diff options
| -rw-r--r-- | frontend/analtypes.icl | 6 | ||||
| -rw-r--r-- | frontend/check.icl | 35 | ||||
| -rw-r--r-- | frontend/trans.icl | 110 |
3 files changed, 91 insertions, 60 deletions
diff --git a/frontend/analtypes.icl b/frontend/analtypes.icl index 3763652..ec209ef 100644 --- a/frontend/analtypes.icl +++ b/frontend/analtypes.icl @@ -243,11 +243,11 @@ where check_types_of_cons :: ![AType] !Bool !Index !Level ![TypeVar] !TypeAttribute ![AttrInequality] !Conditions !*TypeSymbols !*TypeInfo !*CheckState -> *(![AType], ![[ATypeVar]], ![AttrInequality], !TypeProperties, !Conditions, !Int, !*TypeSymbols, !*TypeInfo, !*CheckState) */ - new_local_kind_variables :: .[ATypeVar] *(*Heap TypeVarInfo,*Heap .KindInfo) -> (!Bool,!.Heap TypeVarInfo,!.Heap KindInfo); + new_local_kind_variables :: .[ATypeVar] *(*Heap TypeVarInfo,*Heap KindInfo) -> (!Bool,!.Heap TypeVarInfo,!.Heap KindInfo); new_local_kind_variables td_args (type_var_heap, as_kind_heap) = foldSt new_kind td_args (True, type_var_heap, as_kind_heap) where - new_kind :: ATypeVar *(.Bool,*Heap TypeVarInfo,*Heap .KindInfo) -> (!Bool,!.Heap TypeVarInfo,!.Heap KindInfo); + new_kind :: ATypeVar *(.Bool,*Heap TypeVarInfo,*Heap KindInfo) -> (!Bool,!.Heap TypeVarInfo,!.Heap KindInfo); new_kind {atv_variable={tv_info_ptr},atv_attribute} (coercible, type_var_heap, kind_heap) # (kind_info_ptr, kind_heap) = newPtr KI_Const kind_heap = (coercible && is_not_a_variable atv_attribute, type_var_heap <:= (tv_info_ptr, TVI_TypeKind kind_info_ptr), @@ -295,7 +295,7 @@ emptyIdent name :== { id_name = name, id_info = nilPtr } newKindVariables td_args (type_var_heap, as_kind_heap) = mapSt new_kind td_args (type_var_heap, as_kind_heap) where - new_kind :: ATypeVar *(*Heap TypeVarInfo,*Heap .KindInfo) -> (!.TypeKind,!(!.Heap TypeVarInfo,!.Heap KindInfo)); + new_kind :: ATypeVar *(*Heap TypeVarInfo,*Heap KindInfo) -> (!.TypeKind,!(!.Heap TypeVarInfo,!.Heap KindInfo)); new_kind {atv_variable={tv_info_ptr}} (type_var_heap, kind_heap) # (kind_info_ptr, kind_heap) = newPtr KI_Const kind_heap = (KindVar kind_info_ptr, (type_var_heap <:= (tv_info_ptr, TVI_TypeKind kind_info_ptr), kind_heap <:= (kind_info_ptr, KI_Var kind_info_ptr))) diff --git a/frontend/check.icl b/frontend/check.icl index daf7d7b..ae7d3f6 100644 --- a/frontend/check.icl +++ b/frontend/check.icl @@ -2523,14 +2523,23 @@ where # ({fun_symb, fun_pos}, fun_defs) = fun_defs![dcl_index] = ([{ dcl_ident = fun_symb, dcl_pos = fun_pos, dcl_kind = STE_FunctionOrMacro [], dcl_index = dcl_index } : defs], fun_defs) +gimme_a_lazy_array_type :: !u:{.a} -> v:{.a}, [u<=v] +gimme_a_lazy_array_type a = a + +gimme_a_strict_array_type :: !u:{!.a} -> v:{!.a}, [u<=v] +gimme_a_strict_array_type a = a + +renumber_icl_definitions_as_dcl_definitions :: !ModuleKind ![Declaration] !*{#DclModule} !*CommonDefs !{#Int} !*CheckState + -> (![Declaration], !.{#DclModule}, !.CommonDefs, !.CheckState) renumber_icl_definitions_as_dcl_definitions MK_Main icl_decl_symbols modules cdefs icl_sizes cs = (icl_decl_symbols,modules,cdefs,cs) renumber_icl_definitions_as_dcl_definitions _ icl_decl_symbols modules cdefs icl_sizes cs #! main_dcl_module_n=cs.cs_x.x_main_dcl_module_n # (dcl_mod,modules) = modules![main_dcl_module_n] # (Yes conversion_table) = dcl_mod.dcl_conversions - # icl_to_dcl_index_table = {create_icl_to_dcl_index_table_for_kind table_size dcl_to_icl_table \\ table_size <-: icl_sizes & dcl_to_icl_table <-: conversion_table } + # icl_to_dcl_index_table = gimme_a_lazy_array_type {create_icl_to_dcl_index_table_for_kind table_size dcl_to_icl_table \\ table_size <-: icl_sizes & dcl_to_icl_table <-: conversion_table } with + create_icl_to_dcl_index_table_for_kind :: !Int !{#Int} -> {#Int} create_icl_to_dcl_index_table_for_kind table_size dcl_to_icl_table # icl_to_dcl_index_table_for_kind = {createArray table_size NoIndex & [dcl_to_icl_table.[dcl_index]]=dcl_index \\ dcl_index<- [0..size dcl_to_icl_table-1]} #! max_index=size icl_to_dcl_index_table_for_kind-1 @@ -2769,7 +2778,7 @@ check_module1 {mod_type,mod_name,mod_imports,mod_imported_objects,mod_defs = cde first_inst_index = length fun_defs + size functions_and_macros (inst_fun_defs, def_instances) = convert_class_instances cdefs.def_instances first_inst_index - new_icl_functions = { next_fun \\ next_fun <- fun_defs ++ inst_fun_defs } + new_icl_functions = gimme_a_strict_array_type { next_fun \\ next_fun <- fun_defs ++ inst_fun_defs } icl_functions = {if (i<size functions_and_macros) functions_and_macros.[i] new_icl_functions.[i-size functions_and_macros] \\ i<-[0..size functions_and_macros+size new_icl_functions-1]} @@ -2785,8 +2794,8 @@ check_module1 {mod_type,mod_name,mod_imports,mod_imported_objects,mod_defs = cde (scanned_modules, icl_functions, cs) = add_dcl_module_predef_module_and_modules_to_symbol_table optional_dcl_mod optional_pre_def_mod scanned_modules (size dcl_modules) icl_functions cs - init_new_dcl_modules = { initialDclModule scanned_module module_n \\ scanned_module <- scanned_modules & module_n<-[size dcl_modules..]} - + init_new_dcl_modules = gimme_a_strict_array_type { initialDclModule scanned_module module_n \\ scanned_module <- scanned_modules & module_n<-[size dcl_modules..]} + init_dcl_modules = {if (i<size dcl_modules) dcl_modules.[i] init_new_dcl_modules.[i-size dcl_modules] \\ i<-[0..size dcl_modules+size init_new_dcl_modules-1]} = (mod_name,mod_imported_objects,mod_imports,mod_type,icl_global_function_range,nr_of_functions,first_inst_index,local_defs,icl_functions,init_dcl_modules,main_dcl_module_n,cdefs,sizes,cs) @@ -2882,6 +2891,7 @@ replace_icl_macros_by_dcl_macros _ {ir_from=first_icl_macro_index,ir_to=end_icl_ # (Yes dcl_to_icl_table) = dcl_conversions # macro_renumber_table = create_icl_to_dcl_index_table_for_kind dcl_to_icl_table.[cMacroDefs] with + create_icl_to_dcl_index_table_for_kind :: !{#Int} -> {#Int} create_icl_to_dcl_index_table_for_kind dcl_to_icl_table = {createArray (end_icl_macro_index-first_icl_macro_index) NoIndex & [dcl_to_icl_table.[dcl_index]-first_icl_macro_index]=dcl_index \\ dcl_index<- [0..size dcl_to_icl_table-1]} # decls = replace_icl_macros_by_dcl_macros decls @@ -2900,7 +2910,11 @@ replace_icl_macros_by_dcl_macros _ {ir_from=first_icl_macro_index,ir_to=end_icl_ = [] = (decls,dcl_modules,cs) -check_module2 :: Ident [.ImportedObject] .[Import ImportDeclaration] .ModuleKind !.IndexRange !.IndexRange !Int !Int (Optional (Module a)) [.Declaration] *{#FunDef} *{#DclModule} (CollectedDefinitions ClassInstance IndexRange) *{#.Int} *Heaps *CheckState -> (!Bool,!.IclModule,!.{#DclModule},.{!Group},!Optional {#Int},!.{#FunDef},!Int,!.Heaps,!.{#PredefinedSymbol},!.Heap SymbolTableEntry,!.File); +check_module2 :: Ident [.ImportedObject] .[Import ImportDeclaration] .ModuleKind !.IndexRange !.IndexRange !Int !Int + (Optional (Module a)) [.Declaration] *{#FunDef} *{#DclModule} (CollectedDefinitions ClassInstance IndexRange) + *{#.Int} *Heaps *CheckState + -> (!Bool,!.IclModule,!.{#DclModule},.{!Group},!Optional {#Int},!.{#FunDef},!Int,!.Heaps,!.{#PredefinedSymbol}, + !.Heap SymbolTableEntry,!.File); check_module2 mod_name mod_imported_objects mod_imports mod_type icl_global_function_range icl_instance_range nr_of_functions n_functions_and_macros_in_dcl_modules optional_pre_def_mod local_defs icl_functions init_dcl_modules cdefs sizes heaps cs # (icl_sizes_without_added_dcl_defs, sizes) = memcpy sizes (dcl_modules, local_defs, cdefs, icl_sizes, cs) @@ -2925,12 +2939,7 @@ check_module2 mod_name mod_imported_objects mod_imports mod_type icl_global_func // ii_modules = print_imported_modules 0 ii_modules (used_module_numbers,ii_modules) = compute_used_module_numbers imported_module_numbers imported_module_numbers ii_modules # -// (nr_of_modules, (f_consequences, ii_modules, icl_functions, hp_expression_heap, cs)) -// = check_completeness_of_all_dcl_modules ii_modules icl_functions heaps.hp_expression_heap cs - (nr_of_modules, ii_modules) = usize ii_modules - (nr_functions, icl_functions) = usize icl_functions - f_consequences = create_empty_consequences_array nr_functions hp_expression_heap = heaps.hp_expression_heap (dcls_explicit, dcl_modules, cs) = addImportsToSymbolTable mod_imports [] ii_modules cs @@ -3408,14 +3417,9 @@ checkDclModule is_on_cycle {mod_name,mod_imports,mod_defs} mod_index modules icl nr_of_dcl_functions = size dcl_mod.dcl_functions - (nr_functions, icl_functions) = usize icl_functions - f_consequences = create_empty_consequences_array nr_functions -// dcls_explicit = flatten [dcls_explicit \\ (_,{dcls_explicit})<-imports] dcls_explicit = flatten [[dcls_explicit\\dcls_explicit<-:dcls_explicit] \\ (_,{dcls_explicit})<-imports] #! main_dcl_module_n = cs.cs_x.x_main_dcl_module_n -// # (_,modules,icl_functions,hp_expression_heap,cs) -// = check_completeness_of_module mod_index main_dcl_module_n dcls_explicit (mod_name.id_name+++".dcl") (f_consequences, modules, icl_functions, hp_expression_heap, cs) # (dcl_common, modules, hp_type_heaps, hp_var_heap, cs) = checkCommonDefinitions cIsADclModule mod_index dcl_common modules hp_type_heaps hp_var_heap cs @@ -3423,7 +3427,6 @@ checkDclModule is_on_cycle {mod_name,mod_imports,mod_defs} mod_index modules icl = determineTypesOfInstances nr_of_dcl_functions mod_index dcl_common modules hp_type_heaps hp_var_heap cs (nr_of_dcl_funs_insts_and_specs, rev_function_list, rev_special_defs, com_type_defs, com_class_defs, modules, heaps, cs) = checkDclFunctions mod_index nr_of_dcl_functions_and_instances mod_defs.def_funtypes -// dcl_common.com_type_defs dcl_common.com_class_defs modules { heaps & hp_type_heaps = hp_type_heaps, hp_var_heap = hp_var_heap } cs dcl_common.com_type_defs dcl_common.com_class_defs modules { heaps & hp_type_heaps = hp_type_heaps, hp_var_heap = hp_var_heap, hp_expression_heap=hp_expression_heap} cs (nr_of_dcl_funs_insts_and_specs, new_class_instances, rev_special_defs, all_spec_types, heaps, cs_error) diff --git a/frontend/trans.icl b/frontend/trans.icl index 07eb792..f6ca37b 100644 --- a/frontend/trans.icl +++ b/frontend/trans.icl @@ -95,6 +95,7 @@ where , ai_next_var :: !Int , ai_next_var_of_fun :: !Int , ai_cases_of_vars_for_function :: ![Case] + , ai_main_dcl_module_n :: !Int } :: SharedAI = @@ -295,32 +296,31 @@ where = ai instance consumerRequirements App where - consumerRequirements {app_symb={symb_kind = SK_Function {glob_module,glob_object}, symb_arity, symb_name}, app_args} common_defs ai=:{ai_cons_class} - | glob_module == cIclModIndex + consumerRequirements {app_symb={symb_kind = SK_Function {glob_module,glob_object}, symb_arity, symb_name}, app_args} common_defs ai=:{ai_cons_class,ai_main_dcl_module_n} + | glob_module == ai_main_dcl_module_n | glob_object < size ai_cons_class #! fun_class = ai_cons_class.[glob_object] = reqs_of_args fun_class.cc_args app_args cPassive common_defs ai = consumerRequirements app_args common_defs ai = consumerRequirements app_args common_defs ai - where - reqs_of_args _ [] cumm_arg_class _ ai - = (cumm_arg_class, False, ai) - reqs_of_args [] _ cumm_arg_class _ ai - = (cumm_arg_class, False, ai) - reqs_of_args [form_cc : ccs] [arg : args] cumm_arg_class common_defs ai - # (act_cc, _, ai) = consumerRequirements arg common_defs ai - ai_class_subst = unifyClassifications form_cc act_cc ai.ai_class_subst - = reqs_of_args ccs args (combineClasses act_cc cumm_arg_class) common_defs { ai & ai_class_subst = ai_class_subst } - -/* - consumerRequirements {app_symb={symb_kind = SK_InternalFunction _}, app_args=[arg:_]} ai - # (cc, ai) = consumerRequirements arg ai - ai_class_subst = unifyClassifications cActive cc ai.ai_class_subst - = (cPassive, { ai & ai_class_subst = ai_class_subst }) -*/ + consumerRequirements {app_symb={symb_kind = SK_LocalMacroFunction glob_object, symb_arity, symb_name}, app_args} common_defs ai=:{ai_cons_class,ai_main_dcl_module_n} + | glob_object < size ai_cons_class + #! fun_class = ai_cons_class.[glob_object] + = reqs_of_args fun_class.cc_args app_args cPassive common_defs ai + = consumerRequirements app_args common_defs ai consumerRequirements {app_args} common_defs ai = not_an_unsafe_pattern (consumerRequirements app_args common_defs ai) +reqs_of_args _ [] cumm_arg_class _ ai + = (cumm_arg_class, False, ai) +reqs_of_args [] _ cumm_arg_class _ ai + = (cumm_arg_class, False, ai) +reqs_of_args [form_cc : ccs] [arg : args] cumm_arg_class common_defs ai + # (act_cc, _, ai) = consumerRequirements arg common_defs ai + ai_class_subst = unifyClassifications form_cc act_cc ai.ai_class_subst + = reqs_of_args ccs args (combineClasses act_cc cumm_arg_class) common_defs { ai & ai_class_subst = ai_class_subst } + + instance consumerRequirements Case where consumerRequirements kees=:{case_expr,case_guards,case_default,case_info_ptr} common_defs ai # (cce, _, ai) = consumerRequirements case_expr common_defs ai @@ -483,9 +483,9 @@ independentConsumerRequirements exprs common_defs ai=:{ai_cur_ref_counts} unify_ref_counts 2 _ = 2 -analyseGroups :: !{# CommonDefs} !IndexRange !*{! Group} !*{#FunDef} !*VarHeap !*ExpressionHeap +analyseGroups :: !{# CommonDefs} !IndexRange !Int !*{! Group} !*{#FunDef} !*VarHeap !*ExpressionHeap -> (!CleanupInfo, !*{! ConsClasses}, !*{! Group}, !*{#FunDef}, !*VarHeap, !*ExpressionHeap) -analyseGroups common_defs {ir_from, ir_to} groups fun_defs var_heap expr_heap +analyseGroups common_defs {ir_from, ir_to} main_dcl_module_n 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 @@ -502,7 +502,8 @@ where ai_cur_ref_counts = {}, ai_class_subst = initial_subst, ai_next_var = nr_of_vars, ai_next_var_of_fun = 0, - ai_cases_of_vars_for_function = [] } fun_defs + ai_cases_of_vars_for_function = [], + ai_main_dcl_module_n=main_dcl_module_n } fun_defs class_env = collect_classifications group_members ai.ai_cons_class ai.ai_class_subst (cleanup_info, class_env, fun_defs, var_heap, expr_heap) = foldSt set_case_expr_info (flatten ai_cases_of_vars_for_group) (cleanup_info,class_env, fun_defs, ai.ai_var_heap, expr_heap) @@ -614,6 +615,7 @@ mapAndLength f [] , ro_root_case_mode :: !RootCaseMode , ro_fun :: !SymbIdent , ro_fun_args :: ![FreeVar] + , ro_main_dcl_module_n :: !Int } :: RootCaseMode = NotRootCase | RootCase | RootCaseOfZombie @@ -791,6 +793,8 @@ transformCase this_case=:{case_expr,case_guards,case_default,case_ident,case_inf where equal (SK_Function glob_index1) (SK_Function glob_index2) = glob_index1==glob_index2 + equal (SK_LocalMacroFunction glob_index1) (SK_LocalMacroFunction glob_index2) + = glob_index1==glob_index2 equal (SK_GeneratedFunction _ index1) (SK_GeneratedFunction _ index2) = index1==index2 equal _ _ @@ -960,6 +964,9 @@ possibly_generate_case_function kees=:{case_info_ptr} aci=:{aci_free_vars} ro ti get_fun_def_and_cons_args (SK_Function {glob_object}) cons_args fun_defs fun_heap # (fun_def, fun_defs) = fun_defs![glob_object] = (fun_def, cons_args.[glob_object], fun_defs, fun_heap) + get_fun_def_and_cons_args (SK_LocalMacroFunction glob_object) cons_args fun_defs fun_heap + # (fun_def, fun_defs) = fun_defs![glob_object] + = (fun_def, cons_args.[glob_object], fun_defs, fun_heap) get_fun_def_and_cons_args (SK_GeneratedFunction fun_info_ptr fun_index) cons_args fun_defs fun_heap | fun_index < size fun_defs # (fun_def, fun_defs) = fun_defs![fun_index] @@ -1341,13 +1348,13 @@ where (opt_body, var_names, fun_defs, fun_heap) = case producer of (PR_Curried {symb_arity, symb_kind=SK_Function {glob_module}}) - | glob_module <> cIclModIndex + | glob_module <> ro.ro_main_dcl_module_n // we do not have good names for the formal variables of that function: invent some -> (NoBody, repeatn symb_arity { id_name = "_x", id_info = nilPtr }, fun_defs, fun_heap) // go further with next alternative _ # ({fun_body=fun_body=:TransformedBody tb}, fun_defs, fun_heap) - = get_fun_def symbol.symb_kind fun_defs fun_heap + = get_fun_def symbol.symb_kind ro.ro_main_dcl_module_n fun_defs fun_heap -> (fun_body, take nr_of_applied_args [ fv_name \\ {fv_name}<-tb.tb_args ], fun_defs, fun_heap) (form_vars, act_vars, var_heap) = build_var_args (reverse var_names) vars [] var_heap @@ -1382,13 +1389,16 @@ where = symbol get_producer_type {symb_kind=SK_Function {glob_module, glob_object}} ro fun_defs fun_heap - | glob_module == cIclModIndex + | glob_module == ro.ro_main_dcl_module_n # ({fun_type=Yes symbol_type}, fun_defs) = fun_defs![glob_object] = (symbol_type, fun_defs, fun_heap) # {ft_type} = ro.ro_imported_funs.[glob_module].[glob_object] st_args = addTypesOfDictionaries ro.ro_common_defs ft_type.st_context ft_type.st_args = ({ft_type & st_args = st_args, st_arity = length st_args, st_context = [] }, fun_defs, fun_heap) + get_producer_type {symb_kind=SK_LocalMacroFunction glob_object} ro fun_defs fun_heap + # ({fun_type=Yes symbol_type}, fun_defs) = fun_defs![glob_object] + = (symbol_type, fun_defs, fun_heap) get_producer_type {symb_kind=SK_GeneratedFunction fun_ptr _} ro fun_defs fun_heap # (FI_Function {gf_fun_def={fun_type=Yes symbol_type}}, fun_heap) = readPtr fun_ptr fun_heap = (symbol_type, fun_defs, fun_heap) @@ -1397,7 +1407,11 @@ where # (opt_cons_classes, fun_heap) = case symb_kind of SK_Function {glob_module, glob_object} - | glob_module == cIclModIndex && glob_object < size ti_cons_args + | glob_module == ro.ro_main_dcl_module_n && glob_object < size ti_cons_args + -> (Yes ti_cons_args.[glob_object], fun_heap) + -> (No, fun_heap) + SK_LocalMacroFunction glob_object + | glob_object < size ti_cons_args -> (Yes ti_cons_args.[glob_object], fun_heap) -> (No, fun_heap) SK_GeneratedFunction fun_ptr fun_index @@ -1417,12 +1431,15 @@ where -> ({cc_size = symb_arity, cc_args = repeatn symb_arity cPassive, cc_linear_bits = repeatn symb_arity linear_bit}, fun_heap) - get_fun_def (SK_Function {glob_module, glob_object}) fun_defs fun_heap - | glob_module<>cIclModIndex + get_fun_def (SK_Function {glob_module, glob_object}) main_dcl_module_n fun_defs fun_heap + | glob_module<>main_dcl_module_n = abort "sanity check 2 failed in module trans" # (fun_def, fun_defs) = fun_defs![glob_object] = (fun_def, fun_defs, fun_heap) - get_fun_def (SK_GeneratedFunction fun_ptr _) fun_defs fun_heap + get_fun_def (SK_LocalMacroFunction glob_object) main_dcl_module_n fun_defs fun_heap + # (fun_def, fun_defs) = fun_defs![glob_object] + = (fun_def, fun_defs, fun_heap) + get_fun_def (SK_GeneratedFunction fun_ptr _) main_dcl_module_n fun_defs fun_heap # (FI_Function {gf_fun_def}, fun_heap) = readPtr fun_ptr fun_heap = (gf_fun_def, fun_defs, fun_heap) @@ -1482,13 +1499,20 @@ where max_group_index_of_producer prod current_max fun_defs fun_heap cons_args = abort ("trans.icl: max_group_index_of_producer" ---> prod) + ro_main_dcl_module_n = ro.ro_main_dcl_module_n + max_group_index_of_member fun_defs fun_heap cons_args current_max (App {app_symb = {symb_name, symb_kind = SK_Function { glob_object = fun_index, glob_module = mod_index}}}) - | mod_index == cIclModIndex + | mod_index == ro_main_dcl_module_n | fun_index < size cons_args # {fun_info = {fi_group_index}} = fun_defs.[fun_index] = max fi_group_index current_max = current_max = current_max + max_group_index_of_member fun_defs fun_heap cons_args current_max (App {app_symb = {symb_name, symb_kind = SK_LocalMacroFunction fun_index}}) + | fun_index < size cons_args + # {fun_info = {fi_group_index}} = fun_defs.[fun_index] + = max fi_group_index current_max + = current_max max_group_index_of_member fun_defs fun_heap cons_args current_max (App {app_symb = {symb_kind = SK_GeneratedFunction fun_ptr _ }}) # (FI_Function {gf_fun_def={fun_info = {fi_group_index}}}) = sreadPtr fun_ptr fun_heap = max fi_group_index current_max @@ -1726,7 +1750,7 @@ where transformApplication :: !App ![Expression] !ReadOnlyTI !*TransformInfo -> *(!Expression,!*TransformInfo) transformApplication app=:{app_symb=symb=:{symb_kind = SK_Function {glob_module, glob_object},symb_arity}, app_args} extra_args ro ti=:{ti_cons_args,ti_instances,ti_fun_defs} - | glob_module == cIclModIndex + | glob_module == ro.ro_main_dcl_module_n | glob_object < size ti_cons_args #! cons_class = ti_cons_args.[glob_object] (instances, ti_instances) = ti_instances![glob_object] @@ -1820,7 +1844,7 @@ determineProducer is_applied_to_macro_fun linear_bit app=:{app_symb = symb=:{sym = ({ producers & [prod_index] = PR_Curried symb}, app_args ++ new_args, ti) = (producers, [App app : new_args ], ti) #! max_index = size ti.ti_cons_args - | glob_module <> cIclModIndex || glob_object >= max_index /* Sjaak, to skip array functions */ + | glob_module <> ro.ro_main_dcl_module_n || glob_object >= max_index /* Sjaak, to skip array functions */ = (producers, [App app : new_args ], ti) # ({fun_body}, ti_fun_defs) = (ti.ti_fun_defs)![glob_object] ti = { ti & ti_fun_defs=ti_fun_defs } @@ -1831,7 +1855,7 @@ determineProducer is_applied_to_macro_fun linear_bit app=:{app_symb = symb=:{sym = (producers, [App app : new_args ], ti) where get_fun_arity glob_module glob_object ro ti - | glob_module <> cIclModIndex + | glob_module <> ro.ro_main_dcl_module_n # {st_arity, st_context} = ro.ro_imported_funs.[glob_module].[glob_object].ft_type = (st_arity+length st_context, ti) // for imported functions you have to add ft_arity and length st_context, but for unimported @@ -1908,11 +1932,11 @@ where :: ImportedConstructors :== [Global Index] -transformGroups :: !CleanupInfo !*{! Group} !*{#FunDef} !{!.ConsClasses} !{# CommonDefs} !{# {# FunType} } +transformGroups :: !CleanupInfo !Int !*{! Group} !*{#FunDef} !{!.ConsClasses} !{# CommonDefs} !{# {# FunType} } !*{#{# CheckedTypeDef}} !ImportedConstructors !*VarHeap !*TypeHeaps !*ExpressionHeap -> (!*{! Group}, !*{#FunDef}, !*{#{# CheckedTypeDef}}, !ImportedConstructors, !*VarHeap, !*TypeHeaps, !*ExpressionHeap) -transformGroups cleanup_info groups fun_defs cons_args common_defs imported_funs imported_types collected_imports var_heap type_heaps symbol_heap +transformGroups cleanup_info main_dcl_module_n groups fun_defs cons_args common_defs imported_funs imported_types collected_imports var_heap type_heaps symbol_heap #! (nr_of_funs, fun_defs) = usize fun_defs # (groups, imported_types, collected_imports, ti) = transform_groups 0 groups common_defs imported_funs imported_types collected_imports @@ -1949,12 +1973,13 @@ where , ro_root_case_mode = get_root_case_mode tb , ro_fun = fun_def_to_symb_ident fun fun_def , ro_fun_args = tb.tb_args + , ro_main_dcl_module_n = main_dcl_module_n } (fun_rhs, ti) = transform tb.tb_rhs ro { ti & ti_fun_defs = ti_fun_defs } = { ti & ti_fun_defs = {ti.ti_fun_defs & [fun] = { fun_def & fun_body = TransformedBody { tb & tb_rhs = fun_rhs }}}} where fun_def_to_symb_ident fun_index {fun_symb,fun_arity} - = { symb_name=fun_symb, symb_kind=SK_Function {glob_object=fun_index, glob_module=cIclModIndex } , symb_arity=fun_arity } + = { symb_name=fun_symb, symb_kind=SK_Function {glob_object=fun_index, glob_module=main_dcl_module_n } , symb_arity=fun_arity } get_root_case_mode {tb_rhs=Case _} = RootCase get_root_case_mode _ = NotRootCase @@ -1966,7 +1991,8 @@ where group_index = gf_fun_def.fun_info.fi_group_index # (Yes ft=:{st_args,st_result}) = gf_fun_def.fun_type ((st_result,st_args), {ets_type_defs, ets_collected_conses, ets_type_heaps, ets_var_heap}) = expandSynTypes common_defs (st_result,st_args) - { ets_type_defs = imported_types, ets_collected_conses = collected_imports, ets_type_heaps = type_heaps, ets_var_heap = var_heap } + { ets_type_defs = imported_types, ets_collected_conses = collected_imports, ets_type_heaps = type_heaps, ets_var_heap = var_heap, + ets_main_dcl_module_n=main_dcl_module_n } # (group, groups) = groups![group_index] = ({ groups & [group_index] = { group & group_members = [gf_fun_index : group.group_members]} }, [ { gf_fun_def & fun_type = Yes { ft & st_result = st_result, st_args = st_args }} : fun_defs], @@ -1975,7 +2001,7 @@ where convert_function_type common_defs fun_index (fun_defs, imported_types, collected_imports, type_heaps, var_heap) # (fun_def=:{fun_type = Yes fun_type}, fun_defs) = fun_defs![fun_index] (fun_type, imported_types, collected_imports, type_heaps, var_heap) - = convertSymbolType common_defs fun_type imported_types collected_imports type_heaps var_heap + = convertSymbolType common_defs fun_type main_dcl_module_n imported_types collected_imports type_heaps var_heap = ({ fun_defs & [fun_index] = { fun_def & fun_type = Yes fun_type }}, imported_types, collected_imports, type_heaps, var_heap) cleanup expr_info_ptr symbol_heap @@ -1991,11 +2017,12 @@ set_extended_expr_info expr_info_ptr extension expr_info_heap -> expr_info_heap <:= (expr_info_ptr, EI_Extended extension ei) ei -> expr_info_heap <:= (expr_info_ptr, EI_Extended extension ei) -convertSymbolType :: !{# CommonDefs} !SymbolType !*{#{# CheckedTypeDef}} !ImportedConstructors !*TypeHeaps !*VarHeap +convertSymbolType :: !{# CommonDefs} !SymbolType !Int !*{#{# CheckedTypeDef}} !ImportedConstructors !*TypeHeaps !*VarHeap -> (!SymbolType, !*{#{# CheckedTypeDef}}, !ImportedConstructors, !*TypeHeaps, !*VarHeap) -convertSymbolType common_defs st imported_types collected_imports type_heaps var_heap +convertSymbolType common_defs st main_dcl_module_n imported_types collected_imports type_heaps var_heap # (st, {ets_type_defs, ets_collected_conses, ets_type_heaps, ets_var_heap}) = expandSynTypes common_defs st - { ets_type_defs = imported_types, ets_collected_conses = collected_imports, ets_type_heaps= type_heaps, ets_var_heap = var_heap } + { ets_type_defs = imported_types, ets_collected_conses = collected_imports, ets_type_heaps= type_heaps, ets_var_heap = var_heap, + ets_main_dcl_module_n=main_dcl_module_n } = (st, ets_type_defs, ets_collected_conses, ets_type_heaps, ets_var_heap) :: ExpandTypeState = @@ -2003,6 +2030,7 @@ convertSymbolType common_defs st imported_types collected_imports type_heaps va , ets_collected_conses :: !ImportedConstructors , ets_type_heaps :: !.TypeHeaps , ets_var_heap :: !.VarHeap + , ets_main_dcl_module_n :: !Int } addTypesOfDictionaries :: !{#CommonDefs} ![TypeContext] ![AType] -> [AType] @@ -2071,7 +2099,7 @@ expand_syn_types_in_TA common_defs type_symb=:{type_index={glob_object,glob_modu -> expandSynTypes common_defs type { ets & ets_type_heaps = ets_type_heaps } _ # (types, ets) = expandSynTypes common_defs types ets - | glob_module == cIclModIndex + | glob_module == ets.ets_main_dcl_module_n -> ( TA type_symb types, ets) -> ( TA type_symb types, collect_imported_constructors common_defs glob_module td_rhs ets) where |