Commit 0dd5ac28 authored by Martin Wierich's avatar Martin Wierich
Browse files

fusion works now. The fusion switch in module typesupport is enabled

parent b09775cd
...@@ -23,6 +23,7 @@ where ...@@ -23,6 +23,7 @@ where
kind_list_to_string [] = " ?????? " kind_list_to_string [] = " ?????? "
kind_list_to_string [k] = "* -> *" kind_list_to_string [k] = "* -> *"
kind_list_to_string [k:ks] = "* -> " +++ kind_list_to_string ks kind_list_to_string [k:ks] = "* -> " +++ kind_list_to_string ks
toString ki = "PPPP" //abort ("instance toString KindInfo matcht niet"->>ki)
kindError kind1 kind2 error kindError kind1 kind2 error
......
implementation module convertDynamics implementation module convertDynamics
import syntax, transform, utilities, convertcases import syntax, transform, utilities, convertcases
// XXX
import RWSDebug
:: *ConversionInfo = :: *ConversionInfo =
{ ci_predef_symb :: !*PredefinedSymbols { ci_predef_symb :: !*PredefinedSymbols
......
...@@ -413,7 +413,7 @@ element_appears imported_st element_ident dcl_index ...@@ -413,7 +413,7 @@ element_appears imported_st element_ident dcl_index
# structureInfo = case opt_element_idents of # structureInfo = case opt_element_idents of
No -> SI_DotDot No -> SI_DotDot
Yes element_idents -> (SI_Elements element_idents False) Yes element_idents -> (SI_Elements element_idents False)
newStructure = (struct_id, SI_DotDot, st, (if defined No (Yes dcl_index))) newStructure = (struct_id, structureInfo, st, (if defined No (Yes dcl_index)))
= element_appears imported_st element_ident dcl_index t [newStructure:akku] index modules cs = element_appears imported_st element_ident dcl_index t [newStructure:akku] index modules cs
# (Yes element_idents) = opt_element_idents # (Yes element_idents) = opt_element_idents
oneLess = filter ((<>) element_ident) element_idents oneLess = filter ((<>) element_ident) element_idents
...@@ -475,8 +475,6 @@ element_appears_in_stomm_struct imported_st element_ident dcl_index index type_n ...@@ -475,8 +475,6 @@ element_appears_in_stomm_struct imported_st element_ident dcl_index index type_n
# com_member_def = dcl_module.dcl_common.com_member_defs.[dcl_index] # com_member_def = dcl_module.dcl_common.com_member_defs.[dcl_index]
{glob_object} = com_member_def.me_class {glob_object} = com_member_def.me_class
com_class_def = dcl_module.dcl_common.com_class_defs.[glob_object] com_class_def = dcl_module.dcl_common.com_class_defs.[glob_object]
allMembers = com_class_def.class_members
member_idents = [ ds_ident \\ {ds_ident} <-: allMembers]
appears = com_class_def.class_name.id_name==type_name_string appears = com_class_def.class_name.id_name==type_name_string
= (appears, modules, cs) = (appears, modules, cs)
continuation _ _ _ modules cs continuation _ _ _ modules cs
...@@ -575,7 +573,7 @@ consequences_of count (expl_imp_ident_kind=:(_,expl_imp_kind), (dcl_index, mod_i ...@@ -575,7 +573,7 @@ consequences_of count (expl_imp_ident_kind=:(_,expl_imp_kind), (dcl_index, mod_i
consequences_of_macro count dcl_index f_consequences icl_functions expr_heap consequences_of_macro count dcl_index f_consequences icl_functions expr_heap
# (icl_function, icl_functions) = icl_functions![dcl_index] # (icl_function, icl_functions) = icl_functions![dcl_index]
{fun_symb, fun_type, fun_body} = icl_function {fun_body} = icl_function
result = consequences fun_body result = consequences fun_body
= expand_functions_and_dynamics result [] (f_consequences, icl_functions, expr_heap) = expand_functions_and_dynamics result [] (f_consequences, icl_functions, expr_heap)
where where
...@@ -601,8 +599,6 @@ consequences_of_macro count dcl_index f_consequences icl_functions expr_heap ...@@ -601,8 +599,6 @@ consequences_of_macro count dcl_index f_consequences icl_functions expr_heap
-> ([], expr_heap) -> ([], expr_heap)
(EI_Dynamic (Yes dynamicType)) (EI_Dynamic (Yes dynamicType))
-> (consequences dynamicType, expr_heap) -> (consequences dynamicType, expr_heap)
(EI_Dynamic (Yes dynamicType))
-> (consequences dynamicType, expr_heap)
(EI_DynamicType dynamicType further_dynamic_ptrs) (EI_DynamicType dynamicType further_dynamic_ptrs)
# (further_conseqs, expr_heap) = expand_dynamics further_dynamic_ptrs [] expr_heap # (further_conseqs, expr_heap) = expand_dynamics further_dynamic_ptrs [] expr_heap
-> (further_conseqs++consequences dynamicType, expr_heap) -> (further_conseqs++consequences dynamicType, expr_heap)
......
...@@ -3,6 +3,8 @@ module main ...@@ -3,6 +3,8 @@ module main
import scanner, parse, postparse, check, type, trans, convertcases, utilities, convertDynamics import scanner, parse, postparse, check, type, trans, convertcases, utilities, convertDynamics
import StdEnv import StdEnv
// XXX
import RWSDebug
Start world Start world
# (std_io, world) = stdio world # (std_io, world) = stdio world
...@@ -16,6 +18,17 @@ Start world ...@@ -16,6 +18,17 @@ Start world
(ms.ms_out, ms.ms_files))) world (ms.ms_out, ms.ms_files))) world
= fclose ms_out world = fclose ms_out world
CommandLoop proj ms=:{ms_io}
# answer = "c t5"
(command, argument) = SplitAtLayoutChar (dropWhile isSpace (fromString answer))
| command == []
= CommandLoop proj { ms & ms_io = ms_io}
# (ready, proj, ms) = DoCommand command argument proj { ms & ms_io = ms_io}
| ready
= ms
= ms
/*
CommandLoop proj ms=:{ms_io} CommandLoop proj ms=:{ms_io}
# (answer, ms_io) = freadline (ms_io <<< "> ") # (answer, ms_io) = freadline (ms_io <<< "> ")
(command, argument) = SplitAtLayoutChar (dropWhile isSpace (fromString answer)) (command, argument) = SplitAtLayoutChar (dropWhile isSpace (fromString answer))
...@@ -25,6 +38,7 @@ CommandLoop proj ms=:{ms_io} ...@@ -25,6 +38,7 @@ CommandLoop proj ms=:{ms_io}
| ready | ready
= ms = ms
= CommandLoop proj ms = CommandLoop proj ms
*/
:: MainStateDefs funs funtypes types conses classes instances members selectors = :: MainStateDefs funs funtypes types conses classes instances members selectors =
{ msd_funs :: !funs { msd_funs :: !funs
...@@ -163,19 +177,20 @@ loadModule mod_ident predef_symbols hash_table ms=:{ms_files,ms_error,ms_io,ms_o ...@@ -163,19 +177,20 @@ loadModule mod_ident predef_symbols hash_table ms=:{ms_files,ms_error,ms_io,ms_o
= (No, predef_symbols, { hash_table & hte_symbol_heap = symbol_table}, { ms & ms_files = ms_files, ms_error = ms_error, ms_io = ms_io, ms_out = ms_out }) = (No, predef_symbols, { hash_table & hte_symbol_heap = symbol_table}, { ms & ms_files = ms_files, ms_error = ms_error, ms_io = ms_io, ms_out = ms_out })
# (components, fun_defs) = partitionateFunctions (fun_defs ---> "partitionateFunctions") [ { ir_from = 0, ir_to = nr_of_global_funs }, icl_instances, icl_specials] # (components, fun_defs) = partitionateFunctions (fun_defs ---> "partitionateFunctions") [ { ir_from = 0, ir_to = nr_of_global_funs }, icl_instances, icl_specials]
(components, fun_defs, ms_io) = showTypes components 0 fun_defs ms_io // (components, fun_defs, ms_error) = showTypes components 0 fun_defs ms_error
// (components, fun_defs, ms_out) = showComponents components 0 True fun_defs ms_out (components, fun_defs, ms_error) = showComponents components 0 True fun_defs ms_error
(cleanup_info, acc_args, components, fun_defs, var_heap, expression_heap) (cleanup_info, acc_args, components, fun_defs, var_heap, expression_heap)
= analyseGroups (components ---> "Transform") fun_defs heaps.hp_var_heap heaps.hp_expression_heap = analyseGroups common_defs (components ---> "Transform") fun_defs imported_funs heaps.hp_var_heap heaps.hp_expression_heap
(components, fun_defs, dcl_types, used_conses, var_heap, type_heaps, 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 var_heap heaps.hp_type_heaps expression_heap = transformGroups cleanup_info components fun_defs acc_args common_defs imported_funs var_heap heaps.hp_type_heaps expression_heap
/// (components, fun_defs, ms_error) = showComponents components 0 True fun_defs ms_error (components, fun_defs, ms_error) = showComponents components 0 True fun_defs ms_error
// (components, fun_defs, ms_error) = showTypes components 0 fun_defs ms_error
(dcl_types, used_conses, var_heap, type_heaps) = convertIclModule common_defs dcl_types used_conses var_heap type_heaps (dcl_types, used_conses, var_heap, type_heaps) = convertIclModule common_defs dcl_types used_conses var_heap type_heaps
(dcl_types, used_conses, var_heap, type_heaps) = convertDclModule dcl_mods common_defs dcl_types used_conses var_heap type_heaps (dcl_types, used_conses, var_heap, type_heaps) = convertDclModule dcl_mods common_defs dcl_types used_conses var_heap type_heaps
(components, fun_defs, predef_symbols, dcl_types, used_conses, var_heap, type_heaps, expression_heap) (components, fun_defs, predef_symbols, dcl_types, used_conses, var_heap, type_heaps, expression_heap)
= convertDynamicPatternsIntoUnifyAppls type_code_instances common_defs (components ---> "convertDynamics") fun_defs predef_symbols = convertDynamicPatternsIntoUnifyAppls type_code_instances common_defs (components ---> "convertDynamics") fun_defs predef_symbols
dcl_types used_conses var_heap type_heaps expression_heap dcl_types used_conses var_heap type_heaps expression_heap
(components, fun_defs, ms_out) = showComponents components 0 True fun_defs ms_out // (components, fun_defs, ms_out) = showComponents components 0 True fun_defs ms_out
(used_funs, components, fun_defs, dcl_types, used_conses, var_heap, type_heaps, expression_heap) (used_funs, components, fun_defs, dcl_types, used_conses, var_heap, type_heaps, expression_heap)
= convertCasesOfFunctionsIntoPatterns components imported_funs common_defs fun_defs dcl_types used_conses var_heap type_heaps expression_heap = convertCasesOfFunctionsIntoPatterns components imported_funs common_defs fun_defs dcl_types used_conses var_heap type_heaps expression_heap
(dcl_types, var_heap, type_heaps) (dcl_types, var_heap, type_heaps)
...@@ -247,6 +262,8 @@ where ...@@ -247,6 +262,8 @@ where
show_component [] show_types fun_defs file show_component [] show_types fun_defs file
= (fun_defs, file <<< '\n') = (fun_defs, file <<< '\n')
show_component [fun:funs] show_types fun_defs file show_component [fun:funs] show_types fun_defs file
| fun>=size fun_defs
= abort ("YYY "+++toString fun+++" "+++toString (size fun_defs))
#! fun_def = fun_defs.[fun] #! fun_def = fun_defs.[fun]
| show_types | show_types
= show_component funs show_types fun_defs (file <<< '\n' <<< fun_def) = show_component funs show_types fun_defs (file <<< '\n' <<< fun_def)
...@@ -297,9 +314,7 @@ where ...@@ -297,9 +314,7 @@ where
= (fun_defs, file <<< '\n') = (fun_defs, file <<< '\n')
show_types [fun:funs] fun_defs file show_types [fun:funs] fun_defs file
#! fun_def = fun_defs.[fun] #! fun_def = fun_defs.[fun]
# properties = { form_properties = cAttributed bitor cAnnotated, form_attr_position = No } = show_types funs fun_defs (file <<< '\n' <<< fun_def.fun_type)
(Yes ftype) = fun_def.fun_type
= show_types funs fun_defs (file <<< fun_def.fun_symb <<< " :: " <:: (properties, ftype) <<< '\n' )
converFileToListOfStrings file_name files error converFileToListOfStrings file_name files error
# (ok, file, files) = fopen file_name FReadText files # (ok, file, files) = fopen file_name FReadText files
......
...@@ -478,7 +478,12 @@ cIsALocalVar :== False ...@@ -478,7 +478,12 @@ cIsALocalVar :== False
VI_ExpandedType !SymbolType | /* for storing the (expanded) type of an imported function */ VI_ExpandedType !SymbolType | /* for storing the (expanded) type of an imported function */
VI_Record ![AuxiliaryPattern] | VI_Record ![AuxiliaryPattern] |
VI_Pattern !AuxiliaryPattern | VI_Pattern !AuxiliaryPattern |
VI_Default !Int /* used during conversion of dynamics; the Int indiacted the refenrence count */ VI_Default !Int | /* used during conversion of dynamics; the Int indiacted the refenrence count */
VI_Body !SymbIdent !TransformedBody ![FreeVar] | /* used during fusion */
VI_Dictionary !SymbIdent ![Expression] ![Type] | /* used during fusion */
VI_Extended !ExtendedVarInfo !VarInfo
:: ExtendedVarInfo = EVI_VarType !AType
:: ArgumentPosition :== Int :: ArgumentPosition :== Int
...@@ -638,20 +643,16 @@ cNonRecursiveAppl :== False ...@@ -638,20 +643,16 @@ cNonRecursiveAppl :== False
| EI_Default !Expression !AType !ExprInfoPtr | EI_Default !Expression !AType !ExprInfoPtr
| EI_DefaultFunction !SymbIdent ![Expression] | EI_DefaultFunction !SymbIdent ![Expression]
| EI_Extended ![ExtendedExprInfo] !ExprInfo | EI_Extended !ExtendedExprInfo !ExprInfo
:: ExtendedExprInfo :: ExtendedExprInfo
= EEI_ActiveCase !ActiveCaseInfo = EEI_ActiveCase !ActiveCaseInfo
:: ActiveCaseInfo = :: ActiveCaseInfo =
{ aci_arg_pos :: !Int { aci_params :: ![FreeVar]
, aci_opt_unfolder:: !(Optional SymbIdent) , aci_opt_unfolder :: !(Optional SymbIdent)
, aci_free_vars :: !Optional [VarId] , aci_free_vars :: !Optional [BoundVar]
} , aci_linearity_of_patterns :: ![[Bool]]
:: VarId =
{ v_name :: !Ident
, v_info_ptr :: !VarInfoPtr
} }
:: RefCountsInCase = :: RefCountsInCase =
......
...@@ -434,7 +434,12 @@ cIsALocalVar :== False ...@@ -434,7 +434,12 @@ cIsALocalVar :== False
VI_ExpandedType !SymbolType | /* for storing the (expanded) type of an imported function */ VI_ExpandedType !SymbolType | /* for storing the (expanded) type of an imported function */
VI_Record ![AuxiliaryPattern] | VI_Record ![AuxiliaryPattern] |
VI_Pattern !AuxiliaryPattern | VI_Pattern !AuxiliaryPattern |
VI_Default !Int /* used during conversion of dynamics; the Int indiacted the refenrence count */ VI_Default !Int | /* used during conversion of dynamics; the Int indiacted the refenrence count */
VI_Body !SymbIdent !TransformedBody ![FreeVar] | /* used during fusion */
VI_Dictionary !SymbIdent ![Expression] ![Type] | /* used during fusion */
VI_Extended !ExtendedVarInfo !VarInfo
:: ExtendedVarInfo = EVI_VarType !AType
:: ArgumentPosition :== Int :: ArgumentPosition :== Int
...@@ -585,20 +590,16 @@ cNotVarNumber :== -1 ...@@ -585,20 +590,16 @@ cNotVarNumber :== -1
| EI_Default !Expression !AType !ExprInfoPtr | EI_Default !Expression !AType !ExprInfoPtr
| EI_DefaultFunction !SymbIdent ![Expression] | EI_DefaultFunction !SymbIdent ![Expression]
| EI_Extended ![ExtendedExprInfo] !ExprInfo | EI_Extended !ExtendedExprInfo !ExprInfo
:: ExtendedExprInfo :: ExtendedExprInfo
= EEI_ActiveCase !ActiveCaseInfo = EEI_ActiveCase !ActiveCaseInfo
:: ActiveCaseInfo = :: ActiveCaseInfo =
{ aci_arg_pos :: !Int { aci_params :: ![FreeVar]
, aci_opt_unfolder:: !(Optional SymbIdent) , aci_opt_unfolder :: !(Optional SymbIdent)
, aci_free_vars :: !Optional [VarId] , aci_free_vars :: !Optional [BoundVar]
} , aci_linearity_of_patterns :: ![[Bool]]
:: VarId =
{ v_name :: !Ident
, v_info_ptr :: !VarInfoPtr
} }
:: RefCountsInCase = :: RefCountsInCase =
...@@ -1276,7 +1277,7 @@ where ...@@ -1276,7 +1277,7 @@ where
instance <<< BoundVar instance <<< BoundVar
where where
(<<<) file {var_name,var_info_ptr,var_expr_ptr} (<<<) 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 instance <<< Bind a b | <<< a & <<< b
where where
...@@ -1326,8 +1327,10 @@ where ...@@ -1326,8 +1327,10 @@ where
instance <<< Expression instance <<< Expression
where where
(<<<) file (Var ident) = file <<< ident (<<<) file (Var ident) = file <<< ident
(<<<) file (App {app_symb, app_args}) (<<<) file (App {app_symb, app_args, app_info_ptr})
= file <<< app_symb <<< ' ' <<< app_args = file <<< app_symb <<< (if (app_symb.symb_name.id_name=="==" && isNilPtr app_info_ptr) "\"NIL\"" "") <<< ' ' <<< app_args
// was (<<<) file (App {app_symb, app_args})
// = file <<< app_symb <<< ' ' <<< app_args
(<<<) file (f_exp @ a_exp) = file <<< '(' <<< f_exp <<< " @ " <<< a_exp <<< ')' (<<<) file (f_exp @ a_exp) = file <<< '(' <<< f_exp <<< " @ " <<< a_exp <<< ')'
(<<<) file (Let {let_binds, let_expr}) = write_binds (file <<< "let " <<< '\n') let_binds <<< "in\n" <<< let_expr (<<<) file (Let {let_binds, let_expr}) = write_binds (file <<< "let " <<< '\n') let_binds <<< "in\n" <<< let_expr
where where
......
...@@ -10,7 +10,7 @@ cAccumulating :== -3 ...@@ -10,7 +10,7 @@ cAccumulating :== -3
:: CleanupInfo :: CleanupInfo
analyseGroups :: !*{! Group} !*{#FunDef} !*VarHeap !*ExpressionHeap analyseGroups :: !{# CommonDefs} !*{! Group} !*{#FunDef} !*VarHeap !*ExpressionHeap
-> (!CleanupInfo, !*{! ConsClasses}, !*{! Group}, !*{#FunDef}, !*VarHeap, !*ExpressionHeap) -> (!CleanupInfo, !*{! ConsClasses}, !*{! Group}, !*{#FunDef}, !*VarHeap, !*ExpressionHeap)
transformGroups :: !CleanupInfo !*{! Group} !*{#FunDef} !{!.ConsClasses} !{# CommonDefs} !{# {# FunType} } !*VarHeap !*TypeHeaps !*ExpressionHeap transformGroups :: !CleanupInfo !*{! Group} !*{#FunDef} !{!.ConsClasses} !{# CommonDefs} !{# {# FunType} } !*VarHeap !*TypeHeaps !*ExpressionHeap
......
...@@ -88,29 +88,38 @@ where ...@@ -88,29 +88,38 @@ where
:: BitVector :== Int :: BitVector :== Int
:: *AnalyseInfo = :: *AnalyseInfo =
{ ai_heap :: !*VarHeap { ai_var_heap :: !*VarHeap
, ai_cons_class :: !*{! ConsClasses} , ai_cons_class :: !*{! ConsClasses}
, ai_cur_ref_counts :: !*{#Int} // for each variable 0,1 or 2 , ai_cur_ref_counts :: !*{#Int} // for each variable 0,1 or 2
, ai_class_subst :: !* ConsClassSubst , ai_class_subst :: !* ConsClassSubst
, ai_next_var :: !Int , ai_next_var :: !Int
, ai_cases_of_vars_for_function :: ![(!ExprInfoPtr,!VarInfoPtr)] , ai_next_var_of_fun :: !Int
, ai_cases_of_vars_for_function :: ![Case]
}
:: SharedAI =
{ sai_common_defs :: !{# CommonDefs }
, sai_imported_funs :: !{# {# FunType} }
} }
:: ConsClassSubst :== {# ConsClass} :: ConsClassSubst :== {# ConsClass}
:: CleanupInfo :== [ExprInfoPtr] :: CleanupInfo :== [ExprInfoPtr]
cNoFunArg :== -1
cNope :== -1
/* /*
The argument classification (i.e. 'accumulating', 'active' or 'passive') of consumers The argument classification (i.e. 'accumulating', 'active' or 'passive') of consumers
is represented by an negative integer value. is represented by a negative integer value.
Possitive classifications are used to identify variables. Positive classifications are used to identify variables.
Unification of classifications is done on-the-fly Unification of classifications is done on-the-fly
*/ */
cNoFunArg :== -1
cPassive :== -1 cPassive :== -1
cActive :== -2 cActive :== -2
cAccumulating :== -3 cAccumulating :== -3
cVarOfWeirdCase :== -4
IsAVariable cons_class :== cons_class >= 0 IsAVariable cons_class :== cons_class >= 0
...@@ -165,115 +174,134 @@ write_ptr ptr val heap mess ...@@ -165,115 +174,134 @@ write_ptr ptr val heap mess
= abort mess = abort mess
= heap <:= (ptr,val) = heap <:= (ptr,val)
class consumerRequirements a :: !a !AnalyseInfo -> (!ConsClass, !AnalyseInfo) readVarInfo :: VarInfoPtr *VarHeap -> (VarInfo, !*VarHeap)
readVarInfo var_info_ptr var_heap
# (var_info, var_heap) = readPtr var_info_ptr var_heap
= case var_info of
VI_Extended _ original_var_info -> (original_var_info, var_heap)
_ -> (var_info, var_heap)
writeVarInfo :: VarInfoPtr VarInfo *VarHeap -> *VarHeap
writeVarInfo var_info_ptr new_var_info var_heap
# (old_var_info, var_heap) = readPtr var_info_ptr var_heap
= case old_var_info of
VI_Extended extensions _ -> writePtr var_info_ptr (VI_Extended extensions new_var_info) var_heap
_ -> writePtr var_info_ptr new_var_info var_heap
class consumerRequirements a :: !a !{# CommonDefs} !AnalyseInfo -> (!ConsClass, !UnsafePatternBool, !AnalyseInfo)
:: UnsafePatternBool :== Bool
not_an_unsafe_pattern (cc, _, ai) = (cc, False, ai)
instance consumerRequirements BoundVar instance consumerRequirements BoundVar
where where
consumerRequirements {var_info_ptr} ai=:{ai_heap} consumerRequirements {var_info_ptr} _ ai=:{ai_var_heap}
#! var_info = sreadPtr var_info_ptr ai_heap # (var_info, ai_var_heap) = readPtr var_info_ptr ai_var_heap
= continuation var_info ai = continuation var_info { ai & ai_var_heap=ai_var_heap }
where where
continuation (VI_AccVar temp_var arg_position) ai=:{ai_cur_ref_counts} continuation (VI_AccVar temp_var arg_position) ai=:{ai_cur_ref_counts}
| arg_position<0 // | arg_position<0
= (temp_var, ai) // = (temp_var, ai)
#! ref_count = ai_cur_ref_counts.[arg_position] #! ref_count = ai_cur_ref_counts.[arg_position]
ai_cur_ref_counts = { ai_cur_ref_counts & [arg_position]=min (ref_count+1) 2 } ai_cur_ref_counts = { ai_cur_ref_counts & [arg_position]=min (ref_count+1) 2 }
= (temp_var, { ai & ai_cur_ref_counts=ai_cur_ref_counts }) = (temp_var, False, { ai & ai_cur_ref_counts=ai_cur_ref_counts })
// continuation vi ai // continuation vi ai
// = (cPassive, ai) // = (cPassive, ai)
instance consumerRequirements Expression where instance consumerRequirements Expression where
consumerRequirements (Var var) ai consumerRequirements (Var var) common_defs ai
= consumerRequirements var ai = consumerRequirements var common_defs ai
consumerRequirements (App app) ai consumerRequirements (App app) common_defs ai
= consumerRequirements app ai = consumerRequirements app common_defs ai
consumerRequirements (fun_expr @ exprs) ai consumerRequirements (fun_expr @ exprs) common_defs ai
# (cc_fun, ai) = consumerRequirements fun_expr ai # (cc_fun, _, ai) = consumerRequirements fun_expr common_defs ai
ai_class_subst = unifyClassifications cActive cc_fun ai.ai_class_subst ai_class_subst = unifyClassifications cActive cc_fun ai.ai_class_subst
= consumerRequirements exprs { ai & ai_class_subst = ai_class_subst } = consumerRequirements exprs common_defs { ai & ai_class_subst = ai_class_subst }
consumerRequirements (Let {let_binds,let_expr}) ai=:{ai_next_var,ai_heap} consumerRequirements (Let {let_binds,let_expr}) common_defs ai=:{ai_next_var,ai_next_var_of_fun,ai_var_heap}
# (new_next_var, ai_heap) = init_variables let_binds ai_next_var ai_heap # (new_next_var, new_ai_next_var_of_fun, ai_var_heap) = init_variables let_binds ai_next_var ai_next_var_of_fun ai_var_heap
# ai = acc_requirements_of_let_binds let_binds ai_next_var { ai & ai_next_var = new_next_var, ai_heap = ai_heap } # ai = acc_requirements_of_let_binds let_binds ai_next_var common_defs
= consumerRequirements let_expr ai { ai & ai_next_var = new_next_var, ai_next_var_of_fun = new_ai_next_var_of_fun, ai_var_heap = ai_var_heap }
= consumerRequirements let_expr common_defs ai // XXX why not not_an_unsafe_pattern
where where
init_variables [{bind_dst={fv_info_ptr}} : binds] ai_next_var ai_heap init_variables [{bind_dst={fv_info_ptr}} : binds] ai_next_var ai_next_var_of_fun ai_var_heap
= init_variables binds (inc ai_next_var) = init_variables binds (inc ai_next_var) (inc ai_next_var_of_fun)
(write_ptr fv_info_ptr (VI_AccVar ai_next_var cNoFunArg) ai_heap "init_variables") (writePtr fv_info_ptr (VI_AccVar ai_next_var ai_next_var_of_fun) ai_var_heap)
init_variables [] ai_next_var ai_heap init_variables [] ai_next_var ai_next_var_of_fun ai_var_heap
= (ai_next_var, ai_heap) = (ai_next_var, ai_next_var_of_fun, ai_var_heap)
acc_requirements_of_let_binds [ {bind_src, bind_dst={fv_info_ptr}} : binds ] ai_next_var ai acc_requirements_of_let_binds [ {bind_src, bind_dst={fv_info_ptr}} : binds ] ai_next_var common_defs ai
# (bind_var, ai) = consumerRequirements bind_src ai # (bind_var, _, ai) = consumerRequirements bind_src common_defs ai
ai_class_subst = unifyClassifications ai_next_var bind_var ai.ai_class_subst ai_class_subst = unifyClassifications ai_next_var bind_var ai.ai_class_subst
= acc_requirements_of_let_binds binds (inc ai_next_var) { ai & ai_class_subst = ai_class_subst } = acc_requirements_of_let_binds binds (inc ai_next_var) common_defs { ai & ai_class_subst = ai_class_subst }
acc_requirements_of_let_binds [] ai_next_var ai acc_requirements_of_let_binds [] ai_next_var _ ai
= ai = ai
consumerRequirements (Case case_expr) ai consumerRequirements (Case case_expr) common_defs ai
= consumerRequirements case_expr ai = consumerRequirements case_expr common_defs ai
consumerRequirements (BasicExpr _ _) ai consumerRequirements (BasicExpr _ _) _ ai
= (cPassive, ai) = (cPassive, False, ai)
consumerRequirements (MatchExpr _ _ expr) ai consumerRequirements (MatchExpr _ _ expr) common_defs ai
= consumerRequirements expr ai = consumerRequirements expr common_defs ai
consumerRequirements (Selection _ expr selectors) ai consumerRequirements (Selection _ expr selectors) common_defs ai
# (cc, ai) = consumerRequirements expr ai # (cc, _, ai) = consumerRequirements expr common_defs ai
ai_class_subst = unifyClassifications cActive cc ai.ai_class_subst ai_class_subst = unifyClassifications cActive cc ai.ai_class_subst
ai = requirementsOfSelectors selectors { ai & ai_class_subst = ai_class_subst } ai = requirementsOfSelectors selectors common_defs { ai & ai_class_subst = ai_class_subst }
= (cPassive, ai) = (cPassive, False, ai)
consumerRequirements (Update expr1 selectors expr2) ai consumerRequirements (Update expr1 selectors expr2) common_defs ai
# (cc, ai) = consumerRequirements expr1 ai # (cc, _, ai) = consumerRequirements expr1 common_defs ai
ai = requirementsOfSelectors selectors ai ai = requirementsOfSelectors selectors common_defs ai
(cc, ai) = consumerRequirements expr2 ai (cc, _, ai) = consumerRequirements expr2 common_defs ai
= (cPassive, ai) = (cPassive, False, ai)
consumerRequirements (RecordUpdate cons_symbol expression expressions) ai consumerRequirements (RecordUpdate cons_symbol expression expressions) common_defs ai
# (cc, ai) = consumerRequirements expression ai # (cc, _, ai) = consumerRequirements expression common_defs ai
(cc, ai) = consumerRequirements expressions ai (cc, _, ai) = consumerRequirements expressions common_defs ai
= (cPassive, ai) = (cPassive, False, ai)
consumerRequirements (TupleSelect tuple_symbol arg_nr expr) ai consumerRequirements (TupleSelect tuple_symbol arg_nr expr) common_defs ai
= consumerRequirements expr ai = consumerRequirements expr common_defs ai
consumerRequirements (AnyCodeExpr _ _ _) ai consumerRequirements (AnyCodeExpr _ _ _) _ ai
= (cPassive, ai) = (cPassive, False, ai)
consumerRequirements (ABCCodeExpr _ _) ai