Commit fb9c84a9 authored by John van Groningen's avatar John van Groningen
Browse files

refactor, move type CoercionPosition and functions that use it in module syntax to module type

parent 9cf9a2aa
......@@ -789,7 +789,6 @@ pIsSafe :== True
:: ImportedTypes :== {#{# CheckedTypeDef}}
:: VI_TypeInfo = VITI_Empty
| VITI_Coercion CoercionPosition
| ..
:: VarInfo = VI_Empty | VI_Type !AType !VI_TypeInfo |
......@@ -1473,12 +1472,6 @@ instance == OverloadedPatternType
| PreDefPos Ident
| NoPos
:: CoercionPosition
= CP_Expression !Expression
| CP_FunArg !Ident !Int // Function or constructor ident, argument position (>=1)
| CP_SymbArgAndExpression !SymbIdent !Int !Expression // Function or constructor symbol, argument position (>=1)
| CP_LiftedFunArg !Ident !Ident // Function symbol, lifted argument ident
:: IdentPos =
{ ip_ident :: !Ident
, ip_line :: !Int
......@@ -1507,7 +1500,7 @@ instance <<< (Module a) | <<< a, ParsedDefinition, InstanceType, AttributeVar, T
FieldNameOrQualifiedFieldName, ParsedConstructor, (TypeDef a) | <<< a, TypeVarInfo, AttrVarInfo,
BasicValue, ATypeVar, TypeRhs, Import, ImportDeclaration, CasePatterns,
(Optional a) | <<< a, ConsVariable, BasicType, Annotation, SelectorKind, Selection, SelectorDef, ConsDef, LocalDefs, FreeVar, ClassInstance, SignClassification,
TypeCodeExpression, CoercionPosition, AttrInequality, LetBind, Declaration, STE_Kind, BoundVar,
TypeCodeExpression, AttrInequality, LetBind, Declaration, STE_Kind, BoundVar,
TypeSymbIdent,
TypeCons,
IndexRange,
......
......@@ -870,47 +870,6 @@ where
(<<<) file (IB_Idents idents) = file <<< idents
(<<<) file (IB_IdentsAndOptIdents idents opt_idents) = file <<< idents <<< ' ' <<< opt_idents
instance <<< CoercionPosition
where
(<<<) file (CP_FunArg fun_name arg_nr)
= file <<< "argument " <<< arg_nr <<< " of " <<< readable fun_name
(<<<) file (CP_SymbArgAndExpression fun_name arg_nr expression)
= show_expression (file <<< "argument " <<< arg_nr <<< " of " <<< readable fun_name.symb_ident <<< " : ") expression
(<<<) file (CP_LiftedFunArg fun_name arg_name)
= file <<< "lifted argument " <<< arg_name <<< " of " <<< readable fun_name
(<<<) file (CP_Expression expression) = show_expression file expression
show_expression file (Var {var_ident})
= file <<< var_ident
show_expression file (FreeVar {fv_ident})
= file <<< fv_ident
show_expression file (App {app_symb={symb_ident}, app_args})
| symb_ident.id_name=="_dummyForStrictAlias"
= show_expression file (hd app_args)
= file <<< readable symb_ident
show_expression file (fun @ fun_args)
= show_expression file fun
show_expression file (Case {case_ident=No})
= file <<< "(case ... )"
show_expression file (Selection _ expr selectors)
= file <<< "selection"
show_expression file (Update expr1 selectors expr2)
= file <<< "update"
show_expression file (TupleSelect {ds_arity} elem_nr expr)
= file <<< "argument " <<< (elem_nr + 1) <<< " of " <<< ds_arity <<< "-tuple"
show_expression file (BasicExpr bv)
= file <<< bv
show_expression file (RecordUpdate _ _ _)
= file <<< "update of record"
show_expression file (MatchExpr _ expr)
= file <<< "match expression"
show_expression file (IsConstructor _ _ _ _ _ _)
= file <<< "is constructor expression"
show_expression file (Let _)
= file <<< "(let ... ) or #"
show_expression file _
= file
instance <<< Declaration
where
(<<<) file (Declaration { decl_ident, decl_kind })
......@@ -983,24 +942,6 @@ where
(<<<) file (QualifiedIdent module_ident name)
= file<<<'\''<<<module_ident<<<"'."<<<name
readable :: !Ident -> String // somewhat hacky
readable {id_name}
| size id_name>0 && id_name.[0]=='_'
| id_name=="_Cons" || id_name=="_Nil"
= "list constructor"
| id_name=="_!Cons" || id_name=="_!Nil"
= "! list constructor"
| id_name=="_#Cons" || id_name=="_#Nil"
= "# list constructor"
| id_name=="_Cons!" || id_name=="_Nil!"
= "list constructor !"
| id_name=="_!Cons!" || id_name=="_!Nil!"
= "! list constructor !"
| id_name=="_#Cons!" || id_name=="_#Nil!"
= "# list constructor !"
= id_name%(1, size id_name-1)
= id_name
instance == ModuleKind
where
(==) mk1 mk2 = equal_constructor mk1 mk2
......
......@@ -35,6 +35,12 @@ import check_instances, genericsupport
, tc_coercible :: !Bool
}
:: CoercionPosition
= CP_Expression !Expression
| CP_FunArg !Ident !Int // Function or constructor ident, argument position (>=1)
| CP_SymbArgAndExpression !SymbIdent !Int !Expression // Function or constructor symbol, argument position (>=1)
| CP_LiftedFunArg !Ident !Ident // Function symbol, lifted argument ident
:: Requirements =
{ req_overloaded_calls :: ![ExprInfoPtr]
, req_type_coercions :: ![TypeCoercion]
......@@ -881,6 +887,7 @@ where
| VITI_PatternType [AType] /*module*/!Index /*constructor*/!Index !VI_TypeInfo
| VITI_ExiPatternType [AType] /*module*/!Index /*constructor*/!Index !ExiVarNumbers !VI_TypeInfo
| VITI_ExiVars !ExiVarNumbers !VI_TypeInfo
| VITI_Coercion CoercionPosition
freshRecordType :: ![ATypeVar] ![AttributeVar] ![AlgebraicPattern] !{#CommonDefs} !Expression !*TypeState
-> (![[AType]],!AType,![AttrCoercion],![(DefinedSymbol,[TypeContext])],!ExiVarNumbers,!*TypeState)
......@@ -3375,6 +3382,65 @@ getTypeInfoOfVariable {var_info_ptr} var_heap
empty_id =: { id_name = "", id_info = nilPtr }
instance <<< CoercionPosition
where
(<<<) file (CP_FunArg fun_name arg_nr)
= file <<< "argument " <<< arg_nr <<< " of " <<< readable fun_name
(<<<) file (CP_SymbArgAndExpression fun_name arg_nr expression)
= show_expression (file <<< "argument " <<< arg_nr <<< " of " <<< readable fun_name.symb_ident <<< " : ") expression
(<<<) file (CP_LiftedFunArg fun_name arg_name)
= file <<< "lifted argument " <<< arg_name <<< " of " <<< readable fun_name
(<<<) file (CP_Expression expression) = show_expression file expression
show_expression file (Var {var_ident})
= file <<< var_ident
show_expression file (FreeVar {fv_ident})
= file <<< fv_ident
show_expression file (App {app_symb={symb_ident}, app_args})
| symb_ident.id_name=="_dummyForStrictAlias"
= show_expression file (hd app_args)
= file <<< readable symb_ident
show_expression file (fun @ fun_args)
= show_expression file fun
show_expression file (Case {case_ident=No})
= file <<< "(case ... )"
show_expression file (Selection _ expr selectors)
= file <<< "selection"
show_expression file (Update expr1 selectors expr2)
= file <<< "update"
show_expression file (TupleSelect {ds_arity} elem_nr expr)
= file <<< "argument " <<< (elem_nr + 1) <<< " of " <<< ds_arity <<< "-tuple"
show_expression file (BasicExpr bv)
= file <<< bv
show_expression file (RecordUpdate _ _ _)
= file <<< "update of record"
show_expression file (MatchExpr _ expr)
= file <<< "match expression"
show_expression file (IsConstructor _ _ _ _ _ _)
= file <<< "is constructor expression"
show_expression file (Let _)
= file <<< "(let ... ) or #"
show_expression file _
= file
readable :: !Ident -> String // somewhat hacky
readable {id_name}
| size id_name>0 && id_name.[0]=='_'
| id_name=="_Cons" || id_name=="_Nil"
= "list constructor"
| id_name=="_!Cons" || id_name=="_!Nil"
= "! list constructor"
| id_name=="_#Cons" || id_name=="_#Nil"
= "# list constructor"
| id_name=="_Cons!" || id_name=="_Nil!"
= "list constructor !"
| id_name=="_!Cons!" || id_name=="_!Nil!"
= "! list constructor !"
| id_name=="_#Cons!" || id_name=="_#Nil!"
= "# list constructor !"
= id_name%(1, size id_name-1)
= id_name
instance <<< (Ptr a)
where
(<<<) file ptr = file <<< ptrToInt ptr
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment