Commit 22892760 authored by Sjaak Smetsers's avatar Sjaak Smetsers
Browse files

*** empty log message ***

parent 3beb0c41
......@@ -385,7 +385,7 @@ where
# (pc, _, type_var_heap, td_infos) = propClassOfType at_type group_nr ci type_var_heap td_infos
= prop_classes_of_type_list types tks pcs prop_class_of_type (inc type_index) group_nr ci (cumm_class bitor pc) type_var_heap td_infos
= prop_classes_of_type_list types tks pcs prop_class_of_type (inc type_index) group_nr ci cumm_class type_var_heap td_infos
prop_classes_of_type_list [] [] _ _ _ _ _ cumm_class type_var_heap td_infos
prop_classes_of_type_list [] _ _ _ _ _ _ cumm_class type_var_heap td_infos
= (cumm_class, type_var_heap, td_infos)
propClassOfType (CV tv :@: types) group_nr ci type_var_heap td_infos
......
implementation module frontend
import scanner, parse, postparse, check, type, trans, convertcases, overloading, convertDynamics
import scanner, parse, postparse, check, type, trans, convertcases, overloading, utilities, convertDynamics
import RWSDebug
:: FrontEndSyntaxTree
......@@ -21,7 +21,7 @@ import RWSDebug
frontEndInterface :: !Ident !SearchPaths !*PredefinedSymbols !*HashTable !*Files !*File !*File !*File -> (!*PredefinedSymbols, !*HashTable, !*Files, !*File, !*File, !*File, !Optional *FrontEndSyntaxTree)
frontEndInterface mod_ident search_paths predef_symbols hash_table files error io out
# (ok, mod, hash_table, error, predef_symbols, files)
= wantModule cWantIclFile mod_ident (hash_table -*-> ("Parsing:", mod_ident)) error search_paths predef_symbols files
= wantModule cWantIclFile mod_ident (hash_table ---> ("Parsing:", mod_ident)) error search_paths predef_symbols files
| not ok
= (predef_symbols, hash_table, files, error, io, out, No)
# (ok, mod, nr_of_global_funs, mod_functions, dcl_mod, predef_mod, modules, hash_table, error, predef_symbols, files)
......@@ -42,8 +42,9 @@ frontEndInterface mod_ident search_paths predef_symbols hash_table files error i
= (predef_symbols, hash_table, files, error, io, out, No)
# (components, fun_defs) = partitionateFunctions (fun_defs -*-> "partitionateFunctions") [ { ir_from = 0, ir_to = nr_of_global_funs }, icl_instances, icl_specials]
// (components, fun_defs, io) = showTypes components 0 fun_defs io
// (components, fun_defs, out) = showComponents components 0 True fun_defs out
// (components, fun_defs, error) = showTypes components 0 fun_defs error
// (components, fun_defs, error) = showComponents components 0 True fun_defs error
// (fun_defs, error) = showFunctions array_instances fun_defs error
(components, fun_defs, predef_symbols, dcl_types, used_conses_in_dynamics, var_heap, type_heaps, expression_heap)
= convertDynamicPatternsIntoUnifyAppls type_code_instances common_defs (components -*-> "convertDynamics") fun_defs predef_symbols
......@@ -51,7 +52,7 @@ frontEndInterface mod_ident search_paths predef_symbols hash_table files error i
// (components, fun_defs, error) = showComponents components 0 True fun_defs error
(cleanup_info, acc_args, components, fun_defs, var_heap, expression_heap)
= analyseGroups common_defs (components -*-> "Transform") fun_defs var_heap expression_heap
= analyseGroups common_defs array_instances (components -*-> "Transform") fun_defs var_heap expression_heap
(components, fun_defs, dcl_types, used_conses, var_heap, type_heaps, expression_heap)
= transformGroups cleanup_info components fun_defs acc_args common_defs imported_funs dcl_types used_conses_in_dynamics var_heap type_heaps expression_heap
/*
......@@ -116,6 +117,13 @@ newSymbolTable :: !Int -> *{# SymbolTableEntry}
newSymbolTable size
= createArray size { ste_index = NoIndex, ste_def_level = -1, ste_kind = STE_Empty, ste_previous = abort "PreviousPlaceholder"}
showFunctions :: !IndexRange !*{# FunDef} !*File -> (!*{# FunDef},!*File)
showFunctions {ir_from, ir_to} fun_defs file
= iFoldSt show_function ir_from ir_to (fun_defs, file)
where
show_function fun_index (fun_defs, file)
# (fd, fun_defs) = fun_defs![fun_index]
= (fun_defs, file <<< fun_index <<< fd <<< '\n')
showComponents :: !*{! Group} !Int !Bool !*{# FunDef} !*File -> (!*{! Group}, !*{# FunDef},!*File)
showComponents comps comp_index show_types fun_defs file
......@@ -130,7 +138,7 @@ where
show_component [fun:funs] show_types fun_defs file
#! fun_def = fun_defs.[fun]
| show_types
= show_component funs show_types fun_defs (file <<< '\n' <<< fun_def)
= show_component funs show_types fun_defs (file <<< fun_def.fun_type <<< '\n' <<< fun_def)
= show_component funs show_types fun_defs (file <<< fun_def)
// = show_component funs show_types fun_defs (file <<< fun_def.fun_symb)
......
definition module overloading
import StdEnv
import syntax, check
import syntax, check, typesupport
:: InstanceTree = IT_Node !(Global Index) !InstanceTree !InstanceTree | IT_Empty
......@@ -44,9 +44,9 @@ tryToSolveOverloading :: ![(Optional [TypeContext], [ExprInfoPtr], IdentPos, Ind
, tci_type_var_heap :: !.TypeVarHeap
}
removeOverloadedFunctions :: ![(Optional [TypeContext], IdentPos, Index)] ![TypeContext] ![LocalTypePatternVariable] !*{#FunDef} !*ExpressionHeap
removeOverloadedFunctions :: ![Index] ![LocalTypePatternVariable] !*{#FunDef} !*{! FunctionType} !*ExpressionHeap
!*TypeCodeInfo !*VarHeap !*ErrorAdmin
-> (!*{#FunDef}, !*ExpressionHeap, !*TypeCodeInfo, !*VarHeap, !*ErrorAdmin)
-> (!*{#FunDef}, !*{! FunctionType}, !*ExpressionHeap, !*TypeCodeInfo, !*VarHeap, !*ErrorAdmin)
updateDynamics :: ![Int] ![TypeContext] ![LocalTypePatternVariable] !*{#FunDef} !*ExpressionHeap !*TypeCodeInfo !*VarHeap !*ErrorAdmin
-> (!*{#FunDef}, !*ExpressionHeap, !*TypeCodeInfo, !*VarHeap, !*ErrorAdmin)
updateDynamics :: ![Index] ![LocalTypePatternVariable] !*{#FunDef} !*{! FunctionType} !*ExpressionHeap !*TypeCodeInfo !*VarHeap !*ErrorAdmin
-> (!*{#FunDef}, !*{! FunctionType}, !*ExpressionHeap, !*TypeCodeInfo, !*VarHeap, !*ErrorAdmin)
This diff is collapsed.
......@@ -335,6 +335,7 @@ refMarkOfCase free_vars sel expr (BasicPatterns type patterns) defaul var_heap
(local_lets, var_heap) = collectLocalLetVars free_vars var_heap
(pattern_depth, used_lets, var_heap) = foldSt (ref_mark_of_basic_pattern free_vars sel local_lets) patterns (0, [], var_heap)
= refMarkOfDefault False pattern_depth free_vars sel defaul used_lets var_heap
// ---> ("refMarkOfCase", expr, [ (bp_value, bp_expr) \\ {bp_value, bp_expr} <- patterns])
where
ref_mark_of_basic_pattern free_vars sel local_lets {bp_expr} (pattern_depth, used_lets, var_heap)
# pattern_depth = inc pattern_depth
......@@ -394,10 +395,10 @@ where
| do_par_combine
# new_comb_ref_count = parCombineRefCount comb_ref_count occ_ref_count
= (new_comb_ref_count, occ_previous)
// ---> ("parCombineRefCount", comb_ref_count, occ_ref_count, new_comb_ref_count)
// ---> ("parCombineRefCount", comb_ref_count, occ_ref_count, new_comb_ref_count)
# new_comb_ref_count = seqCombineRefCount comb_ref_count occ_ref_count
= (new_comb_ref_count, occ_previous)
// ---> ("seqCombineRefCount", comb_ref_count, occ_ref_count, new_comb_ref_count)
// ---> ("seqCombineRefCount", comb_ref_count, occ_ref_count, new_comb_ref_count)
case_combine_ref_counts do_par_combine comb_ref_count [occ_ref_count:occ_previous] depth
# new_comb_ref_count = case_combine_ref_count comb_ref_count occ_ref_count
= case_combine_ref_counts do_par_combine new_comb_ref_count occ_previous (dec depth)
......
......@@ -447,7 +447,8 @@ cIsALocalVar :== False
VI_Alias !BoundVar /* used for resolving aliases just before type checking (in transform) */ |
/* used during elimination and lifting of cases */
VI_FreeVar !Ident !VarInfoPtr !Int !AType | VI_BoundVar !AType | VI_LocalVar |
VI_ClassVar !Ident !VarInfoPtr !Int /* used to hold dictionary variables during overloading */ |
VI_ClassVar !Ident !VarInfoPtr !Int | /* to hold dictionary variables during overloading */
VI_ForwardClassVar !VarInfoPtr | /* to hold the dictionary variable generated during overloading */
VI_Forward !BoundVar | VI_LetVar !LetVarInfo | VI_LetExpression !LetExpressionInfo | VI_CaseVar !VarInfoPtr |
VI_CorrespondenceNumber !Int | VI_SequenceNumber !Int |
VI_Used | /* for indicating that an imported function has been used */
......@@ -812,7 +813,8 @@ cNonRecursiveAppl :== False
}
:: TypeAttribute = TA_Unique | TA_Multi | TA_Var !AttributeVar | TA_RootVar AttributeVar | TA_TempVar !Int | TA_TempExVar
| TA_Anonymous | TA_None | TA_List !Int !TypeAttribute
| TA_Anonymous | TA_None
| TA_List !Int !TypeAttribute | TA_Locked !TypeAttribute
:: AttributeVar =
{ av_name :: !Ident
......
......@@ -424,7 +424,8 @@ cIsALocalVar :== False
VI_Alias !BoundVar /* used for resolving aliases just before type checking (in transform) */ |
/* used during elimination and lifting of cases */
VI_FreeVar !Ident !VarInfoPtr !Int !AType | VI_BoundVar !AType | VI_LocalVar |
VI_ClassVar !Ident !VarInfoPtr !Int /* used to hold dictionary variables during overloading */ |
VI_ClassVar !Ident !VarInfoPtr !Int | /* to hold dictionary variables during overloading */
VI_ForwardClassVar !VarInfoPtr | /* to hold the dictionary variable generated during overloading */
VI_Forward !BoundVar | VI_LetVar !LetVarInfo | VI_LetExpression !LetExpressionInfo | VI_CaseVar !VarInfoPtr |
VI_CorrespondenceNumber !Int | VI_SequenceNumber !Int |
VI_Used | /* for indicating that an imported function has been used */
......@@ -772,7 +773,8 @@ cNotVarNumber :== -1
}
:: TypeAttribute = TA_Unique | TA_Multi | TA_Var !AttributeVar | TA_RootVar AttributeVar | TA_TempVar !Int | TA_TempExVar
| TA_Anonymous | TA_None | TA_List !Int !TypeAttribute
| TA_Anonymous | TA_None
| TA_List !Int !TypeAttribute | TA_Locked !TypeAttribute
:: AttributeVar =
{ av_name :: !Ident
......@@ -1153,7 +1155,7 @@ where
toString (TA_Var avar)
= toString avar + ": "
toString TA_TempExVar
= "E"
= "(E)"
toString (TA_RootVar avar)
= toString avar + ": "
toString (TA_Anonymous)
......@@ -1256,14 +1258,14 @@ where
instance <<< SymbIdent
where
(<<<) file symb=:{symb_kind = SK_Function symb_index } = file <<< symb.symb_name <<< '.' <<< symb_index
(<<<) file symb=:{symb_kind = SK_GeneratedFunction _ symb_index } = file <<< symb.symb_name <<< '.' <<< symb_index
(<<<) file symb=:{symb_kind = SK_OverloadedFunction symb_index } = file <<< symb.symb_name <<< "OL"
(<<<) file symb=:{symb_kind = SK_Function symb_index } = file <<< symb.symb_name <<< '@' <<< symb_index
(<<<) file symb=:{symb_kind = SK_GeneratedFunction _ symb_index } = file <<< symb.symb_name <<< '@' <<< symb_index
(<<<) file symb=:{symb_kind = SK_OverloadedFunction symb_index } = file <<< symb.symb_name <<< "[o]@" <<< symb_index
(<<<) file symb = file <<< symb.symb_name
instance <<< TypeSymbIdent
where
(<<<) file symb = file <<< symb.type_name <<< '.' <<< symb.type_arity
(<<<) file symb = file <<< symb.type_name <<< '.' <<< symb.type_index
instance <<< ClassSymbIdent
where
......@@ -1272,7 +1274,7 @@ where
instance <<< BoundVar
where
(<<<) file {var_name,var_info_ptr,var_expr_ptr}
= file <<< var_name <<< '<' <<< ptrToInt var_info_ptr /*<<< ',' <<< ptrToInt var_expr_ptr*/ <<< '>'
= file <<< var_name <<< '<' <<< ptrToInt var_info_ptr <<< ',' <<< ptrToInt var_expr_ptr <<< '>'
instance <<< Bind a b | <<< a & <<< b
where
......@@ -1513,6 +1515,8 @@ where
// <<< fun_index <<< '.' <<< fi_def_level <<< ' ' <<< '[' <<< fi_free_vars <<< ']' <<< tb_args <<< " = " <<< tb_rhs
(<<<) file {fun_symb,fun_index,fun_body=BackendBody body,fun_type=Yes type} = file <<< type <<< '\n' <<< fun_symb <<< '.'
<<< fun_index <<< body <<< '\n'
(<<<) file {fun_symb,fun_index,fun_body=NoBody,fun_type=Yes type} = file <<< type <<< '\n' <<< fun_symb <<< '.'
<<< fun_index <<< "Array function\n"
instance <<< FunCall
where
......@@ -1698,7 +1702,7 @@ where
instance <<< Global a | <<< a
where
(<<<) file {glob_object,glob_module} = file <<< glob_object <<< '.' <<< glob_module
(<<<) file {glob_object,glob_module} = file <<< glob_object <<< "M:" <<< glob_module
instance <<< Position
where
......
......@@ -10,7 +10,7 @@ cAccumulating :== -3
:: CleanupInfo
analyseGroups :: !{# CommonDefs} !*{! Group} !*{#FunDef} !*VarHeap !*ExpressionHeap
analyseGroups :: !{# CommonDefs} !IndexRange !*{! Group} !*{#FunDef} !*VarHeap !*ExpressionHeap
-> (!CleanupInfo, !*{! ConsClasses}, !*{! Group}, !*{#FunDef}, !*VarHeap, !*ExpressionHeap)
transformGroups :: !CleanupInfo !*{! Group} !*{#FunDef} !{!.ConsClasses} !{# CommonDefs} !{# {# FunType} }
......
......@@ -497,10 +497,10 @@ independentConsumerRequirements exprs common_defs ai=:{ai_cur_ref_counts}
unify_ref_counts 2 _ = 2
analyseGroups :: !{# CommonDefs} !*{! Group} !*{#FunDef} !*VarHeap !*ExpressionHeap
analyseGroups :: !{# CommonDefs} !IndexRange !*{! Group} !*{#FunDef} !*VarHeap !*ExpressionHeap
-> (!CleanupInfo, !*{! ConsClasses}, !*{! Group}, !*{#FunDef}, !*VarHeap, !*ExpressionHeap)
analyseGroups common_defs groups fun_defs var_heap expr_heap
#! nr_of_funs = size fun_defs
analyseGroups common_defs {ir_from, ir_to} groups fun_defs var_heap expr_heap
#! nr_of_funs = size fun_defs + ir_from - ir_to /* Sjaak */
nr_of_groups = size groups
= iFoldSt (analyse_group common_defs) 0 nr_of_groups
([], createArray nr_of_funs { cc_size = 0, cc_args = [], cc_linear_bits = []}, groups, fun_defs, var_heap, expr_heap)
......@@ -1242,6 +1242,7 @@ generateFunction fd=:{fun_body = TransformedBody {tb_args,tb_rhs},fun_info = {fi
th_attrs = foldSt (\av attr_var_heap -> attr_var_heap <:= (av.av_info_ptr, SwitchFusion AVI_Empty (AVI_Attr (TA_Var av)))) st_attr_vars ti_type_heaps.th_attrs
(new_fun_args, new_arg_types, new_linear_bits, new_cons_args, th_vars, ti_symbol_heap, ti_fun_defs, ti_fun_heap, ti_var_heap)
// = determine_args cc_linear_bits cc_args 0 prods tb_args (st_args ---> ("generateFunction", fd.fun_symb, fd.fun_index, fun_type)) (st_vars, ti_cons_args, tb_rhs) th_vars
= determine_args cc_linear_bits cc_args 0 prods tb_args st_args (st_vars, ti_cons_args, tb_rhs) th_vars
ti_symbol_heap ti_fun_defs ti_fun_heap ti_var_heap
(fresh_arg_types, ti_type_heaps) = substitute new_arg_types { ti_type_heaps & th_vars = th_vars, th_attrs = th_attrs }
......@@ -1309,6 +1310,7 @@ where
, mapAppend (\_ -> { at_attribute = TA_Multi, at_annotation = AN_None, at_type = TE }) free_vars types
, mapAppend (\_ -> True) free_vars new_linear_bits
, mapAppend (\_ -> cActive) free_vars new_cons_args
// , bind_class_types type.at_type (class_types ---> ("determine_arg", (class_app.app_symb.symb_name, class_app.app_args), type.at_type, class_types)) type_var_heap
, bind_class_types type.at_type class_types type_var_heap
, symbol_heap
, fun_defs
......@@ -1379,8 +1381,14 @@ where
bind_type (TV {tv_info_ptr}) type type_var_heap
= type_var_heap <:= (tv_info_ptr, TVI_Type type)
bind_type (TA _ arg_types1) (TA _ arg_types2) type_var_heap
= bind_types arg_types1 arg_types2 type_var_heap
bind_type (TA {type_name} arg_types1) (TA _ arg_types2) type_var_heap
| length arg_types1 == length arg_types2
= bind_types arg_types1 arg_types2 type_var_heap
= abort ("bind_type (trans.icl)" ---> (type_name, arg_types1, arg_types2))
bind_type (CV {tv_info_ptr} :@: arg_types1) (TA type_cons arg_types2) type_var_heap
# type_arity = type_cons.type_arity - length arg_types1
type_var_heap = type_var_heap <:= (tv_info_ptr, TVI_Type (TA {type_cons & type_arity = type_arity} (take type_arity arg_types2)))
= bind_types arg_types1 (drop type_arity arg_types2) type_var_heap
bind_type _ _ type_var_heap
= type_var_heap
......@@ -1729,7 +1737,8 @@ where
= (Var var, writeVarInfo var_info_ptr VI_Empty (writeVarInfo var.var_info_ptr VI_Empty var_heap))
determineProducer is_applied_to_macro_fun linear_bit app=:{app_symb = symb=:{symb_kind = SK_Function { glob_module, glob_object }}, app_args} _
new_args prod_index producers ti
| glob_module <> cIclModIndex
#! max_index = size ti.ti_cons_args
| glob_module <> cIclModIndex || glob_object >= max_index /* Sjaak, to skip array functions */
= (producers, [App app : new_args ], ti)
# (fun_def, ti_fun_defs) = (ti.ti_fun_defs)![glob_object]
ti = { ti & ti_fun_defs=ti_fun_defs }
......@@ -1932,7 +1941,6 @@ convertSymbolType common_defs st imported_types collected_imports type_heaps va
{ ets_type_defs = imported_types, ets_collected_conses = collected_imports, ets_type_heaps= type_heaps, ets_var_heap = var_heap }
= (st, ets_type_defs, ets_collected_conses, ets_type_heaps, ets_var_heap)
:: ExpandTypeState =
{ ets_type_defs :: !.{#{#CheckedTypeDef}}
, ets_collected_conses :: !ImportedConstructors
......@@ -1961,25 +1969,55 @@ where
instance expandSynTypes Type
where
expandSynTypes common_defs (TA type_symb=:{type_index={glob_object,glob_module},type_name} types) ets=:{ets_type_defs}
# ({td_rhs,td_name,td_args},ets_type_defs) = ets_type_defs![glob_module].[glob_object]
ets = { ets & ets_type_defs = ets_type_defs }
= case td_rhs of
SynType rhs_type
# (type, ets_type_heaps) = substitute rhs_type.at_type (fold2St bind_var_and_attr td_args types ets.ets_type_heaps)
// ---> (td_name, td_args, rhs_type.at_type))
-> expandSynTypes common_defs type { ets & ets_type_heaps = ets_type_heaps }
_
# (types, ets) = expandSynTypes common_defs types ets
| glob_module == cIclModIndex
-> (TA type_symb types, ets)
-> (TA type_symb types, collect_imported_constructors common_defs glob_module td_rhs ets)
where
expandSynTypes common_defs (arg_type --> res_type) ets
# ((arg_type, res_type), ets) = expandSynTypes common_defs (arg_type, res_type) ets
= (arg_type --> res_type, ets)
expandSynTypes common_defs type=:(TB _) ets
= (type, ets)
expandSynTypes common_defs (cons_var :@: types) ets
# (types, ets) = expandSynTypes common_defs types ets
= (cons_var :@: types, ets)
expandSynTypes common_defs type=:(TA type_symb types) ets
= expand_syn_types_in_TA common_defs type_symb types TA_Multi ets
expandSynTypes common_defs type ets
= (type, ets)
instance expandSynTypes [a] | expandSynTypes a
where
expandSynTypes common_defs list ets
= mapSt (expandSynTypes common_defs) list ets
instance expandSynTypes (a,b) | expandSynTypes a & expandSynTypes b
where
expandSynTypes common_defs tuple ets
= app2St (expandSynTypes common_defs, expandSynTypes common_defs) tuple ets
expand_syn_types_in_TA common_defs type_symb=:{type_index={glob_object,glob_module},type_name} types attribute ets=:{ets_type_defs}
# ({td_rhs,td_name,td_args,td_attribute},ets_type_defs) = ets_type_defs![glob_module].[glob_object]
ets = { ets & ets_type_defs = ets_type_defs }
= case td_rhs of
SynType rhs_type
# ets_type_heaps = bind_attr td_attribute attribute ets.ets_type_heaps
ets_type_heaps = (fold2St bind_var_and_attr td_args types ets_type_heaps)
(type, ets_type_heaps) = substitute rhs_type.at_type ets_type_heaps
-> expandSynTypes common_defs type { ets & ets_type_heaps = ets_type_heaps }
_
# (types, ets) = expandSynTypes common_defs types ets
| glob_module == cIclModIndex
-> ( TA type_symb types, ets)
-> ( TA type_symb types, collect_imported_constructors common_defs glob_module td_rhs ets)
where
bind_var_and_attr { atv_attribute = TA_Var {av_info_ptr}, atv_variable = {tv_info_ptr} } {at_attribute,at_type} type_heaps=:{th_vars,th_attrs}
= { type_heaps & th_vars = th_vars <:= (tv_info_ptr, TVI_Type at_type), th_attrs = th_attrs <:= (av_info_ptr, AVI_Attr at_attribute) }
bind_var_and_attr { atv_variable = {tv_info_ptr}} {at_type} type_heaps=:{th_vars}
= { type_heaps & th_vars = th_vars <:= (tv_info_ptr, TVI_Type at_type) }
bind_attr (TA_Var {av_info_ptr}) attribute type_heaps=:{th_attrs}
= { type_heaps & th_attrs = th_attrs <:= (av_info_ptr, AVI_Attr attribute) }
bind_attr _ attribute type_heaps
= type_heaps
collect_imported_constructors common_defs mod_index (RecordType {rt_constructor}) ets=:{ets_collected_conses,ets_var_heap}
# (ets_collected_conses, ets_var_heap)
= collect_imported_constructor mod_index common_defs.[mod_index].com_cons_defs rt_constructor (ets_collected_conses, ets_var_heap)
......@@ -2003,32 +2041,17 @@ where
has_been_collected _ = False
expandSynTypes common_defs (arg_type --> res_type) ets
# ((arg_type, res_type), ets) = expandSynTypes common_defs (arg_type, res_type) ets
= (arg_type --> res_type, ets)
expandSynTypes common_defs (cons_var :@: types) ets
# (types, ets) = expandSynTypes common_defs types ets
= (cons_var :@: types, ets)
expandSynTypes common_defs type ets
= (type, ets)
instance expandSynTypes [a] | expandSynTypes a
where
expandSynTypes common_defs list ets
= mapSt (expandSynTypes common_defs) list ets
instance expandSynTypes (a,b) | expandSynTypes a & expandSynTypes b
where
expandSynTypes common_defs tuple ets
= app2St (expandSynTypes common_defs, expandSynTypes common_defs) tuple ets
instance expandSynTypes AType
where
expandSynTypes common_defs atype=:{at_type} ets
# (at_type, ets) = expandSynTypes common_defs at_type ets
= ({ atype & at_type = at_type }, ets)
expandSynTypes common_defs atype ets
= expand_syn_types_in_a_type common_defs atype ets
where
expand_syn_types_in_a_type common_defs atype=:{at_type = TA type_symb types, at_attribute} ets
# (at_type, ets) = expand_syn_types_in_TA common_defs type_symb types at_attribute ets
= ({ atype & at_type = at_type }, ets)
expand_syn_types_in_a_type common_defs atype ets
# (at_type, ets) = expandSynTypes common_defs atype.at_type ets
= ({ atype & at_type = at_type }, ets)
:: FreeVarInfo =
{ fvi_var_heap :: !.VarHeap
......
Supports Markdown
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