diff options
| author | johnvg | 2001-10-18 11:33:45 +0000 |
|---|---|---|
| committer | johnvg | 2001-10-18 11:33:45 +0000 |
| commit | ddda5856e49c82fb6d5a4a94dae46a93ceade138 (patch) | |
| tree | 9a230fd07c464bed267be66bab103c62901860ec /frontend | |
| parent | Bug fixes: too many error messages were printed (diff) | |
store macros and local functions in macros in separate {#{#FunDef}},
remove conversion table, except for macros
git-svn-id: https://svn.cs.ru.nl/repos/clean-compiler/trunk@863 1f8540f1-abd5-4d5b-9d24-4c5ce8603e2d
Diffstat (limited to 'frontend')
33 files changed, 2156 insertions, 1906 deletions
diff --git a/frontend/StdCompare.icl b/frontend/StdCompare.icl index 12978bb..10a9455 100644 --- a/frontend/StdCompare.icl +++ b/frontend/StdCompare.icl @@ -99,6 +99,7 @@ instance == Priority where (==) NoPrio NoPrio = True (==) (Prio assoc1 prio1) (Prio assoc2 prio2) = assoc1==assoc2 && prio1==prio2 + (==) _ _ = False instance == Assoc where @@ -137,6 +138,7 @@ where // compare_indexes (SK_InternalFunction i1) (SK_InternalFunction i2) = i1 =< i2 compare_indexes (SK_OverloadedFunction i1) (SK_OverloadedFunction i2) = i1 =< i2 compare_indexes (SK_GeneratedFunction _ i1) (SK_GeneratedFunction _ i2) = i1 =< i2 + compare_indexes (SK_LocalDclMacroFunction i1) (SK_LocalDclMacroFunction i2) = i1 =< i2 | less_constructor symb1 symb2 = Smaller diff --git a/frontend/analtypes.dcl b/frontend/analtypes.dcl index 96f8d2d..1f29066 100644 --- a/frontend/analtypes.dcl +++ b/frontend/analtypes.dcl @@ -12,7 +12,7 @@ analyseTypeDefs :: !{#CommonDefs} !TypeGroups !*TypeDefInfos !*TypeVarHeap !*Err determineKindsOfClasses :: !NumberSet !{#CommonDefs} !*TypeDefInfos !*TypeVarHeap !*ErrorAdmin -> (!*ClassDefInfos, !*TypeDefInfos, !*TypeVarHeap, !*ErrorAdmin) -checkKindsOfCommonDefsAndFunctions :: !Index !Index !NumberSet !IndexRange !{#CommonDefs} !u:{# FunDef} !v:{#DclModule} !*TypeDefInfos !*ClassDefInfos +checkKindsOfCommonDefsAndFunctions :: !Index !Index !NumberSet ![IndexRange] !{#CommonDefs} !u:{# FunDef} !v:{#DclModule} !*TypeDefInfos !*ClassDefInfos !*TypeVarHeap !*ErrorAdmin -> (!u:{# FunDef}, !v:{#DclModule}, !*TypeDefInfos, !*TypeVarHeap, !*ErrorAdmin) isATopConsVar cv :== cv < 0 diff --git a/frontend/analtypes.icl b/frontend/analtypes.icl index fcc2b5f..fabbafe 100644 --- a/frontend/analtypes.icl +++ b/frontend/analtypes.icl @@ -30,15 +30,32 @@ partionateAndExpandTypes :: !NumberSet !Index !*CommonDefs !*{#DclModule} !*Type -> (!TypeGroups, !*{# CommonDefs}, !*TypeDefInfos, !*CommonDefs, !*{#DclModule}, !*TypeHeaps, !*ErrorAdmin) partionateAndExpandTypes used_module_numbers main_dcl_module_index icl_common=:{com_type_defs,com_class_defs} dcl_modules type_heaps error #! nr_of_modules = size dcl_modules - #! nr_of_types_in_icl_mod = size com_type_defs - size com_class_defs +// #! nr_of_types_in_icl_mod = size com_type_defs - size com_class_defs + #! n_exported_dictionaries = size dcl_modules.[main_dcl_module_index].dcl_common.com_class_defs + #! index_of_first_not_exported_type_or_dictionary = size dcl_modules.[main_dcl_module_index].dcl_common.com_type_defs + #! n_exported_icl_types = index_of_first_not_exported_type_or_dictionary - n_exported_dictionaries + #! n_types_without_not_exported_dictionaries = size com_type_defs - (size com_class_defs - n_exported_dictionaries) # (dcl_type_defs, dcl_modules, new_type_defs, new_marks, type_def_infos) - = copy_type_defs_and_create_marks_and_infos used_module_numbers main_dcl_module_index nr_of_types_in_icl_mod nr_of_modules (com_type_defs, dcl_modules) + = copy_type_defs_and_create_marks_and_infos used_module_numbers main_dcl_module_index n_types_without_not_exported_dictionaries nr_of_modules (com_type_defs, dcl_modules) pi = {pi_marks = new_marks, pi_type_defs = new_type_defs, pi_type_def_infos = type_def_infos, pi_next_num = 0, pi_deps = [], pi_next_group_num = 0, pi_groups = [], pi_error = error } {pi_error,pi_groups,pi_type_defs,pi_type_def_infos} = iFoldSt partionate_type_defs 0 nr_of_modules pi - + with + partionate_type_defs mod_index pi=:{pi_marks} + #! nr_of_typedefs_to_be_examined = size pi_marks.[mod_index] + | mod_index == main_dcl_module_index + # pi = iFoldSt (partitionate_type_def mod_index) 0 n_exported_icl_types pi + = iFoldSt (partitionate_type_def mod_index) index_of_first_not_exported_type_or_dictionary nr_of_typedefs_to_be_examined pi + = iFoldSt (partitionate_type_def mod_index) 0 nr_of_typedefs_to_be_examined pi + where + partitionate_type_def module_index type_index pi=:{pi_marks} + # mark = pi_marks.[module_index, type_index] + | mark == cNotPartitionated + # (_, pi) = partitionateTypeDef {gi_module = module_index, gi_index = type_index} pi + = pi + = pi | not pi_error.ea_ok # (icl_type_defs, type_defs) = replace pi_type_defs main_dcl_module_index dcl_type_defs (dcl_modules, common_defs) = update_modules_and_create_commondefs used_module_numbers type_defs nr_of_modules dcl_modules @@ -50,38 +67,27 @@ partionateAndExpandTypes used_module_numbers main_dcl_module_index icl_common=:{ (dcl_modules, common_defs) = update_modules_and_create_commondefs used_module_numbers type_defs nr_of_modules dcl_modules = (reverse pi_groups, common_defs, pi_type_def_infos, {icl_common & com_type_defs = icl_type_defs}, dcl_modules, type_heaps, error) where - copy_type_defs_and_create_marks_and_infos used_module_numbers main_dcl_module_index nr_of_types_in_icl_mod nr_of_modules (icl_type_defs, dcl_modules) + copy_type_defs_and_create_marks_and_infos used_module_numbers main_dcl_module_index n_types_without_not_exported_dictionaries nr_of_modules (icl_type_defs, dcl_modules) # type_defs = { {} \\ module_nr <- [1..nr_of_modules] } marks = { {} \\ module_nr <- [1..nr_of_modules] } type_def_infos = { {} \\ module_nr <- [1..nr_of_modules] } - = iFoldSt (copy_type_def_and_create_marks_and_infos used_module_numbers main_dcl_module_index nr_of_types_in_icl_mod) 0 nr_of_modules + = iFoldSt (copy_type_def_and_create_marks_and_infos used_module_numbers main_dcl_module_index n_types_without_not_exported_dictionaries) 0 nr_of_modules (icl_type_defs, dcl_modules, type_defs, marks, type_def_infos) where - copy_type_def_and_create_marks_and_infos used_module_numbers main_dcl_module_index nr_of_types_in_icl_mod module_index + copy_type_def_and_create_marks_and_infos used_module_numbers main_dcl_module_index n_types_without_not_exported_dictionaries module_index (icl_type_defs, dcl_modules, type_defs, marks, type_def_infos) | inNumberSet module_index used_module_numbers # ({com_type_defs,com_class_defs}, dcl_modules) = dcl_modules![module_index].dcl_common | module_index == main_dcl_module_index = ( { type_def \\ type_def <-: com_type_defs }, dcl_modules, { type_defs & [module_index] = icl_type_defs }, - { marks & [module_index] = createArray nr_of_types_in_icl_mod cNotPartitionated }, - { type_def_infos & [module_index] = createArray nr_of_types_in_icl_mod EmptyTypeDefInfo }) + { marks & [module_index] = createArray n_types_without_not_exported_dictionaries cNotPartitionated }, + { type_def_infos & [module_index] = createArray n_types_without_not_exported_dictionaries EmptyTypeDefInfo }) # nr_of_types = size com_type_defs - size com_class_defs = ( icl_type_defs, dcl_modules, { type_defs & [module_index] = { type_def \\ type_def <-: com_type_defs }}, { marks & [module_index] = createArray nr_of_types cNotPartitionated }, { type_def_infos & [module_index] = createArray nr_of_types EmptyTypeDefInfo }) = (icl_type_defs, dcl_modules, type_defs, marks,type_def_infos) - partionate_type_defs mod_index pi=:{pi_marks} - #! nr_of_typedefs_to_be_examined = size pi_marks.[mod_index] - = iFoldSt (partitionate_type_def mod_index) 0 nr_of_typedefs_to_be_examined pi - where - partitionate_type_def module_index type_index pi=:{pi_marks} - # mark = pi_marks.[module_index, type_index] - | mark == cNotPartitionated - # (_, pi) = partitionateTypeDef {gi_module = module_index, gi_index = type_index} pi - = pi - = pi - expand_synonym_types_of_group main_dcl_module_index group_members (type_defs, main_dcl_type_defs, type_heaps, error) = foldSt (expand_synonym_type main_dcl_module_index) group_members (type_defs, main_dcl_type_defs, type_heaps, error) where @@ -800,9 +806,9 @@ where # (kind_info_ptr, kind_heap) = newPtr KI_Const kind_heap = ( type_var_heap <:= (tv_info_ptr, TVI_TypeKind kind_info_ptr), kind_heap <:= (kind_info_ptr, KI_Var kind_info_ptr)) -checkKindsOfCommonDefsAndFunctions :: !Index !Index !NumberSet !IndexRange !{#CommonDefs} !u:{# FunDef} !v:{#DclModule} !*TypeDefInfos !*ClassDefInfos +checkKindsOfCommonDefsAndFunctions :: !Index !Index !NumberSet ![IndexRange] !{#CommonDefs} !u:{# FunDef} !v:{#DclModule} !*TypeDefInfos !*ClassDefInfos !*TypeVarHeap !*ErrorAdmin -> (!u:{# FunDef}, !v:{#DclModule}, !*TypeDefInfos, !*TypeVarHeap, !*ErrorAdmin) -checkKindsOfCommonDefsAndFunctions first_uncached_module main_module_index used_module_numbers icl_fun_def_range common_defs icl_fun_defs dcl_modules +checkKindsOfCommonDefsAndFunctions first_uncached_module main_module_index used_module_numbers icl_fun_def_ranges common_defs icl_fun_defs dcl_modules type_def_infos class_infos type_var_heap error # as = { as_td_infos = type_def_infos @@ -812,16 +818,19 @@ checkKindsOfCommonDefsAndFunctions first_uncached_module main_module_index used_ } # (icl_fun_defs, dcl_modules, class_infos, as) - = iFoldSt (check_kinds_of_module first_uncached_module main_module_index used_module_numbers icl_fun_def_range common_defs) + = iFoldSt (check_kinds_of_module first_uncached_module main_module_index used_module_numbers icl_fun_def_ranges common_defs) 0 (size common_defs) (icl_fun_defs, dcl_modules, class_infos, as) = (icl_fun_defs, dcl_modules, as.as_td_infos, as.as_type_var_heap, as.as_error) where - check_kinds_of_module first_uncached_module main_module_index used_module_numbers {ir_from,ir_to} common_defs module_index + check_kinds_of_module first_uncached_module main_module_index used_module_numbers icl_fun_def_ranges common_defs module_index (icl_fun_defs, dcl_modules, class_infos, as) | inNumberSet module_index used_module_numbers | module_index == main_module_index # (class_infos, as) = check_kinds_of_class_instances common_defs 0 common_defs.[module_index].com_instance_defs class_infos as - (icl_fun_defs, class_infos, as) = iFoldSt (check_kinds_of_icl_fuction common_defs) ir_from ir_to (icl_fun_defs, class_infos, as) + # (icl_fun_defs, class_infos, as) = foldSt (check_kinds_of_icl_fuctions common_defs) icl_fun_def_ranges (icl_fun_defs, class_infos, as) + with + check_kinds_of_icl_fuctions common_defs {ir_from,ir_to} (icl_fun_defs, class_infos, as) + = iFoldSt (check_kinds_of_icl_fuction common_defs) ir_from ir_to (icl_fun_defs, class_infos, as) = (icl_fun_defs, dcl_modules, class_infos, as) | module_index >= first_uncached_module # (class_infos, as) = check_kinds_of_class_instances common_defs 0 common_defs.[module_index].com_instance_defs class_infos as diff --git a/frontend/analunitypes.icl b/frontend/analunitypes.icl index 9541732..eec067d 100644 --- a/frontend/analunitypes.icl +++ b/frontend/analunitypes.icl @@ -310,9 +310,11 @@ propClassification :: !Index !Index ![PropClassification] !{# CommonDefs } !*Typ propClassification type_index module_index hio_props defs type_var_heap td_infos | type_index >= size td_infos.[module_index] = (0, type_var_heap, td_infos) - # {td_args, td_name} = defs.[module_index].com_type_defs.[type_index] - (td_info, td_infos) = td_infos![module_index].[type_index] - = determinePropClassOfTypeDef type_index module_index td_args td_info hio_props defs type_var_heap td_infos + # (td_info, td_infos) = td_infos![module_index].[type_index] + | td_info.tdi_group_nr== (-1) // is an exported dictionary ? + = (0, type_var_heap, td_infos) + # {td_args, td_name} = defs.[module_index].com_type_defs.[type_index] + = determinePropClassOfTypeDef type_index module_index td_args td_info hio_props defs type_var_heap td_infos determinePropClassOfTypeDef :: !Int !Int ![ATypeVar] !TypeDefInfo ![PropClassification] !{# CommonDefs} !*TypeVarHeap !*TypeDefInfos -> (!PropClassification,!*TypeVarHeap, !*TypeDefInfos) diff --git a/frontend/cheat.dcl b/frontend/cheat.dcl new file mode 100644 index 0000000..8189566 --- /dev/null +++ b/frontend/cheat.dcl @@ -0,0 +1,5 @@ +system module cheat + +//i :: !b -> a + +uniqueCopy :: !*a -> (!*a, !*a) diff --git a/frontend/check.dcl b/frontend/check.dcl index 8f9a018..9501cd6 100644 --- a/frontend/check.dcl +++ b/frontend/check.dcl @@ -2,11 +2,15 @@ definition module check import syntax, transform, checksupport, typesupport, predef -checkModule :: !ScannedModule !IndexRange ![FunDef] !Int !Int !(Optional ScannedModule) ![ScannedModule] !{#DclModule} !{#FunDef} !*PredefinedSymbols !*SymbolTable !*File !*Heaps - -> (!Bool, *IclModule, *{# DclModule}, *{! Group}, !(Optional {# Index}), !.{#FunDef},!Int, !*Heaps, !*PredefinedSymbols, !*SymbolTable, *File /* TD */, [String]) +checkModule :: !ScannedModule !IndexRange ![FunDef] !Int !Int !(Optional ScannedModule) ![ScannedModule] !{#DclModule} !*{#*{#FunDef}} !*PredefinedSymbols !*SymbolTable !*File !*Heaps + -> (!Bool, *IclModule, *{# DclModule}, *{! Group}, !*{#*{#FunDef}},!Int, !*Heaps, !*PredefinedSymbols, !*SymbolTable, *File, [String]) -checkFunctions :: !Index !Level !Index !Index !*{#FunDef} !*ExpressionInfo !*Heaps !*CheckState -> (!*{#FunDef}, !*ExpressionInfo, !*Heaps, !*CheckState) +checkFunctions :: !Index !Level !Index !Index !Int !*{#FunDef} !*ExpressionInfo !*Heaps !*CheckState + -> (!*{#FunDef},!*ExpressionInfo,!*Heaps,!*CheckState) +checkDclMacros :: !Index !Level !Index !Index !*{#FunDef} !*ExpressionInfo !*Heaps !*CheckState + -> (!*{#FunDef},!*ExpressionInfo,!*Heaps,!*CheckState) + determineTypeOfMemberInstance :: !SymbolType ![TypeVar] !InstanceType !Specials !*TypeHeaps !u:(Optional (v:{#DclModule}, w:{#CheckedTypeDef}, Index)) !*ErrorAdmin -> (!SymbolType, !Specials, !*TypeHeaps, !u:Optional (v:{#DclModule}, w:{#CheckedTypeDef}), !*ErrorAdmin) diff --git a/frontend/check.icl b/frontend/check.icl index 6c608a1..e9b2e69 100644 --- a/frontend/check.icl +++ b/frontend/check.icl @@ -12,7 +12,6 @@ isMainModule :: ModuleKind -> Bool isMainModule MK_Main = True isMainModule _ = False -// AA.. checkGenerics :: !Index !Index !*{#GenericDef} !*{#ClassDef} !*{#CheckedTypeDef} !*{#DclModule} !*TypeHeaps !*CheckState -> (!*{#GenericDef}, !*{#ClassDef}, !*{#CheckedTypeDef}, !*{#DclModule}, !*TypeHeaps, !*CheckState) checkGenerics @@ -239,7 +238,7 @@ where (instance_def, is, type_heaps, cs) = check_instance mod_index instance_def is type_heaps cs = check_instance_defs (inc inst_index) mod_index { instance_defs & [inst_index] = instance_def } is type_heaps cs = (instance_defs, is, type_heaps, cs) - + check_instance :: !Index !ClassInstance !u:InstanceSymbols !*TypeHeaps !*CheckState -> (!ClassInstance, !u:InstanceSymbols, !*TypeHeaps, !*CheckState) check_instance module_index ins=:{ins_members,ins_class={glob_object = class_name =: {ds_ident = {id_name,id_info},ds_arity}},ins_type,ins_specials,ins_pos,ins_ident} @@ -284,9 +283,7 @@ where ins=:{ins_members,ins_class={glob_object = class_name =: {ds_ident = {id_name,id_info},ds_arity}},ins_type,ins_specials,ins_pos,ins_ident,ins_generate} is=:{is_class_defs,is_modules} type_heaps cs=:{cs_symbol_table} | ins_generate - = ( ins - , is - , type_heaps + = ( ins, is, type_heaps , { cs & cs_error = checkError id_name "cannot generate class instance" cs.cs_error } ) | class_def.class_arity == ds_arity @@ -297,9 +294,7 @@ where is = { is & is_type_defs = is_type_defs, is_class_defs = is_class_defs, is_modules = is_modules } = ({ins & ins_class = ins_class, ins_type = ins_type, ins_specials = ins_specials}, is, type_heaps, cs) // otherwise - = ( ins - , is - , type_heaps + = ( ins, is, type_heaps , { cs & cs_error = checkError id_name ("wrong arity: expected "+++toString class_def.class_arity+++" found "+++toString ds_arity) cs.cs_error } ) check_generic_instance :: GenericDef !Index !Index !Index !ClassInstance !u:InstanceSymbols !*TypeHeaps !*CheckState -> (!ClassInstance, !u:InstanceSymbols, !*TypeHeaps, !*CheckState) @@ -307,14 +302,8 @@ where {gen_member_name} module_index generic_index generic_module_index ins=:{ - ins_members, ins_class={glob_object = class_name =: {ds_ident = {id_name,id_info},ds_arity, ds_index} }, - ins_type, - ins_specials, - ins_pos, - ins_ident, - ins_is_generic, - ins_generate + ins_members, ins_type, ins_specials, ins_pos, ins_ident, ins_is_generic, ins_generate } is=:{is_class_defs,is_modules} type_heaps @@ -357,7 +346,6 @@ where !*VarHeap !*TypeHeaps !*CheckState -> (![(Index,SymbolType)], !x:{# ClassInstance}, !w:{# ClassDef}, !v:{# MemberDef}, /*AA*/!w:{# GenericDef}, !nerd:{# CheckedTypeDef}, !u:{# DclModule}, !*VarHeap, !*TypeHeaps, !*CheckState) check_instances inst_index mod_index instance_types instance_defs class_defs member_defs generic_defs type_defs modules var_heap type_heaps cs -// AA.. | inst_index < size instance_defs # (instance_def=:{ins_ident,ins_is_generic, ins_pos}, instance_defs) = instance_defs![inst_index] # (instance_types, class_defs, member_defs, generic_defs, type_defs, modules, var_heap, type_heaps, cs) = @@ -366,7 +354,7 @@ where = check_instances (inc inst_index) mod_index instance_types instance_defs class_defs member_defs generic_defs type_defs modules var_heap type_heaps cs // otherwise = (instance_types, instance_defs, class_defs, member_defs, generic_defs, type_defs, modules, var_heap, type_heaps, cs) - + check_class_instance {ins_pos,ins_class,ins_members,ins_type} mod_index instance_types class_defs member_defs generic_defs type_defs modules var_heap type_heaps cs # ({class_members,class_name}, class_defs, modules) = getClassDef ins_class mod_index class_defs modules class_size = size class_members @@ -378,7 +366,7 @@ where // otherwise # cs = { cs & cs_error = checkError class_name "different number of members specified" cs.cs_error } = (instance_types, class_defs, member_defs, generic_defs, type_defs, modules, var_heap, type_heaps, cs) - + check_generic_instance {ins_class, ins_members, ins_generate} mod_index instance_types class_defs member_defs generic_defs type_defs modules var_heap type_heaps cs # ({gen_name, gen_member_name}, generic_defs, modules) = getGenericDef ins_class mod_index generic_defs modules //| ins_generate @@ -392,7 +380,6 @@ where = (instance_types, class_defs, member_defs, generic_defs, type_defs, modules, var_heap, type_heaps, cs) // otherwise = (instance_types, class_defs, member_defs, generic_defs, type_defs, modules, var_heap, type_heaps, cs) -// ..AA check_member_instances :: !Index !Index !Int !Int !{#DefinedSymbol} !{#DefinedSymbol} Ident !Position !InstanceType ![(Index,SymbolType)] !v:{# MemberDef} !blah:{# CheckedTypeDef} !u:{# DclModule} !*VarHeap !*TypeHeaps !*CheckState @@ -437,7 +424,6 @@ getMemberDef mem_mod mem_index mod_index member_defs modules # (dcl_mod,modules) = modules![mem_mod] = (dcl_mod.dcl_common.com_member_defs.[mem_index], member_defs, modules) -// AA.. getGenericDef :: !(Global DefinedSymbol) !Int !u:{#GenericDef} !v:{#DclModule} -> (!GenericDef,!u:{#GenericDef},!v:{#DclModule}) getGenericDef {glob_module, glob_object={ds_ident, ds_index}} mod_index generic_defs modules | glob_module == mod_index @@ -445,7 +431,6 @@ getGenericDef {glob_module, glob_object={ds_ident, ds_index}} mod_index generic_ = (generic_def, generic_defs, modules) # (dcl_mod, modules) = modules![glob_module] = (dcl_mod.dcl_common.com_generic_defs.[ds_index], generic_defs, modules) -// ..AA instantiateTypes :: ![TypeVar] ![AttributeVar] ![AType] ![TypeContext] ![AttrInequality] !SpecialSubstitution ![SpecialSubstitution] !*TypeHeaps !*ErrorAdmin -> (![TypeVar], ![AttributeVar], ![AType], ![TypeContext], ![AttrInequality], ![SpecialSubstitution], !*TypeHeaps, !*ErrorAdmin) @@ -796,23 +781,18 @@ where # (new_info_ptr, var_heap) = newPtr VI_Empty var_heap = ({ context & tc_var = new_info_ptr}, var_heap) -ident_for_errors_from_fun_symb_and_fun_kind :: Ident DefOrImpFunKind -> Ident; -ident_for_errors_from_fun_symb_and_fun_kind {id_name} (FK_ImpFunction fun_name_is_location_dependent) - | fun_name_is_location_dependent && size id_name>0 - # beautiful_name = if (id_name.[0]==backslash) "lambda" "comprehension" - = { id_name=beautiful_name, id_info=nilPtr } -ident_for_errors_from_fun_symb_and_fun_kind {id_name} (FK_DefFunction fun_name_is_location_dependent) +ident_for_errors_from_fun_symb_and_fun_kind :: Ident FunKind -> Ident; +ident_for_errors_from_fun_symb_and_fun_kind {id_name} (FK_Function fun_name_is_location_dependent) | fun_name_is_location_dependent && size id_name>0 # beautiful_name = if (id_name.[0]==backslash) "lambda" "comprehension" = { id_name=beautiful_name, id_info=nilPtr } ident_for_errors_from_fun_symb_and_fun_kind fun_symb _ = fun_symb -checkFunction :: !Index !Index !Level !*{#FunDef} !*ExpressionInfo !*Heaps !*CheckState -> (!*{#FunDef},!*ExpressionInfo, !*Heaps, !*CheckState); -checkFunction mod_index fun_index def_level fun_defs - e_info=:{ef_type_defs,ef_modules,ef_class_defs,ef_is_macro_fun} heaps=:{hp_var_heap,hp_expression_heap,hp_type_heaps} cs=:{cs_error} - # (fun_def,fun_defs) = fun_defs![fun_index] - # {fun_symb,fun_pos,fun_body,fun_type,fun_kind} = fun_def +checkFunction :: !FunDef !Index !FunctionOrMacroIndex !Level !Int !*{#FunDef} !*ExpressionInfo !*Heaps !*CheckState + -> (!FunDef,!*{#FunDef},!*ExpressionInfo,!*Heaps,!*CheckState); +checkFunction fun_def=:{fun_symb,fun_pos,fun_body,fun_type,fun_kind} mod_index fun_index def_level local_functions_index_offset + fun_defs e_info=:{ef_type_defs,ef_modules,ef_class_defs,ef_is_macro_fun} heaps=:{hp_var_heap,hp_expression_heap,hp_type_heaps} cs=:{cs_error} # function_ident_for_errors = ident_for_errors_from_fun_symb_and_fun_kind fun_symb fun_kind # cs = {cs & cs_error = pushErrorAdmin (newPosition function_ident_for_errors fun_pos) cs_error} @@ -821,7 +801,7 @@ checkFunction mod_index fun_index def_level fun_defs e_info = { e_info & ef_type_defs = ef_type_defs, ef_class_defs = ef_class_defs, ef_modules = ef_modules } e_state = { es_var_heap = hp_var_heap, es_expr_heap = hp_expression_heap, es_type_heaps = hp_type_heaps, es_dynamics = [], es_calls = [], es_fun_defs = fun_defs, es_dynamic_expr_count = 0} - e_input = { ei_expr_level = inc def_level, ei_fun_index = fun_index, ei_fun_level = inc def_level, ei_mod_index = mod_index } + e_input = { ei_expr_level = inc def_level, ei_fun_index = fun_index, ei_fun_level = inc def_level, ei_mod_index = mod_index, ei_local_functions_index_offset=local_functions_index_offset } (fun_body, free_vars, e_state, e_info, cs) = checkFunctionBodies fun_body function_ident_for_errors e_input e_state e_info cs # {es_fun_defs,es_calls,es_var_heap,es_expr_heap,es_type_heaps,es_dynamics} = e_state @@ -831,10 +811,10 @@ checkFunction mod_index fun_index def_level fun_defs fi_properties = (if ef_is_macro_fun FI_IsMacroFun 0) bitor (has_type fun_type) fun_info = { fun_def.fun_info & fi_calls = es_calls, fi_def_level = def_level, fi_free_vars = free_vars, fi_dynamics = es_dynamics, fi_properties = fi_properties } - fun_defs = { es_fun_defs & [fun_index] = { fun_def & fun_body = fun_body, fun_info = fun_info, fun_type = fun_type}} - (fun_defs, cs_symbol_table) = remove_calls_from_symbol_table fun_index def_level es_calls fun_defs cs.cs_symbol_table - = (fun_defs, - { e_info & ef_type_defs = ef_type_defs, ef_modules = ef_modules }, + fun_def = { fun_def & fun_body = fun_body, fun_info = fun_info, fun_type = fun_type} + (fun_defs,macro_defs,cs_symbol_table) = remove_calls_from_symbol_table fun_index def_level es_calls e_state.es_fun_defs e_info.ef_macro_defs cs.cs_symbol_table + = (fun_def,fun_defs, + { e_info & ef_type_defs = ef_type_defs, ef_modules = ef_modules,ef_macro_defs=macro_defs }, { heaps & hp_var_heap = es_var_heap, hp_expression_heap = es_expr_heap, hp_type_heaps = es_type_heaps }, { cs & cs_symbol_table = cs_symbol_table }) @@ -850,27 +830,61 @@ where check_function_type No module_index type_defs class_defs modules var_heap type_heaps cs = (No, type_defs, class_defs, modules, var_heap, type_heaps, cs) - remove_calls_from_symbol_table fun_index fun_level [{fc_index, fc_level} : fun_calls] fun_defs symbol_table + remove_calls_from_symbol_table fun_index fun_level [FunCall fc_index fc_level : fun_calls] fun_defs macro_defs symbol_table | fc_level <= fun_level - # ({fun_symb=fun_symb=:{id_info}}, fun_defs) = fun_defs![fc_index] + # (id_info, fun_defs) = fun_defs![fc_index].fun_symb.id_info # (entry, symbol_table) = readPtr id_info symbol_table - # (c,cs) = get_calls entry.ste_kind - | fun_index == c - = remove_calls_from_symbol_table fun_index fun_level fun_calls fun_defs (symbol_table <:= (id_info,{ entry & ste_kind = STE_FunctionOrMacro cs})) - = abort " Error in remove_calls_from_symbol_table" - = remove_calls_from_symbol_table fun_index fun_level fun_calls fun_defs symbol_table - remove_calls_from_symbol_table fun_index fun_level [] fun_defs symbol_table - = (fun_defs, symbol_table) - - get_calls (STE_FunctionOrMacro [x:xs]) = (x,xs) - get_calls ste_kind = abort "get_calls (check.icl)" // <<- ste_kind - -checkFunctions :: !Index !Level !Index !Index !*{#FunDef} !*ExpressionInfo !*Heaps !*CheckState -> (!*{#FunDef}, !*ExpressionInfo, !*Heaps, !*CheckState) -checkFunctions mod_index level from_index to_index fun_defs e_info heaps cs - | from_index == to_index + # symbol_table = remove_call entry.ste_kind fun_index entry id_info symbol_table + = remove_calls_from_symbol_table fun_index fun_level fun_calls fun_defs macro_defs symbol_table + = remove_calls_from_symbol_table fun_index fun_level fun_calls fun_defs macro_defs symbol_table + remove_calls_from_symbol_table fun_index fun_level [MacroCall module_index fc_index fc_level : fun_calls] fun_defs macro_defs symbol_table + | fc_level <= fun_level + # (id_info, macro_defs) = macro_defs![module_index,fc_index].fun_symb.id_info + # (entry, symbol_table) = readPtr id_info symbol_table + # symbol_table = remove_call entry.ste_kind fun_index entry id_info symbol_table + = remove_calls_from_symbol_table fun_index fun_level fun_calls fun_defs macro_defs symbol_table + = remove_calls_from_symbol_table fun_index fun_level fun_calls fun_defs macro_defs symbol_table + remove_calls_from_symbol_table fun_index fun_level [] fun_defs macro_defs symbol_table + = (fun_defs,macro_defs,symbol_table) + + remove_call (STE_FunctionOrMacro [x:xs]) fun_index entry id_info symbol_table + | fun_index==x + = symbol_table <:= (id_info,{ entry & ste_kind = STE_FunctionOrMacro xs}) + remove_call (STE_DclMacroOrLocalMacroFunction [x:xs]) fun_index entry id_info symbol_table + | fun_index==x + = symbol_table <:= (id_info,{ entry & ste_kind = STE_DclMacroOrLocalMacroFunction xs}) + remove_call (STE_Imported (STE_DclMacroOrLocalMacroFunction [x:xs]) mod_index) fun_index entry id_info symbol_table + | fun_index==x + = symbol_table <:= (id_info,{ entry & ste_kind = (STE_Imported (STE_DclMacroOrLocalMacroFunction xs) mod_index)}) + +checkGlobalFunctionsInRanges:: ![IndexRange] !Index !Int !*{#FunDef} !*ExpressionInfo !*Heaps !*CheckState + -> (!*{#FunDef},!*ExpressionInfo,!*Heaps,!*CheckState) +checkGlobalFunctionsInRanges [{ir_from,ir_to}:ranges] mod_index local_functions_index_offset fun_defs e_info heaps cs + # (fun_defs, e_info, heaps, cs) + = checkFunctions mod_index cGlobalScope ir_from ir_to local_functions_index_offset fun_defs e_info heaps cs; + = checkGlobalFunctionsInRanges ranges mod_index local_functions_index_offset fun_defs e_info heaps cs; +checkGlobalFunctionsInRanges [] mod_index local_functions_index_offset fun_defs e_info heaps cs + = (fun_defs, e_info, heaps, cs) + +checkFunctions :: !Index !Level !Index !Index !Int !*{#FunDef} !*ExpressionInfo !*Heaps !*CheckState + -> (!*{#FunDef},!*ExpressionInfo,!*Heaps,!*CheckState) +checkFunctions mod_index level fun_index to_index local_functions_index_offset fun_defs e_info heaps cs + | fun_index == to_index + = (fun_defs, e_info, heaps, cs) + # (fun_def,fun_defs) = fun_defs![fun_index] + # (fun_def,fun_defs, e_info, heaps, cs) = checkFunction fun_def mod_index (FunctionOrIclMacroIndex fun_index) level local_functions_index_offset fun_defs e_info heaps cs + # fun_defs = { fun_defs & [fun_index] = fun_def } + = checkFunctions mod_index level (inc fun_index) to_index local_functions_index_offset fun_defs e_info heaps cs + +checkDclMacros :: !Index !Level !Index !Index !*{#FunDef} !*ExpressionInfo !*Heaps !*CheckState + -> (!*{#FunDef},!*ExpressionInfo,!*Heaps,!*CheckState) +checkDclMacros mod_index level fun_index to_index fun_defs e_info heaps cs + | fun_index == to_index = (fun_defs, e_info, heaps, cs) - # (fun_defs, e_info, heaps, cs) = checkFunction mod_index from_index level fun_defs e_info heaps cs - = checkFunctions mod_index level (inc from_index) to_index fun_defs e_info heaps cs + # (macro_def,e_info) = e_info!ef_macro_defs.[mod_index,fun_index] + # (macro_def,fun_defs, e_info, heaps, cs) = checkFunction macro_def mod_index (DclMacroIndex mod_index fun_index) level 0 fun_defs e_info heaps cs + # e_info = { e_info & ef_macro_defs.[mod_index,fun_index] = macro_def } + = checkDclMacros mod_index level (inc fun_index) to_index fun_defs e_info heaps cs get_predef_symbols_for_transform :: *PredefinedSymbols -> (!PredefSymbolsForTransform,!.PredefinedSymbols) // clean 2.0 does not allow this, clean 1.3 does: @@ -881,29 +895,42 @@ get_predef_symbols_for_transform cs_predef_symbols # (predef_or,cs_predef_symbols) = cs_predef_symbols![PD_OrOp] = ({predef_alias_dummy=predef_alias_dummy,predef_and=predef_and,predef_or=predef_or},cs_predef_symbols) -checkMacros :: !Index !IndexRange !*{#FunDef} !*ExpressionInfo !*Heaps !*CheckState - -> (!*{#FunDef}, !*ExpressionInfo, !*Heaps, !*CheckState); -checkMacros mod_index range fun_defs e_info=:{ef_is_macro_fun=ef_is_macro_fun_old} heaps cs +checkAndPartitionateDclMacros :: !Index !IndexRange !*{#FunDef} !*ExpressionInfo !*Heaps !*CheckState + -> (!*{#FunDef},!*ExpressionInfo,!*Heaps,!*CheckState); +checkAndPartitionateDclMacros mod_index range fun_defs e_info=:{ef_is_macro_fun=ef_is_macro_fun_old} heaps cs # (fun_defs, e_info, heaps=:{hp_var_heap, hp_expression_heap}, cs=:{cs_symbol_table, cs_predef_symbols, cs_error}) - = checkFunctions mod_index cGlobalScope range.ir_from range.ir_to fun_defs { e_info & ef_is_macro_fun=True } heaps cs - (e_info=:{ef_modules}) = { e_info & ef_is_macro_fun=ef_is_macro_fun_old } + = checkDclMacros mod_index cGlobalScope range.ir_from range.ir_to fun_defs { e_info & ef_is_macro_fun=True } heaps cs + (e_info=:{ef_modules,ef_macro_defs}) = { e_info & ef_is_macro_fun=ef_is_macro_fun_old } # (predef_symbols_for_transform, cs_predef_symbols) = get_predef_symbols_for_transform cs_predef_symbols - (fun_defs, ef_modules, hp_var_heap, hp_expression_heap, cs_symbol_table, cs_error) - = partitionateMacros range mod_index predef_symbols_for_transform fun_defs ef_modules hp_var_heap hp_expression_heap cs_symbol_table cs_error - = (fun_defs, { e_info & ef_modules = ef_modules }, {heaps & hp_var_heap = hp_var_heap, hp_expression_heap = hp_expression_heap}, + (fun_defs, macro_defs, ef_modules, hp_var_heap, hp_expression_heap, cs_symbol_table, cs_error) + = partitionateDclMacros range mod_index predef_symbols_for_transform fun_defs ef_macro_defs ef_modules hp_var_heap hp_expression_heap cs_symbol_table cs_error + = (fun_defs, { e_info & ef_modules = ef_modules,ef_macro_defs=macro_defs }, {heaps & hp_var_heap = hp_var_heap, hp_expression_heap = hp_expression_heap}, { cs & cs_symbol_table = cs_symbol_table, cs_predef_symbols = cs_predef_symbols, cs_error = cs_error }) -checkInstanceBodies :: !IndexRange !*{#FunDef} !*ExpressionInfo !*Heaps !*CheckState -> (!*{#FunDef},!*ExpressionInfo,!*Heaps, !*CheckState); -checkInstanceBodies {ir_from, ir_to} fun_defs e_info heaps cs=:{cs_x} - = checkFunctions cs_x.x_main_dcl_module_n cGlobalScope ir_from ir_to fun_defs e_info heaps cs +checkAndPartitionateIclMacros :: !Index !IndexRange !Int !*{#FunDef} !*ExpressionInfo !*Heaps !*CheckState + -> (!*{#FunDef},!*ExpressionInfo,!*Heaps,!*CheckState); +checkAndPartitionateIclMacros mod_index range local_functions_index_offset fun_defs e_info=:{ef_is_macro_fun=ef_is_macro_fun_old} heaps cs + # (fun_defs, e_info, heaps=:{hp_var_heap, hp_expression_heap}, cs=:{cs_symbol_table, cs_predef_symbols, cs_error}) + = checkFunctions mod_index cGlobalScope range.ir_from range.ir_to local_functions_index_offset fun_defs { e_info & ef_is_macro_fun=True } heaps cs + (e_info=:{ef_modules,ef_macro_defs}) = { e_info & ef_is_macro_fun=ef_is_macro_fun_old } + # (predef_symbols_for_transform, cs_predef_symbols) = get_predef_symbols_for_transform cs_predef_symbols + (fun_defs, macro_defs, ef_modules, hp_var_heap, hp_expression_heap, cs_symbol_table, cs_error) + = partitionateIclMacros range mod_index predef_symbols_for_transform fun_defs ef_macro_defs ef_modules hp_var_heap hp_expression_heap cs_symbol_table cs_error + = (fun_defs, { e_info & ef_modules = ef_modules,ef_macro_defs=macro_defs }, {heaps & hp_var_heap = hp_var_heap, hp_expression_heap = hp_expression_heap}, + { cs & cs_symbol_table = cs_symbol_table, cs_predef_symbols = cs_predef_symbols, cs_error = cs_error }) + +checkInstanceBodies :: ![IndexRange] !Int !*{#FunDef} !*ExpressionInfo !*Heaps !*CheckState + -> (!*{#FunDef},!*ExpressionInfo,!*Heaps, !*CheckState); +checkInstanceBodies icl_instances_ranges local_functions_index_offset fun_defs e_info heaps cs=:{cs_x} + = checkGlobalFunctionsInRanges icl_instances_ranges cs_x.x_main_dcl_module_n local_functions_index_offset fun_defs e_info heaps cs instance < FunDef where (<) fd1 fd2 = fd1.fun_symb.id_name < fd2.fun_symb.id_name -createCommonDefinitions {def_types,def_constructors,def_selectors,def_macros,def_classes,def_members,def_instances, def_generics} +createCommonDefinitions :: (CollectedDefinitions ClassInstance a) -> .CommonDefs; +createCommonDefinitions {def_types,def_constructors,def_selectors,def_classes,def_members,def_instances, def_generics} = { com_type_defs = { type \\ type <- def_types } -// , com_unexpanded_type_defs = {} , com_cons_defs = { cons \\ cons <- def_constructors } , com_selector_defs = { sel \\ sel <- def_selectors } , com_class_defs = { class_def \\ class_def <- def_classes } @@ -916,9 +943,8 @@ array_plus_list a [] = a array_plus_list a l = arrayPlusList a l checkCommonDefinitions :: !(Optional (CopiedDefinitions, Int)) !Index !*CommonDefs !*{# DclModule} !*TypeHeaps !*VarHeap !*CheckState - -> (!*CommonDefs, !*{# DclModule}, !*TypeHeaps, !*VarHeap, !*CheckState) -checkCommonDefinitions opt_icl_info module_index common modules type_heaps var_heap cs - #! is_main_dcl_mod = hasOption opt_icl_info && module_index == cs.cs_x.x_main_dcl_module_n + -> (!DictionaryInfo,!*CommonDefs,!*{# DclModule},!*TypeHeaps,!*VarHeap,!*CheckState) +checkCommonDefinitions opt_icl_info module_index common modules type_heaps var_heap cs # (com_type_defs, com_cons_defs, com_selector_defs, modules, var_heap, type_heaps, cs) = checkTypeDefs module_index opt_icl_info common.com_type_defs common.com_cons_defs common.com_selector_defs modules var_heap type_heaps cs @@ -926,31 +952,31 @@ checkCommonDefinitions opt_icl_info module_index common modules type_heaps var_ = checkTypeClasses module_index opt_icl_info common.com_class_defs common.com_member_defs com_type_defs modules type_heaps cs (com_member_defs, com_type_defs, com_class_defs, modules, type_heaps, var_heap, cs) = checkMemberTypes module_index opt_icl_info com_member_defs com_type_defs com_class_defs modules type_heaps var_heap cs -// AA.. (com_generic_defs, com_class_defs, com_type_defs, modules, type_heaps, cs) = checkGenerics 0 module_index common.com_generic_defs com_class_defs com_type_defs modules type_heaps cs -// ..AA - (com_instance_defs, com_type_defs, com_class_defs, com_member_defs, /*AA*/com_generic_defs, modules, type_heaps, cs) - = checkInstanceDefs module_index common.com_instance_defs com_type_defs com_class_defs com_member_defs /*AA*/com_generic_defs modules type_heaps cs + (com_instance_defs, com_type_defs, com_class_defs, com_member_defs, com_generic_defs, modules, type_heaps, cs) + = checkInstanceDefs module_index common.com_instance_defs com_type_defs com_class_defs com_member_defs com_generic_defs modules type_heaps cs (size_com_type_defs,com_type_defs) = usize com_type_defs (size_com_selector_defs,com_selector_defs) = usize com_selector_defs (size_com_cons_defs,com_cons_defs) = usize com_cons_defs - (com_class_defs, modules, new_type_defs, new_selector_defs, new_cons_defs, th_vars, var_heap, cs_symbol_table) - = createClassDictionaries module_index com_class_defs modules size_com_type_defs size_com_selector_defs size_com_cons_defs - type_heaps.th_vars var_heap cs.cs_symbol_table + is_dcl = case opt_icl_info of No -> True ; Yes _ -> False + (new_type_defs, new_selector_defs, new_cons_defs,dictionary_info,com_type_defs,com_selector_defs, com_cons_defs, com_class_defs, modules, th_vars, var_heap, cs_symbol_table) + = createClassDictionaries is_dcl module_index size_com_type_defs size_com_selector_defs size_com_cons_defs + com_type_defs com_selector_defs com_cons_defs com_class_defs modules type_heaps.th_vars var_heap cs.cs_symbol_table com_type_defs = array_plus_list com_type_defs new_type_defs com_selector_defs = array_plus_list com_selector_defs new_selector_defs com_cons_defs = array_plus_list com_cons_defs new_cons_defs + + common = {common & com_type_defs = com_type_defs, com_cons_defs = com_cons_defs, com_selector_defs = com_selector_defs, com_class_defs = com_class_defs, + com_member_defs = com_member_defs, com_instance_defs = com_instance_defs, com_generic_defs = com_generic_defs } - = ({common & com_type_defs = com_type_defs, com_cons_defs = com_cons_defs, com_selector_defs = com_selector_defs, com_class_defs = com_class_defs, - com_member_defs = com_member_defs, com_instance_defs = com_instance_defs, /* AA */ com_generic_defs = com_generic_defs }, modules, - { type_heaps & th_vars = th_vars }, var_heap, { cs & cs_symbol_table = cs_symbol_table }) + = (dictionary_info,common, modules, { type_heaps & th_vars = th_vars }, var_heap, { cs & cs_symbol_table = cs_symbol_table }) collectCommonfinitions :: !(CollectedDefinitions ClassInstance a) -> (!*{# Int}, ![Declaration]) -collectCommonfinitions {def_types,def_constructors,def_selectors,def_macros,def_classes,def_members,def_instances, def_generics} +collectCommonfinitions {def_types,def_constructors,def_selectors,def_classes,def_members,def_instances, def_generics} // MW: the order in which the declarations appear in the returned list is essential (explicit imports) # sizes = createArray cConversionTableSize 0 (size, defs) = foldSt cons_def_to_dcl def_constructors (0, []) @@ -965,10 +991,8 @@ collectCommonfinitions {def_types,def_constructors,def_selectors,def_macros,def_ sizes = { sizes & [cClassDefs] = size } (size, defs) = foldSt instance_def_to_dcl def_instances (0, defs) sizes = { sizes & [cInstanceDefs] = size } -// AA.. (size, defs) = foldSt generic_def_to_dcl def_generics (0, defs) sizes = { sizes & [cGenericDefs] = size } -// ..AA = (sizes, defs) where type_def_to_dcl {td_name, td_pos} (decl_index, decls) @@ -983,12 +1007,10 @@ where = (inc decl_index, [Declaration { decl_ident = me_symb, decl_pos = me_pos, decl_kind = STE_Member, decl_index = decl_index } : decls]) instance_def_to_dcl {ins_class, ins_ident, ins_pos} (decl_index, decls) = (inc decl_index, [Declaration { decl_ident = ins_ident, decl_pos = ins_pos, decl_kind = STE_Instance ins_class.glob_object.ds_ident, decl_index = decl_index } : decls]) -// AA.. generic_def_to_dcl {gen_name, gen_member_name, gen_type, gen_pos} (decl_index, decls) # generic_decl = Declaration { decl_ident = gen_name, decl_pos = gen_pos, decl_kind = STE_Generic, decl_index = decl_index } # member_decl = Declaration { decl_ident = gen_member_name, decl_pos = gen_pos, decl_kind = STE_Generic, decl_index = decl_index } = (inc decl_index, [generic_decl, member_decl : decls]) -// ..AA collectMacros {ir_from,ir_to} macro_defs sizes_defs = collectGlobalFunctions cMacroDefs ir_from ir_to macro_defs sizes_defs @@ -1001,44 +1023,89 @@ where = (inc decl_index, [Declaration { decl_ident = ft_symb, decl_pos = ft_pos, decl_kind = STE_DclFunction, decl_index = decl_index } : decls]) collectGlobalFunctions def_index from_index to_index fun_defs (sizes, defs) - # (defs, fun_defs) = iFoldSt fun_def_to_dcl from_index to_index (defs, fun_defs) + # (defs, fun_defs) = iFoldSt fun_def_to_decl from_index to_index (defs, fun_defs) = (fun_defs, ({ sizes & [def_index] = to_index - from_index }, defs)) where - fun_def_to_dcl decl_index (defs, fun_defs) + fun_def_to_decl decl_index (defs, fun_defs) # ({fun_symb, fun_pos}, fun_defs) = fun_defs![decl_index] = ([Declaration { decl_ident = fun_symb, decl_pos = fun_pos, decl_kind = STE_FunctionOrMacro [], decl_index = decl_index } : defs], fun_defs) +collectDclMacros {ir_from=from_index,ir_to=to_index} fun_defs (sizes, defs) + # (defs, fun_defs) = iFoldSt macro_def_to_dcl from_index to_index (defs, fun_defs) + = (fun_defs, ({ sizes & [cMacroDefs] = to_index - from_index }, defs)) +where + macro_def_to_dcl decl_index (defs, fun_defs) + # ({fun_symb, fun_pos}, fun_defs) = fun_defs![decl_index] + = ([Declaration { decl_ident = fun_symb, decl_pos = fun_pos, decl_kind = STE_DclMacroOrLocalMacroFunction [], decl_index = decl_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 +create_icl_to_dcl_index_table :: !ModuleKind !{#Int} IndexRange !Int !(Optional {#{#Int}}) !*{#DclModule} !*{#FunDef} + -> (!Optional {#{#Int}},!Optional {#{#Int}}, !.{#DclModule},!*{#FunDef}) +create_icl_to_dcl_index_table MK_Main icl_sizes icl_global_function_range main_dcl_module_n dcl_conversions modules fun_defs + = (No,No,modules,fun_defs) +create_icl_to_dcl_index_table _ icl_sizes icl_global_function_range main_dcl_module_n old_conversions modules fun_defs + # (size_icl_functions,fun_defs) = usize fun_defs + # icl_sizes = {{icl_sizes.[i] \\ i<-[0..cMacroDefs-1]} & [cFunctionDefs]=size_icl_functions} # (dcl_mod,modules) = modules![main_dcl_module_n] - # (Yes conversion_table) = dcl_mod.dcl_conversions - # 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 } + # dictionary_info=dcl_mod.dcl_dictionary_info + # (Yes conversion_table) = old_conversions + # icl_to_dcl_index_table = {create_icl_to_dcl_index_table_for_kind table_size dcl_to_icl_table table_kind dictionary_info \\ table_kind<-[0..] & table_size <-: icl_sizes & dcl_to_icl_table <-: conversion_table } + # modules = {modules & [main_dcl_module_n].dcl_macro_conversions=Yes conversion_table.[cMacroDefs]} + = (Yes icl_to_dcl_index_table,old_conversions,modules,fun_defs) + +recompute_icl_to_dcl_index_table_for_functions No dcl_icl_conversions n_functions + = No +recompute_icl_to_dcl_index_table_for_functions (Yes icl_to_dcl_index_table) (Yes dcl_icl_conversions) n_functions + # icl_to_dcl_index_table_for_functions = create_icl_to_dcl_index_table_for_kind n_functions dcl_icl_conversions cFunctionDefs {n_dictionary_types=0, n_dictionary_constructors=0, n_dictionary_selectors=0} + # icl_to_dcl_index_table = {{t\\t<-:icl_to_dcl_index_table} & [cFunctionDefs] = icl_to_dcl_index_table_for_functions} + = Yes icl_to_dcl_index_table + +create_icl_to_dcl_index_table_for_kind :: !Int !{#Int} Int DictionaryInfo -> {#Int} +create_icl_to_dcl_index_table_for_kind table_size dcl_to_icl_table table_kind dcl_dictionary_info + # icl_to_dcl_index_table_for_kind = {createArray table_size NoIndex & [dcl_to_icl_table.[decl_index]]=decl_index \\ decl_index<- [0..size dcl_to_icl_table-1]} + #! max_index=size icl_to_dcl_index_table_for_kind-1 + # free_position_index = if (table_kind==cTypeDefs) (max_index+dcl_dictionary_info.n_dictionary_types) + (if (table_kind==cSelectorDefs) (max_index+dcl_dictionary_info.n_dictionary_selectors) + (if (table_kind==cConstructorDefs) (max_index+dcl_dictionary_info.n_dictionary_constructors) + max_index)) + # icl_to_dcl_index_table_for_kind = number_NoIndex_elements max_index free_position_index icl_to_dcl_index_table_for_kind 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.[decl_index]]=decl_index \\ decl_index<- [0..size dcl_to_icl_table-1]} - #! max_index=size icl_to_dcl_index_table_for_kind-1 - # icl_to_dcl_index_table_for_kind = number_NoIndex_elements max_index max_index icl_to_dcl_index_table_for_kind - with - number_NoIndex_elements :: Int Int *{#Int} -> .{#Int}; - number_NoIndex_elements index free_position_index icl_to_dcl_index_table_for_kind - | index>=0 - | icl_to_dcl_index_table_for_kind.[index]==NoIndex - = number_NoIndex_elements (index-1) (free_position_index-1) {icl_to_dcl_index_table_for_kind & [index]=free_position_index} - = number_NoIndex_elements (index-1) free_position_index icl_to_dcl_index_table_for_kind - = icl_to_dcl_index_table_for_kind - = icl_to_dcl_index_table_for_kind - # modules = {modules & [main_dcl_module_n] = { dcl_mod & dcl_conversions = Yes conversion_table}} + number_NoIndex_elements :: Int Int *{#Int} -> .{#Int}; + number_NoIndex_elements index free_position_index icl_to_dcl_index_table_for_kind + | index>=0 + | icl_to_dcl_index_table_for_kind.[index]==NoIndex + = number_NoIndex_elements (index-1) (free_position_index-1) {icl_to_dcl_index_table_for_kind & [index]=free_position_index} + = number_NoIndex_elements (index-1) free_position_index icl_to_dcl_index_table_for_kind + = icl_to_dcl_index_table_for_kind + = icl_to_dcl_index_table_for_kind + +renumber_member_indexes_of_class_instances No class_instances + = class_instances +renumber_member_indexes_of_class_instances (Yes icl_to_dcl_index_table) class_instances + = renumber_member_indexes_of_class_instances 0 class_instances + where + function_conversion_table = icl_to_dcl_index_table.[cFunctionDefs] + + renumber_member_indexes_of_class_instances class_inst_index class_instances + | class_inst_index < size class_instances + # (class_instance,class_instances) = class_instances![class_inst_index] + # new_members = {{icl_member & ds_index=function_conversion_table.[icl_member.ds_index]} \\ icl_member<-:class_instance.ins_members} + # class_instances = {class_instances & [class_inst_index]={class_instance & ins_members=new_members}} + = renumber_member_indexes_of_class_instances (class_inst_index+1) class_instances + = class_instances + +renumber_icl_definitions_as_dcl_definitions :: !(Optional {{#Int}}) !{#Int} IndexRange !Int ![Declaration] !*{#DclModule} !*CommonDefs !*{#FunDef} + -> (![Declaration],!.{#DclModule},!.CommonDefs,!*{#FunDef}) +renumber_icl_definitions_as_dcl_definitions No icl_sizes icl_global_function_range main_dcl_module_n icl_decl_symbols modules cdefs fun_defs + = (icl_decl_symbols,modules,cdefs,fun_defs) +renumber_icl_definitions_as_dcl_definitions (Yes icl_to_dcl_index_table) icl_sizes icl_global_function_range main_dcl_module_n icl_decl_symbols modules cdefs fun_defs + # (size_icl_functions,fun_defs) = usize fun_defs + # icl_sizes = {{icl_sizes.[i] \\ i<-[0..cMacroDefs-1]} & [cFunctionDefs]=size_icl_functions} # (icl_decl_symbols,cdefs) = renumber_icl_decl_symbols icl_decl_symbols cdefs with renumber_icl_decl_symbols [] cdefs @@ -1079,35 +1146,48 @@ renumber_icl_definitions_as_dcl_definitions _ icl_decl_symbols modules cdefs icl = (Declaration {icl_decl_symbol & decl_index=icl_to_dcl_index_table.[cInstanceDefs,decl_index]},cdefs) renumber_icl_decl_symbol (Declaration icl_decl_symbol=:{decl_kind = STE_Generic, decl_index}) cdefs = (Declaration {icl_decl_symbol & decl_index=icl_to_dcl_index_table.[cGenericDefs,decl_index]},cdefs) + renumber_icl_decl_symbol icl_decl=:(Declaration icl_decl_symbol=:{decl_kind=STE_FunctionOrMacro _, decl_index}) cdefs +// | decl_index>=icl_global_function_range.ir_from && decl_index<icl_global_function_range.ir_to + = (Declaration {icl_decl_symbol & decl_index=icl_to_dcl_index_table.[cFunctionDefs,decl_index]},cdefs) +// = (icl_decl,cdefs) renumber_icl_decl_symbol icl_decl_symbol cdefs = (icl_decl_symbol,cdefs) + # (dcl_mod,modules) = modules![main_dcl_module_n] + # {n_dictionary_types,n_dictionary_selectors,n_dictionary_constructors}=dcl_mod.dcl_dictionary_info # cdefs=reorder_common_definitions cdefs with reorder_common_definitions {com_type_defs,com_cons_defs,com_selector_defs,com_class_defs,com_member_defs,com_instance_defs,com_generic_defs} - # com_type_defs=reorder_array com_type_defs icl_to_dcl_index_table.[cTypeDefs] - # com_cons_defs=reorder_array com_cons_defs icl_to_dcl_index_table.[cConstructorDefs] - # com_selector_defs=reorder_array com_selector_defs icl_to_dcl_index_table.[cSelectorDefs] + # dummy_ident = {id_name="",id_info=nilPtr} + # com_type_defs=reorder_and_enlarge_array com_type_defs n_dictionary_types icl_to_dcl_index_table.[cTypeDefs] + {td_name=dummy_ident,td_index= -1,td_arity=0,td_args=[],td_attrs=[],td_context=[],td_rhs=UnknownType,td_attribute=TA_None,td_pos=NoPos,td_used_types=[]} + # dummy_symbol_type={st_vars=[],st_args=[],st_arity=0,st_result={at_attribute=TA_None,at_annotation=AN_None,at_type=TE},st_context=[],st_attr_vars=[],st_attr_env=[]} + # com_selector_defs=reorder_and_enlarge_array com_selector_defs n_dictionary_selectors icl_to_dcl_index_table.[cSelectorDefs] + {sd_symb=dummy_ident,sd_field=dummy_ident,sd_type=dummy_symbol_type,sd_exi_vars=[],sd_field_nr=0,sd_type_index=0,sd_type_ptr=nilPtr,sd_pos=NoPos} + # com_cons_defs=reorder_and_enlarge_array com_cons_defs n_dictionary_constructors icl_to_dcl_index_table.[cConstructorDefs] + {cons_symb=dummy_ident,cons_type=dummy_symbol_type,cons_arg_vars=[],cons_priority=NoPrio,cons_index= -1,cons_type_index= -1,cons_exi_vars=[],cons_type_ptr=nilPtr,cons_pos=NoPos} # com_class_defs=reorder_array com_class_defs icl_to_dcl_index_table.[cClassDefs] # com_member_defs=reorder_array com_member_defs icl_to_dcl_index_table.[cMemberDefs] # com_instance_defs=reorder_array com_instance_defs icl_to_dcl_index_table.[cInstanceDefs] # com_generic_defs=reorder_array com_generic_defs icl_to_dcl_index_table.[cGenericDefs] = { -// com_unexpanded_type_defs={}, com_type_defs=com_type_defs,com_cons_defs=com_cons_defs,com_selector_defs=com_selector_defs, com_class_defs=com_class_defs,com_member_defs=com_member_defs,com_instance_defs=com_instance_defs,com_generic_defs=com_generic_defs } - where - reorder_array array index_array - # new_array={e\\e<-:array} - = {new_array & [index_array.[i]]=e \\ e<-:array & i<-[0..]} - # conversion_table = {if (kind_index<=cInstanceDefs) {i\\i<-[0..size table-1]} table \\ table<-:conversion_table & kind_index<-[0..]} - # modules = {modules & [main_dcl_module_n].dcl_conversions=Yes conversion_table} - = (icl_decl_symbols,modules,cdefs,cs) - -combineDclAndIclModule :: ModuleKind *{#DclModule} [Declaration] (CollectedDefinitions a b) *{#Int} *CheckState - -> (!CopiedDefinitions, !*{#DclModule}, ![Declaration], !CollectedDefinitions a b, !*{#Int}, !*CheckState); + # fun_defs = reorder_array fun_defs icl_to_dcl_index_table.[cFunctionDefs] + = (icl_decl_symbols,modules,cdefs,fun_defs) + where + reorder_array array index_array + # new_array={e\\e<-:array} + = {new_array & [index_array.[i]]=e \\ e<-:array & i<-[0..]} + + reorder_and_enlarge_array array n_extra_elements index_array dummy_element + # new_array=createArray (size array+n_extra_elements) dummy_element + = {new_array & [index_array.[i]] = e \\ e<-:array & i<-[0..]} + +combineDclAndIclModule :: ModuleKind *{#DclModule} [Declaration] (CollectedDefinitions a b) *{#Int} *CheckState + -> (!CopiedDefinitions,!Optional {#{#Int}},!*{#DclModule},![Declaration],!CollectedDefinitions a b, !*{#Int}, !*CheckState); combineDclAndIclModule MK_Main modules icl_decl_symbols icl_definitions icl_sizes cs - = ({ copied_type_defs = {}, copied_class_defs = {} }, modules, icl_decl_symbols, icl_definitions, icl_sizes, cs) + = ({ copied_type_defs = {}, copied_class_defs = {} }, No, modules, icl_decl_symbols, icl_definitions, icl_sizes, cs) combineDclAndIclModule _ modules icl_decl_symbols icl_definitions icl_sizes cs #! main_dcl_module_n=cs.cs_x.x_main_dcl_module_n # (dcl_mod=:{dcl_declared={dcls_local},dcl_macros, dcl_sizes, dcl_common}, modules) = modules![main_dcl_module_n] @@ -1116,7 +1196,6 @@ combineDclAndIclModule _ modules icl_decl_symbols icl_definitions icl_sizes cs (moved_dcl_defs, conversion_table, icl_sizes, icl_decl_symbols, cs) = foldSt (add_to_conversion_table dcl_macros.ir_from dcl_common) dcls_local ([], { createArray size NoIndex \\ size <-: dcl_sizes }, icl_sizes, icl_decl_symbols, cs) - (new_type_defs, new_class_defs, new_cons_defs, new_selector_defs, new_member_defs, new_generic_defs, (cop_td_indexes, cop_cd_indexes), cs) = foldSt (add_dcl_definition dcl_common) moved_dcl_defs ([], [], [], [], [], [], ([], []), cs) cs_symbol_table @@ -1126,7 +1205,8 @@ combineDclAndIclModule _ modules icl_decl_symbols icl_definitions icl_sizes cs # copied_type_defs = mark_copied_definitions n_dcl_types cop_td_indexes # copied_class_defs = mark_copied_definitions n_dcl_classes cop_cd_indexes = ( { copied_type_defs = copied_type_defs, copied_class_defs = copied_class_defs } - , { modules & [main_dcl_module_n] = { dcl_mod & dcl_conversions = Yes conversion_table }} + , Yes conversion_table + , { modules & [main_dcl_module_n] = { dcl_mod & dcl_macro_conversions = Yes conversion_table.[cMacroDefs] }} , icl_decl_symbols , { icl_definitions & def_types = my_append icl_definitions.def_types new_type_defs @@ -1134,7 +1214,7 @@ combineDclAndIclModule _ modules icl_decl_symbols icl_definitions icl_sizes cs , def_selectors = my_append icl_definitions.def_selectors new_selector_defs , def_classes = my_append icl_definitions.def_classes new_class_defs , def_members = my_append icl_definitions.def_members new_member_defs - , def_generics = my_append icl_definitions.def_generics new_generic_defs // AA + , def_generics = my_append icl_definitions.def_generics new_generic_defs } , icl_sizes , { cs & cs_symbol_table = cs_symbol_table } @@ -1147,7 +1227,7 @@ where = foldSt mark_def not_to_be_checked marks where mark_def index marks = { marks & [index] = True } - + add_to_conversion_table first_macro_index dcl_common decl=:(Declaration {decl_ident=decl_ident=:{id_info},decl_kind,decl_index,decl_pos}) (moved_dcl_defs, conversion_table, icl_sizes, icl_defs, cs) # (entry=:{ste_kind,ste_index,ste_def_level}, cs_symbol_table) = readPtr id_info cs.cs_symbol_table @@ -1159,24 +1239,20 @@ where = ([ decl : moved_dcl_defs ], conversion_table, icl_sizes, icl_defs, { cs & cs_symbol_table = cs_symbol_table }) | def_index == cMacroDefs # (conversion_table, icl_defs, cs_symbol_table) - = add_macro_declaration id_info entry decl def_index (decl_index - first_macro_index) decl_index - (conversion_table, icl_defs, cs_symbol_table) - = ([ decl : moved_dcl_defs ], conversion_table, icl_sizes, icl_defs, { cs & cs_symbol_table = cs_symbol_table }) + = add_macro_declaration id_info entry decl (decl_index - first_macro_index) /*decl_index*/ (conversion_table, icl_defs, cs_symbol_table) + = (moved_dcl_defs /* [ decl : moved_dcl_defs ] */, conversion_table, icl_sizes, icl_defs, { cs & cs_symbol_table = cs_symbol_table }) # cs_error = checkError "undefined in implementation module" "" (setErrorAdmin (newPosition decl_ident decl_pos) cs.cs_error) = (moved_dcl_defs, conversion_table, icl_sizes, icl_defs, { cs & cs_error = cs_error, cs_symbol_table = cs_symbol_table }) | ste_def_level == cGlobalScope && ste_kind == decl_kind # def_index = toInt decl_kind - decl_index = if (def_index == cMacroDefs) (decl_index - first_macro_index) decl_index + # decl_index = if (def_index == cMacroDefs) (decl_index - first_macro_index) decl_index = (moved_dcl_defs, { conversion_table & [def_index].[decl_index] = ste_index }, icl_sizes, icl_defs, { cs & cs_symbol_table = cs_symbol_table }) - # cs_error = checkError "conflicting definition in implementation module" "" - (setErrorAdmin (newPosition decl_ident decl_pos) cs.cs_error) - = (moved_dcl_defs, conversion_table, icl_sizes, icl_defs, { cs & cs_error = cs_error, cs_symbol_table = cs_symbol_table }) - -/* To be done : cClassDefs and cMemberDefs */ + # cs_error = checkError "conflicting definition in implementation module" "" (setErrorAdmin (newPosition decl_ident decl_pos) cs.cs_error) + = (moved_dcl_defs, conversion_table, icl_sizes, icl_defs, { cs & cs_error = cs_error, cs_symbol_table = cs_symbol_table }) can_be_only_in_dcl def_kind = def_kind == cTypeDefs || def_kind == cConstructorDefs || def_kind == cSelectorDefs - || def_kind == cClassDefs || def_kind == cMemberDefs /*AA*/ || def_kind == cGenericDefs + || def_kind == cClassDefs || def_kind == cMemberDefs || def_kind == cGenericDefs is_abstract_type com_type_defs decl_index = case com_type_defs.[decl_index].td_rhs of (AbstractType _) -> True ; _ -> False @@ -1189,10 +1265,10 @@ where , NewEntry symbol_table info_ptr dcl.decl_kind icl_index cGlobalScope entry ) - add_macro_declaration info_ptr entry (Declaration dcl) def_index decl_index icl_index (conversion_table, icl_defs, symbol_table) - = ( { conversion_table & [def_index].[decl_index] = icl_index } - , [ Declaration { dcl & decl_index = icl_index } : icl_defs ] - , NewEntry symbol_table info_ptr dcl.decl_kind icl_index cGlobalScope entry + add_macro_declaration info_ptr entry decl=:(Declaration dcl) decl_index /*icl_index*/ (conversion_table, icl_defs, symbol_table) + = ( { conversion_table & [cMacroDefs].[decl_index] = -1 /*icl_index*/ } + , [ decl /* Declaration { dcl & decl_index = icl_index } */ : icl_defs ] + , NewEntry symbol_table info_ptr dcl.decl_kind dcl.decl_index /*icl_index*/ cGlobalScope entry ) add_dcl_definition {com_type_defs} dcl=:(Declaration {decl_kind = STE_Type, decl_index}) @@ -1271,11 +1347,51 @@ where my_append front back = front ++ back +replace_icl_macros_by_dcl_macros :: ModuleKind IndexRange [Declaration] *{#DclModule} *CheckState -> (![Declaration],!*{#DclModule},!*CheckState); +replace_icl_macros_by_dcl_macros MK_Main icl_macro_index_range decls dcl_modules cs + = (decls,dcl_modules,cs) +replace_icl_macros_by_dcl_macros _ {ir_from=first_icl_macro_index,ir_to=end_icl_macro_index} decls dcl_modules cs + #! main_dcl_module_n=cs.cs_x.x_main_dcl_module_n + # ({dcl_macros={ir_from=first_macro_n},dcl_macro_conversions},dcl_modules) = dcl_modules![main_dcl_module_n] + | case dcl_macro_conversions of No -> True ; _ -> False + = (decls,dcl_modules,cs) + # (Yes dcl_to_icl_table) = dcl_macro_conversions + # macro_renumber_table = create_icl_to_dcl_index_table_for_macros dcl_to_icl_table + with + create_icl_to_dcl_index_table_for_macros :: !{#Int} -> {#Int} + create_icl_to_dcl_index_table_for_macros dcl_to_icl_table + # macro_renumber_table = createArray (end_icl_macro_index-first_icl_macro_index) NoIndex + # size_dcl_to_icl_table = size dcl_to_icl_table + # macro_renumber_table = fill_macro_renumber_table 0 macro_renumber_table + with + fill_macro_renumber_table decl_index macro_renumber_table + | decl_index<size_dcl_to_icl_table + # i=dcl_to_icl_table.[decl_index] + | i>=first_icl_macro_index && i<end_icl_macro_index + = fill_macro_renumber_table (decl_index+1) {macro_renumber_table & [i-first_icl_macro_index]=decl_index} + = fill_macro_renumber_table (decl_index+1) macro_renumber_table // for a macro that only occurs in the dcl module and not in the icl module + = macro_renumber_table + = macro_renumber_table + + # decls = replace_icl_macros_by_dcl_macros decls + with + replace_icl_macros_by_dcl_macros [decl=:(Declaration decl_record=:{decl_kind=STE_FunctionOrMacro _,decl_index}):decls] + # dcl_n=macro_renumber_table.[decl_index-first_icl_macro_index] + # decls = replace_icl_macros_by_dcl_macros decls; + | decl_index>=first_icl_macro_index && decl_index<end_icl_macro_index && dcl_n<>NoIndex +// | trace_tn ("replace_icl_macros_by_dcl_macros "+++toString decl_record.decl_ident+++" "+++toString decl_index+++" "+++toString (first_macro_n+dcl_n)) + = [Declaration {decl_record & decl_kind=STE_DclMacroOrLocalMacroFunction [], decl_index=first_macro_n+dcl_n} : decls] + = [decl : decls] + replace_icl_macros_by_dcl_macros [decl:decls] + = [decl : replace_icl_macros_by_dcl_macros decls] + replace_icl_macros_by_dcl_macros [] + = [] + = (decls,dcl_modules,cs) + (<=<) infixl (<=<) state fun :== fun state - -checkDclModules imports_of_icl_mod dcl_modules icl_functions heaps cs=:{cs_symbol_table} +checkDclModules imports_of_icl_mod dcl_modules icl_functions macro_defs heaps cs=:{cs_symbol_table} #! nr_of_dcl_modules = size dcl_modules # (bitvect, dependencies, dcl_modules, cs_symbol_table) @@ -1322,12 +1438,12 @@ checkDclModules imports_of_icl_mod dcl_modules icl_functions heaps cs=:{cs_symbo = { cs & cs_symbol_table = cs_symbol_table } nr_of_icl_component = component_numbers.[index_of_icl_module] - (_, expl_imp_infos, dcl_modules, icl_functions, heaps, cs) + (_, expl_imp_infos, dcl_modules, icl_functions, macro_defs, heaps, cs) = unsafeFold2St (checkDclComponent components_array super_components) (reverse expl_imp_indices) (reverse components) - (nr_of_components-1, expl_imp_infos, dcl_modules, icl_functions, heaps, cs) + (nr_of_components-1, expl_imp_infos, dcl_modules, icl_functions, macro_defs, heaps, cs) // # cs = cs--->"------------------------------------" = (nr_of_icl_component, hd expl_imp_indices!!nr_of_icl_component, directly_imported_dcl_modules, - expl_imp_infos, dcl_modules, icl_functions, heaps, cs) + expl_imp_infos, dcl_modules, icl_functions, macro_defs, heaps, cs) where add_dependencies mod_index (bitvect, dependencies, dcl_modules, cs_symbol_table) // all i: not bitvect.[i] @@ -1426,12 +1542,12 @@ checkDclModules imports_of_icl_mod dcl_modules icl_functions heaps cs=:{cs_symbo -> ([ident:expl_imp_symbols_accu], nr_of_expl_imp_symbols+1,[ini:expl_imp_indices_accu], cs_symbol_table) checkDclComponent :: !{![Int]} !{![Int]} ![[(Index, Position, [ImportNrAndIdents])]] ![Int] - !(!Int, !*ExplImpInfos, !*{# DclModule}, !*{# FunDef}, !*Heaps,!*CheckState) - -> (!Int, !*ExplImpInfos, !.{# DclModule}, !.{# FunDef}, !.Heaps,!.CheckState) + !(!Int, !*ExplImpInfos, !*{# DclModule},!*{# FunDef},!*{#*{#FunDef}},!*Heaps,!*CheckState) + -> (!Int, !*ExplImpInfos, !.{# DclModule},!.{# FunDef},!*{#*{#FunDef}},!.Heaps,!.CheckState) checkDclComponent components_array super_components expl_imp_indices mod_indices - (component_nr, expl_imp_infos, dcl_modules, icl_functions, heaps, cs=:{cs_x}) + (component_nr, expl_imp_infos, dcl_modules, icl_functions, macro_defs, heaps, cs=:{cs_x}) | not cs.cs_error.ea_ok || hd mod_indices==size dcl_modules // the icl module! - = (component_nr-1, expl_imp_infos, dcl_modules, icl_functions, heaps, cs) + = (component_nr-1, expl_imp_infos, dcl_modules, icl_functions, macro_defs, heaps, cs) // | False--->("checkDclComponent", mod_indices, size dcl_modules) = undef # ({dcl_name=dcl_name_of_first_mod_in_component}, dcl_modules) = dcl_modules![hd mod_indices] @@ -1445,7 +1561,7 @@ checkDclComponent components_array super_components expl_imp_indices mod_indices # (expl_imp_infos, dcl_modules, cs_symbol_table) = foldSt (just_update_expl_imp_info components_array super_components) mod_indices (expl_imp_infos, dcl_modules, cs.cs_symbol_table) - -> (component_nr-1, expl_imp_infos, dcl_modules, icl_functions, heaps, + -> (component_nr-1, expl_imp_infos, dcl_modules, icl_functions, macro_defs, heaps, { cs & cs_symbol_table = cs_symbol_table }) STE_Module _ # is_on_cycle @@ -1472,7 +1588,7 @@ checkDclComponent components_array super_components expl_imp_indices mod_indices cs = { cs & cs_error = cs_error } | not cs.cs_error.ea_ok - -> (component_nr-1, expl_imp_infos, dcl_modules, icl_functions, heaps, cs) + -> (component_nr-1, expl_imp_infos, dcl_modules, icl_functions, macro_defs, heaps, cs) # (expl_imp_infos, dcl_modules, cs) = case is_on_cycle of True @@ -1495,7 +1611,7 @@ checkDclComponent components_array super_components expl_imp_indices mod_indices = mapSt (solveExplicitImports expl_imp_indices_ikh modules_in_component_set) mod_indices (dcl_modules, bitvectCreate nr_of_modules, expl_imp_info, cs) | not cs.cs_error.ea_ok - -> (component_nr-1, expl_imp_infos, dcl_modules, icl_functions, heaps, cs) + -> (component_nr-1, expl_imp_infos, dcl_modules, icl_functions, macro_defs, heaps, cs) # imports_ikh = fold2St (ikhInsert` False) mod_indices imports ikhEmpty // maps the module indices of all modules in the actual component to all explicit @@ -1505,30 +1621,26 @@ checkDclComponent components_array super_components expl_imp_indices mod_indices = switch_port_to_new_syntax (possibly_write_expl_imports_of_main_dcl_mod_to_file imports_ikh dcl_modules cs) (dcl_modules, cs) - - (afterwards_info, (expl_imp_infos, dcl_modules, icl_functions, heaps, cs)) - = mapSt (checkDclModuleWithinComponent dcl_imported_module_numbers component_nr is_on_cycle modules_in_component_set - super_components imports_ikh) mod_indices - (expl_imp_infos, dcl_modules, icl_functions, heaps, cs) - + + (afterwards_info, (expl_imp_infos, dcl_modules, icl_functions, macro_defs, heaps, cs)) + = mapSt (checkDclModuleWithinComponent dcl_imported_module_numbers component_nr is_on_cycle modules_in_component_set super_components imports_ikh) + mod_indices (expl_imp_infos, dcl_modules, icl_functions, macro_defs, heaps, cs) | not cs.cs_error.ea_ok - -> (component_nr-1, expl_imp_infos, dcl_modules, icl_functions, heaps, cs) + -> (component_nr-1, expl_imp_infos, dcl_modules, icl_functions, macro_defs, heaps, cs) - # (dcl_modules, icl_functions, heaps, cs) + # (dcl_modules, icl_functions,macro_defs,heaps, cs) = case is_on_cycle of False - -> (dcl_modules, icl_functions, heaps, cs) + -> (dcl_modules, icl_functions, macro_defs,heaps, cs) True - # (dcl_modules, icl_functions, hp_expression_heap, cs) + # (dcl_modules, icl_functions, macro_defs,hp_expression_heap, cs) = fold2St check_expl_imp_completeness_of_dcl_mod_within_non_trivial_component mod_indices imports - (dcl_modules, icl_functions, heaps.hp_expression_heap, cs) - -> (dcl_modules, icl_functions, { heaps & hp_expression_heap = hp_expression_heap }, cs) + (dcl_modules, icl_functions,macro_defs,heaps.hp_expression_heap, cs) + -> (dcl_modules, icl_functions, macro_defs,{ heaps & hp_expression_heap = hp_expression_heap }, cs) (dcl_modules, heaps, cs) - = fold2St doSomeThingsThatHaveToBeDoneAfterTheWholeComponentHasBeenChecked - mod_indices afterwards_info - (dcl_modules, heaps, cs) - -> (component_nr-1, expl_imp_infos, dcl_modules, icl_functions, heaps, cs) + = fold2St checkInstancesOfDclModule mod_indices afterwards_info (dcl_modules, heaps, cs) + -> (component_nr-1, expl_imp_infos, dcl_modules, icl_functions, macro_defs, heaps, cs) where check_whether_module_imports_itself expl_imp_indices_for_module mod_index cs_error = foldSt (check_that mod_index) expl_imp_indices_for_module cs_error @@ -1569,20 +1681,15 @@ checkDclComponent components_array super_components expl_imp_indices mod_indices dcl_modules expl_imp_infos cs_symbol_table = (expl_imp_infos, dcl_modules, cs_symbol_table) - check_expl_imp_completeness_of_dcl_mod_within_non_trivial_component mod_index {si_explicit} - (dcl_modules, icl_functions, hp_expression_heap, cs) - # ({dcl_declared}, dcl_modules) - = dcl_modules![mod_index] - ({dcls_local_for_import, dcls_import}) - = dcl_declared - cs - = addDeclarationsOfDclModToSymbolTable mod_index dcls_local_for_import dcls_import cs - (dcl_modules, icl_functions, hp_expression_heap, cs=:{cs_symbol_table}) - = checkExplicitImportCompleteness si_explicit - dcl_modules icl_functions hp_expression_heap cs + check_expl_imp_completeness_of_dcl_mod_within_non_trivial_component mod_index {si_explicit} (dcl_modules, icl_functions,macro_defs,hp_expression_heap, cs) + # ({dcl_declared}, dcl_modules) = dcl_modules![mod_index] + ({dcls_local_for_import, dcls_import}) = dcl_declared + cs = addDeclarationsOfDclModToSymbolTable mod_index dcls_local_for_import dcls_import cs + (dcl_modules, icl_functions,macro_defs,hp_expression_heap, cs=:{cs_symbol_table}) + = checkExplicitImportCompleteness si_explicit dcl_modules icl_functions macro_defs hp_expression_heap cs cs_symbol_table = removeImportsAndLocalsOfModuleFromSymbolTable dcl_declared cs.cs_symbol_table - = (dcl_modules, icl_functions, hp_expression_heap, { cs & cs_symbol_table = cs_symbol_table }) + = (dcl_modules, icl_functions,macro_defs,hp_expression_heap, { cs & cs_symbol_table = cs_symbol_table }) compute_used_module_nrs (mod_index, _, _) (mod_nr_accu, dcl_modules) | inNumberSet mod_index mod_nr_accu @@ -1594,7 +1701,7 @@ compute_used_module_nrs (mod_index, _, _) (mod_nr_accu, dcl_modules) checkDclModuleWithinComponent dcl_imported_module_numbers component_nr is_on_cycle modules_in_component_set super_components imports_ikh mod_index - (expl_imp_infos, dcl_modules, icl_functions, heaps, cs=:{cs_symbol_table}) + (expl_imp_infos, dcl_modules, icl_functions, macro_defs, heaps, cs=:{cs_symbol_table}) # ({dcl_name}, dcl_modules) = dcl_modules![mod_index] (mod_entry, cs_symbol_table) @@ -1607,84 +1714,183 @@ checkDclModuleWithinComponent dcl_imported_module_numbers component_nr is_on_cyc = writePtr dcl_name.id_info { mod_entry & ste_kind = STE_ClosedModule } cs.cs_symbol_table = checkDclModule dcl_imported_module_numbers super_components.[mod_index] imports_ikh component_nr is_on_cycle modules_in_component_set - mod ste_index expl_imp_infos dcl_modules icl_functions heaps + mod ste_index expl_imp_infos dcl_modules icl_functions macro_defs heaps { cs & cs_symbol_table = cs_symbol_table } +renumber_icl_module :: ModuleKind IndexRange IndexRange Index Int {#Int} (Optional {#{#Int}}) IndexRange *{#FunDef} *CommonDefs [Declaration] *{#DclModule} + -> (![IndexRange],![IndexRange],!Int,!Index,!IndexRange,!*{#FunDef},!*CommonDefs,![Declaration],!*{#DclModule}); +renumber_icl_module mod_type icl_global_function_range icl_instance_range nr_of_functions main_dcl_module_n icl_sizes dcl_conversions def_macro_indices icl_functions icl_common local_defs dcl_modules + + # (optional_icl_to_dcl_index_table,optional_old_conversion_table,dcl_modules,icl_functions) + = create_icl_to_dcl_index_table mod_type icl_sizes icl_global_function_range main_dcl_module_n dcl_conversions dcl_modules icl_functions + + # (dcl_mod, dcl_modules) = dcl_modules![main_dcl_module_n] + # icl_functions = add_dummy_specialized_functions mod_type dcl_mod icl_functions + # class_instances = icl_common.com_instance_defs + # (dcl_icl_conversions, class_instances) + = add_dcl_instances_to_conversion_table optional_old_conversion_table nr_of_functions dcl_mod class_instances + # (n_functions,icl_functions) = usize icl_functions + # optional_icl_to_dcl_index_table = recompute_icl_to_dcl_index_table_for_functions optional_icl_to_dcl_index_table dcl_icl_conversions n_functions + # class_instances = renumber_member_indexes_of_class_instances optional_icl_to_dcl_index_table class_instances + # icl_common = {icl_common & com_instance_defs = class_instances} + + # (local_defs,dcl_modules,icl_common,icl_functions) + = renumber_icl_definitions_as_dcl_definitions optional_icl_to_dcl_index_table icl_sizes icl_global_function_range main_dcl_module_n local_defs dcl_modules icl_common icl_functions + # (dcl_mod, dcl_modules) = dcl_modules![main_dcl_module_n] + + #! dcl_instances = dcl_mod.dcl_instances + #! n_exported_global_functions=dcl_mod.dcl_sizes.[cFunctionDefs] + #! first_not_exported_global_function_index = size dcl_mod.dcl_functions + + # n_dcl_instances = dcl_instances.ir_to-dcl_instances.ir_from + # local_functions_index_offset = n_dcl_instances; + + # dcl_mod = case dcl_mod of + dcl_mod=:{dcl_macro_conversions=Yes conversion_table} + # new_macro_conversions = {old_icl_macro_index+local_functions_index_offset \\ old_icl_macro_index<-:conversion_table} + -> {dcl_mod & dcl_macro_conversions=Yes new_macro_conversions} + dcl_mod + -> dcl_mod + # dcl_modules = {dcl_modules & [main_dcl_module_n]=dcl_mod} + + # n_global_functions=icl_global_function_range.ir_to + # n_not_exported_global_functions=n_global_functions-n_exported_global_functions + # end_not_exported_global_functions_range=first_not_exported_global_function_index+n_not_exported_global_functions + # icl_global_functions_ranges = [{ir_from=icl_global_function_range.ir_from,ir_to=n_exported_global_functions}, + {ir_from=first_not_exported_global_function_index,ir_to=end_not_exported_global_functions_range}] + + # first_macro_index = def_macro_indices.ir_from+local_functions_index_offset + # end_macro_indexes = def_macro_indices.ir_to+local_functions_index_offset + # def_macro_indices={ir_from=first_macro_index,ir_to=end_macro_indexes} + + # icl_instances_ranges = [dcl_instances,{ir_from=icl_instance_range.ir_from+n_dcl_instances,ir_to=icl_instance_range.ir_to}] + + = (icl_global_functions_ranges,icl_instances_ranges,n_exported_global_functions,local_functions_index_offset,def_macro_indices,icl_functions,icl_common,local_defs,dcl_modules) + + where + + add_dummy_specialized_functions MK_Main dcl_mod icl_functions + = icl_functions + add_dummy_specialized_functions _ {dcl_specials={ir_from,ir_to}} icl_functions + # n_specials = ir_to-ir_from + | n_specials==0 + = icl_functions + # dummy_function = {fun_symb={id_name="",id_info=nilPtr},fun_arity= -1,fun_priority=NoPrio,fun_body=NoBody,fun_type=No,fun_pos=NoPos,fun_kind=FK_Unknown,fun_lifted=0,fun_info=EmptyFunInfo} + = arrayPlusList icl_functions [dummy_function \\ i<-[0..n_specials-1]] + + add_dcl_instances_to_conversion_table :: (Optional {#{#Int}}) !Index !DclModule !*{# ClassInstance} -> (!*Optional *{#Index},!*{# ClassInstance}) + add_dcl_instances_to_conversion_table optional_old_conversion_table first_free_index dcl_mod=:{dcl_specials,dcl_functions,dcl_common,dcl_macro_conversions} icl_instances + = case dcl_macro_conversions of + Yes _ + # (new_conversion_table, icl_instances) + = build_conversion_table_for_instances_of_dcl_mod dcl_specials first_free_index optional_old_conversion_table + dcl_functions dcl_common.com_instance_defs icl_instances + -> (Yes new_conversion_table,icl_instances) + No + -> (No,icl_instances) + where + build_conversion_table_for_instances_of_dcl_mod {ir_from,ir_to} first_free_index optional_old_conversion_table dcl_functions dcl_instances icl_instances + #! nr_of_dcl_functions = size dcl_functions + # (Yes old_conversion_table) = optional_old_conversion_table + # dcl_instances_table = old_conversion_table.[cInstanceDefs] + dcl_function_table = old_conversion_table.[cFunctionDefs] + new_table = { createArray nr_of_dcl_functions NoIndex & [i] = icl_index \\ icl_index <-: dcl_function_table & i <- [0..] } + index_diff = first_free_index - ir_from + new_table = { new_table & [i] = i + index_diff \\ i <- [ir_from .. ir_to - 1] } + = build_conversion_table_for_instances 0 dcl_instances dcl_instances_table icl_instances new_table + + build_conversion_table_for_instances dcl_class_inst_index dcl_instances class_instances_table icl_instances new_table + | dcl_class_inst_index < size class_instances_table + # icl_index = class_instances_table.[dcl_class_inst_index] + # (icl_instance, icl_instances) = icl_instances![icl_index] + dcl_instance = dcl_instances.[dcl_class_inst_index] + # new_table = build_conversion_table_for_instances_of_members 0 dcl_instance.ins_members icl_instance.ins_members new_table + = build_conversion_table_for_instances (inc dcl_class_inst_index) dcl_instances class_instances_table icl_instances new_table + = (new_table, icl_instances) + + build_conversion_table_for_instances_of_members mem_index dcl_members icl_members new_table + | mem_index < size dcl_members + # dcl_member = dcl_members.[mem_index] + icl_member = icl_members.[mem_index] + # new_table = {new_table & [dcl_member.ds_index] = icl_member.ds_index} + = build_conversion_table_for_instances_of_members (inc mem_index) dcl_members icl_members new_table + = new_table + +checkModule :: !ScannedModule !IndexRange ![FunDef] !Int !Int !(Optional ScannedModule) ![ScannedModule] !{#DclModule} !*{#*{#FunDef}} !*PredefinedSymbols !*SymbolTable !*File !*Heaps + -> (!Bool, *IclModule, *{# DclModule}, *{! Group}, !*{#*{#FunDef}},!Int, !*Heaps, !*PredefinedSymbols, !*SymbolTable, *File, [String]) -checkModule :: !ScannedModule !IndexRange ![FunDef] !Int !Int !(Optional ScannedModule) ![ScannedModule] !{#DclModule} !{#FunDef} !*PredefinedSymbols !*SymbolTable !*File !*Heaps - -> (!Bool, *IclModule, *{# DclModule}, *{! Group}, !(Optional {# Index}), !.{#FunDef},!Int, !*Heaps, !*PredefinedSymbols, !*SymbolTable, *File, [String]) checkModule m icl_global_function_range fun_defs n_functions_and_macros_in_dcl_modules dcl_module_n_in_cache - optional_dcl_mod scanned_modules dcl_modules functions_and_macros predef_symbols symbol_table err_file heaps + optional_dcl_mod scanned_modules dcl_modules cached_dcl_macros predef_symbols symbol_table err_file heaps # nr_of_cached_modules = size dcl_modules # (optional_pre_def_mod,predef_symbols) = case nr_of_cached_modules of 0 # (predef_mod,predef_symbols) = buildPredefinedModule predef_symbols -> (Yes predef_mod,predef_symbols) _ -> (No,predef_symbols) - # (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) - = check_module1 m icl_global_function_range fun_defs optional_dcl_mod optional_pre_def_mod scanned_modules dcl_modules functions_and_macros dcl_module_n_in_cache predef_symbols symbol_table err_file + # (mod_name,mod_imported_objects,mod_imports,mod_type,icl_global_function_range,nr_of_functions,first_inst_index,local_defs,icl_functions,macro_defs,init_dcl_modules,main_dcl_module_n,cdefs,sizes,cs) + = check_module1 m icl_global_function_range fun_defs optional_dcl_mod optional_pre_def_mod scanned_modules dcl_modules cached_dcl_macros dcl_module_n_in_cache predef_symbols symbol_table err_file # icl_instance_range = {ir_from = first_inst_index, ir_to = nr_of_functions} - - = check_module2 mod_name m.mod_modification_time mod_imported_objects mod_imports mod_type icl_global_function_range icl_instance_range nr_of_cached_modules 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 + = check_module2 mod_name m.mod_modification_time mod_imported_objects mod_imports mod_type icl_global_function_range icl_instance_range nr_of_functions nr_of_cached_modules optional_pre_def_mod local_defs icl_functions macro_defs init_dcl_modules cdefs sizes heaps cs -check_module1 {mod_type,mod_name,mod_imports,mod_imported_objects,mod_defs = cdefs} icl_global_function_range fun_defs optional_dcl_mod optional_pre_def_mod scanned_modules dcl_modules functions_and_macros dcl_module_n_in_cache predef_symbols symbol_table err_file +check_module1 {mod_type,mod_name,mod_imports,mod_imported_objects,mod_defs = cdefs} icl_global_function_range fun_defs optional_dcl_mod optional_pre_def_mod scanned_modules dcl_modules cached_dcl_macros dcl_module_n_in_cache predef_symbols symbol_table err_file # error = {ea_file = err_file, ea_loc = [], ea_ok = True } - first_inst_index = length fun_defs + size functions_and_macros + first_inst_index = length fun_defs (inst_fun_defs, def_instances) = convert_class_instances cdefs.def_instances first_inst_index - 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]} + icl_functions = { next_fun \\ next_fun <- fun_defs ++ inst_fun_defs } cdefs = { cdefs & def_instances = def_instances } #! nr_of_functions = size icl_functions # sizes_and_local_defs = collectCommonfinitions cdefs (icl_functions, sizes_and_local_defs) = collectGlobalFunctions cFunctionDefs icl_global_function_range.ir_from icl_global_function_range.ir_to icl_functions sizes_and_local_defs - (icl_functions, (sizes, local_defs)) = collectMacros cdefs.def_macros icl_functions sizes_and_local_defs + + (icl_functions, (sizes, local_defs)) = collectMacros cdefs.def_macro_indices icl_functions sizes_and_local_defs # nr_of_cached_modules = size dcl_modules main_dcl_module_n = if (dcl_module_n_in_cache<>NoIndex) dcl_module_n_in_cache nr_of_cached_modules - cs = { cs_symbol_table = symbol_table, cs_predef_symbols = predef_symbols, cs_error = error, cs_x= {x_needed_modules=0,x_main_dcl_module_n=main_dcl_module_n}} - (scanned_modules, icl_functions, cs) = add_dcl_module_predef_module_and_modules_to_symbol_table optional_dcl_mod optional_pre_def_mod scanned_modules nr_of_cached_modules icl_functions cs + cs = { cs_symbol_table = symbol_table, cs_predef_symbols = predef_symbols, cs_error = error, cs_x= {x_needed_modules=0,x_main_dcl_module_n=main_dcl_module_n}} + + (scanned_modules,macro_defs,cs) = add_dcl_module_predef_module_and_modules_to_symbol_table optional_dcl_mod optional_pre_def_mod scanned_modules nr_of_cached_modules cs + macro_defs = make_macro_def_array cached_dcl_macros macro_defs init_new_dcl_modules = gimme_a_strict_array_type { initialDclModule scanned_module module_n \\ scanned_module <- scanned_modules & module_n<-[nr_of_cached_modules..]} - - init_dcl_modules = { if (i<nr_of_cached_modules) + + init_dcl_modules = { if (i<size dcl_modules) dcl_modules.[i] - init_new_dcl_modules.[i-nr_of_cached_modules] - \\ i<-[0..nr_of_cached_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) + 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,macro_defs,init_dcl_modules,main_dcl_module_n,cdefs,sizes,cs) where - add_dcl_module_predef_module_and_modules_to_symbol_table (Yes dcl_mod) optional_predef_mod modules mod_index macro_and_fun_defs cs - # (mod_sizes_and_defs,macro_and_fun_defs,cs) = add_module_to_symbol_table dcl_mod mod_index macro_and_fun_defs cs - (mods, macro_and_fun_defs, cs) = add_predef_module_and_modules_to_symbol_table optional_predef_mod modules (inc mod_index) macro_and_fun_defs cs - = ([mod_sizes_and_defs : mods], macro_and_fun_defs, cs) - add_dcl_module_predef_module_and_modules_to_symbol_table No optional_predef_mod modules mod_index macro_and_fun_defs cs - = add_predef_module_and_modules_to_symbol_table optional_predef_mod modules mod_index macro_and_fun_defs cs + add_dcl_module_predef_module_and_modules_to_symbol_table (Yes dcl_mod) optional_predef_mod modules mod_index cs + # (mod_sizes_and_defs,dcl_macro_defs,cs) = add_module_to_symbol_table dcl_mod mod_index cs + (mods, macro_defs, cs) = add_predef_module_and_modules_to_symbol_table optional_predef_mod modules (inc mod_index) cs + = ([mod_sizes_and_defs:mods], [dcl_macro_defs:macro_defs], cs) + add_dcl_module_predef_module_and_modules_to_symbol_table No optional_predef_mod modules mod_index cs + = add_predef_module_and_modules_to_symbol_table optional_predef_mod modules mod_index cs - add_predef_module_and_modules_to_symbol_table (Yes predef_mod) modules mod_index macro_and_fun_defs cs - # (mod_sizes_and_defs,macro_and_fun_defs,cs) = add_module_to_symbol_table predef_mod mod_index macro_and_fun_defs cs - (mods, macro_and_fun_defs, cs) = add_modules_to_symbol_table modules (inc mod_index) macro_and_fun_defs cs - = ([mod_sizes_and_defs : mods], macro_and_fun_defs, cs) - add_predef_module_and_modules_to_symbol_table No modules mod_index macro_and_fun_defs cs - = add_modules_to_symbol_table modules mod_index macro_and_fun_defs cs + add_predef_module_and_modules_to_symbol_table (Yes predef_mod) modules mod_index cs + # (mod_sizes_and_defs,dcl_macro_defs,cs) = add_module_to_symbol_table predef_mod mod_index cs + (mods, macro_defs, cs) = add_modules_to_symbol_table modules (inc mod_index) cs + = ([mod_sizes_and_defs:mods],[dcl_macro_defs:macro_defs], cs) + add_predef_module_and_modules_to_symbol_table No modules mod_index cs + = add_modules_to_symbol_table modules mod_index cs - add_modules_to_symbol_table [] mod_index macro_and_fun_defs cs=:{cs_predef_symbols,cs_symbol_table,cs_x} + add_modules_to_symbol_table [] mod_index cs=:{cs_predef_symbols,cs_symbol_table,cs_x} # (cs_predef_symbols, cs_symbol_table) = (cs_predef_symbols, cs_symbol_table) <=< adjust_predefined_module_symbol PD_StdArray <=< adjust_predefined_module_symbol PD_StdEnum <=< adjust_predefined_module_symbol PD_StdBool <=< adjust_predefined_module_symbol PD_StdStrictLists <=< adjust_predefined_module_symbol PD_StdDynamic - <=< adjust_predefined_module_symbol PD_StdGeneric // AA - <=< adjust_predefined_module_symbol PD_StdMisc // AA + <=< adjust_predefined_module_symbol PD_StdGeneric + <=< adjust_predefined_module_symbol PD_StdMisc <=< adjust_predefined_module_symbol PD_PredefinedModule - = ([], macro_and_fun_defs, { cs & cs_predef_symbols = cs_predef_symbols, cs_symbol_table = cs_symbol_table}) + = ([], [], { cs & cs_predef_symbols = cs_predef_symbols, cs_symbol_table = cs_symbol_table}) where adjust_predefined_module_symbol :: !Index !(!*PredefinedSymbols, !*SymbolTable) -> (!*PredefinedSymbols, !*SymbolTable) adjust_predefined_module_symbol predef_index (pre_def_symbols, symbol_table) @@ -1695,20 +1901,22 @@ check_module1 {mod_type,mod_name,mod_imports,mod_imported_objects,mod_defs = cde -> ({ pre_def_symbols & [predef_index] = { mod_symb & pds_module = cs_x.x_main_dcl_module_n, pds_def = mod_entry.ste_index }}, symbol_table) _ -> (pre_def_symbols, symbol_table) + add_modules_to_symbol_table [mod : mods] mod_index cs + # (mod_sizes_and_defs,dcl_macro_defs,cs) = add_module_to_symbol_table mod mod_index cs + (mods, macro_defs, cs) = add_modules_to_symbol_table mods (inc mod_index) cs + = ([mod_sizes_and_defs:mods],[dcl_macro_defs:macro_defs], cs) - add_modules_to_symbol_table [mod : mods] mod_index macro_and_fun_defs cs - # (mod_sizes_and_defs,macro_and_fun_defs,cs) = add_module_to_symbol_table mod mod_index macro_and_fun_defs cs - (mods, macro_and_fun_defs, cs) = add_modules_to_symbol_table mods (inc mod_index) macro_and_fun_defs cs - = ([mod_sizes_and_defs : mods], macro_and_fun_defs, cs) - - add_module_to_symbol_table mod=:{mod_defs} mod_index macro_and_fun_defs cs=:{cs_predef_symbols,cs_symbol_table, cs_error} + add_module_to_symbol_table mod=:{mod_defs} mod_index cs=:{cs_predef_symbols,cs_symbol_table, cs_error} # def_instances = convert_class_instances mod_defs.def_instances mod_defs = { mod_defs & def_instances = def_instances } sizes_and_defs = collectFunctionTypes mod_defs.def_funtypes (collectCommonfinitions mod_defs) - (macro_and_fun_defs, (sizes, defs)) = collectMacros mod_defs.def_macros macro_and_fun_defs sizes_and_defs + + dcl_macro_defs={macro_def \\ macro_def<-mod_defs.def_macros} + (dcl_macro_defs, (sizes, defs)) = collectDclMacros mod_defs.def_macro_indices dcl_macro_defs sizes_and_defs + mod = { mod & mod_defs = mod_defs } (cs_symbol_table, cs_error) = addDefToSymbolTable cGlobalScope mod_index mod.mod_name (STE_Module mod) cs_symbol_table cs_error - = ((mod,sizes,defs),macro_and_fun_defs,{ cs & cs_symbol_table = cs_symbol_table, cs_error = cs_error }) + = ((mod,sizes,defs),dcl_macro_defs,{ cs & cs_symbol_table = cs_symbol_table, cs_error = cs_error }) where convert_class_instances :: ![ParsedInstance a] -> [ClassInstance] convert_class_instances [pi : pins] @@ -1731,196 +1939,126 @@ check_module1 {mod_type,mod_name,mod_imports,mod_imported_objects,mod_defs = cde determine_indexes_of_members [] next_fun_index = ([], next_fun_index) -replace_icl_macros_by_dcl_macros :: ModuleKind IndexRange [Declaration] *{#DclModule} *CheckState -> (![Declaration],!*{#DclModule},!*CheckState); -replace_icl_macros_by_dcl_macros MK_Main icl_macro_index_range decls dcl_modules cs - = (decls,dcl_modules,cs) -replace_icl_macros_by_dcl_macros _ {ir_from=first_icl_macro_index,ir_to=end_icl_macro_index} decls dcl_modules cs - #! main_dcl_module_n=cs.cs_x.x_main_dcl_module_n - # ({dcl_macros={ir_from=first_macro_n},dcl_conversions},dcl_modules) = dcl_modules![main_dcl_module_n] - | case dcl_conversions of No -> True ; _ -> False - = (decls,dcl_modules,cs) - # (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 - # macro_renumber_table = createArray (end_icl_macro_index-first_icl_macro_index) NoIndex - # size_dcl_to_icl_table = size dcl_to_icl_table - # macro_renumber_table = fill_macro_renumber_table 0 macro_renumber_table - with - fill_macro_renumber_table decl_index macro_renumber_table - | decl_index<size_dcl_to_icl_table - # i=dcl_to_icl_table.[decl_index] - | i>=first_icl_macro_index && i<end_icl_macro_index - = fill_macro_renumber_table (decl_index+1) {macro_renumber_table & [i-first_icl_macro_index]=decl_index} - = fill_macro_renumber_table (decl_index+1) macro_renumber_table // for a macro that only occurs in the dcl module and not in the icl module - = macro_renumber_table - = macro_renumber_table - - # decls = replace_icl_macros_by_dcl_macros decls - with - replace_icl_macros_by_dcl_macros [decl=:(Declaration decl_record=:{decl_kind=STE_FunctionOrMacro _,decl_index}):decls] - # icl_n=macro_renumber_table.[decl_index-first_icl_macro_index] - # decls = replace_icl_macros_by_dcl_macros decls; - | decl_index>=first_icl_macro_index && decl_index<end_icl_macro_index && icl_n<>NoIndex - = [Declaration {decl_record & decl_kind=STE_FunctionOrMacro [], decl_index=first_macro_n+icl_n} : decls] - = [decl : decls] - replace_icl_macros_by_dcl_macros [decl:decls] - = [decl : replace_icl_macros_by_dcl_macros decls] - replace_icl_macros_by_dcl_macros [] - = [] - = (decls,dcl_modules,cs) - -remove_function_conversion_table main_dcl_module_n dcl_modules - # (dcl_mod,dcl_modules) = dcl_modules![main_dcl_module_n] - = case dcl_mod.dcl_conversions of - No - -> ({},dcl_modules) - (Yes conversion_table) - #! size_function_conversions = size conversion_table.[cFunctionDefs] - # conversion_table = {e \\ e <-:conversion_table} - # (function_conversions,conversion_table) = replace conversion_table cFunctionDefs {n \\ n<-[0..size_function_conversions-1]} - # dcl_modules = {dcl_modules & [main_dcl_module_n].dcl_conversions=Yes conversion_table} - -> (function_conversions,dcl_modules) - -// add_function_conversion_table :: {#Int} Int *(a DclModule) -> *(a DclModule) | Array a DclModule -add_function_conversion_table dcl_to_icl_function_conversions main_dcl_module_n dcl_modules - # (dcl_mod,dcl_modules) = dcl_modules![main_dcl_module_n] - = case dcl_mod.dcl_conversions of - No - -> dcl_modules - (Yes conversion_table) - # conversion_table = {e \\ e <-:conversion_table} - # conversion_table = {conversion_table & [cFunctionDefs]=dcl_to_icl_function_conversions} - # dcl_modules = {dcl_modules & [main_dcl_module_n].dcl_conversions=Yes conversion_table} - -> dcl_modules - -check_module2 :: Ident {#Char} [.ImportedObject] .[Import ImportDeclaration] .ModuleKind !.IndexRange !.IndexRange !Int !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,[String]); -check_module2 mod_name mod_modification_time mod_imported_objects mod_imports mod_type icl_global_function_range icl_instance_range nr_of_cached_modules 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 + make_macro_def_array :: *{#*{#FunDef}} *[*{#FunDef}] -> *{#*{#FunDef}} + make_macro_def_array cached_dcl_macros macro_defs + #! size_cached_dcl_macros=size cached_dcl_macros + #! n_modules=length macro_defs+size_cached_dcl_macros + # a={{} \\ i<-[0..n_modules-1]} + # a=move_cached_macros_to_macro_def_array 0 size_cached_dcl_macros {} cached_dcl_macros a + = fill_macro_def_array size_cached_dcl_macros macro_defs a + where + move_cached_macros_to_macro_def_array :: Int Int !*{#FunDef} !*{#*{#FunDef}} !*{#*{#FunDef}} -> *{#*{#FunDef}} + move_cached_macros_to_macro_def_array i size_cached_dcl_macros empty_array cached_dcl_macros a + | i==size_cached_dcl_macros + = a + # (cached_macros,cached_dcl_macros) = replace cached_dcl_macros i empty_array + # (empty_array,a) = replace a i cached_macros + = move_cached_macros_to_macro_def_array (i+1) size_cached_dcl_macros empty_array cached_dcl_macros a + + fill_macro_def_array i [] a + = a + fill_macro_def_array i [dcl_macro_defs:macro_defs] a + = fill_macro_def_array (i+1) macro_defs {a & [i]=dcl_macro_defs} + +check_module2 :: Ident {#Char} [.ImportedObject] .[Import ImportDeclaration] .ModuleKind !.IndexRange !.IndexRange !Int !Int + (Optional (Module a)) [Declaration] *{#FunDef} *{#*{#FunDef}} *{#DclModule} (CollectedDefinitions ClassInstance IndexRange) + *{#.Int} *Heaps *CheckState + -> (!Bool,.IclModule,!.{#DclModule},.{!Group},!*{#*{#FunDef}},!Int,!.Heaps,!.{#PredefinedSymbol},!.Heap SymbolTableEntry,!.File,[String]); +check_module2 mod_name mod_modification_time mod_imported_objects mod_imports mod_type icl_global_function_range icl_instance_range nr_of_functions nr_of_cached_modules optional_pre_def_mod local_defs icl_functions macro_defs init_dcl_modules cdefs sizes heaps cs # (main_dcl_module_n,cs)=cs!cs_x.x_main_dcl_module_n - (icl_sizes_without_added_dcl_defs, sizes) = memcpy sizes - (copied_dcl_defs, dcl_modules, local_defs, cdefs, icl_sizes, cs) + + (copied_dcl_defs, dcl_conversions, dcl_modules, local_defs, cdefs, icl_sizes, cs) = combineDclAndIclModule mod_type init_dcl_modules local_defs cdefs sizes cs + | not cs.cs_error.ea_ok - = (False, abort "evaluated error 1 (check.icl)", {}, {}, No, {}, cs.cs_x.x_main_dcl_module_n,heaps, cs.cs_predef_symbols, cs.cs_symbol_table, cs.cs_error.ea_file, []) - # icl_common = createCommonDefinitions cdefs - (local_defs,dcl_modules,icl_common,cs) - = renumber_icl_definitions_as_dcl_definitions mod_type local_defs dcl_modules icl_common {icl_sizes.[i] \\ i<-[0..cMacroDefs-1]} cs + = (False, abort "evaluated error 1 (check.icl)", {}, {}, {}, cs.cs_x.x_main_dcl_module_n,heaps, cs.cs_predef_symbols, cs.cs_symbol_table, cs.cs_error.ea_file, []) - (dcl_modules, icl_functions, heaps, cs) - = check_predefined_module optional_pre_def_mod dcl_modules icl_functions heaps cs + # icl_common = createCommonDefinitions cdefs - (dcl_to_icl_function_conversions,dcl_modules) = remove_function_conversion_table main_dcl_module_n dcl_modules + (dcl_modules, icl_functions, macro_defs, heaps, cs) + = check_predefined_module optional_pre_def_mod dcl_modules icl_functions macro_defs heaps cs (nr_of_icl_component, expl_imp_indices, directly_imported_dcl_modules, - expl_imp_info, dcl_modules, icl_functions, heaps, cs) - = checkDclModules mod_imports dcl_modules icl_functions heaps cs + expl_imp_info, dcl_modules, icl_functions, macro_defs, heaps, cs) + = checkDclModules mod_imports dcl_modules icl_functions macro_defs heaps cs | not cs.cs_error.ea_ok - = (False, abort "evaluated error 2 (check.icl)", {}, {}, No, {}, cs.cs_x.x_main_dcl_module_n,heaps, cs.cs_predef_symbols, cs.cs_symbol_table, cs.cs_error.ea_file, []) - # (imported_module_numbers_of_main_dcl_mod, dcl_modules) - = dcl_modules![main_dcl_module_n].dcl_imported_module_numbers - (imported_module_numbers, dcl_modules) - = foldSt compute_used_module_nrs - expl_imp_indices - (addNr cPredefinedModuleIndex imported_module_numbers_of_main_dcl_mod, - dcl_modules) + = (False, abort "evaluated error 2 (check.icl)", {}, {}, {}, cs.cs_x.x_main_dcl_module_n,heaps, cs.cs_predef_symbols, cs.cs_symbol_table, cs.cs_error.ea_file, []) + + # def_macro_indices=cdefs.def_macro_indices + # (icl_global_functions_ranges,icl_instances_ranges,n_exported_global_functions,local_functions_index_offset,def_macro_indices,icl_functions,icl_common,local_defs,dcl_modules) + = renumber_icl_module mod_type icl_global_function_range icl_instance_range nr_of_functions main_dcl_module_n icl_sizes dcl_conversions def_macro_indices icl_functions icl_common local_defs dcl_modules - dcl_modules = add_function_conversion_table dcl_to_icl_function_conversions main_dcl_module_n dcl_modules + # (imported_module_numbers_of_main_dcl_mod, dcl_modules) = dcl_modules![main_dcl_module_n].dcl_imported_module_numbers + (imported_module_numbers, dcl_modules) + = foldSt compute_used_module_nrs expl_imp_indices (addNr cPredefinedModuleIndex imported_module_numbers_of_main_dcl_mod, dcl_modules) cs = { cs & cs_x.x_needed_modules = 0 } (nr_of_modules, dcl_modules) = usize dcl_modules - (dcl_macros, dcl_modules) - = dcl_modules![main_dcl_module_n].dcl_macros + (dcl_macros, dcl_modules) = dcl_modules![main_dcl_module_n].dcl_macros - expl_imp_indices_ikh - = ikhInsert` False nr_of_modules expl_imp_indices ikhEmpty + expl_imp_indices_ikh = ikhInsert` False nr_of_modules expl_imp_indices ikhEmpty - modules_in_component_set - = bitvectCreate nr_of_modules + modules_in_component_set = bitvectCreate nr_of_modules (imports, (dcl_modules, _, _, cs)) = solveExplicitImports expl_imp_indices_ikh modules_in_component_set nr_of_modules - (dcl_modules, bitvectCreate nr_of_modules, expl_imp_info.[nr_of_icl_component], cs) + (dcl_modules, bitvectCreate nr_of_modules, expl_imp_info.[nr_of_icl_component], cs) (dcl_modules, cs) = switch_port_to_new_syntax (writeExplImportsToFile "icl.txt" imports.si_explicit dcl_modules cs) (dcl_modules, cs) - imports_ikh - = ikhInsert` False nr_of_modules imports ikhEmpty + imports_ikh = ikhInsert` False nr_of_modules imports ikhEmpty // maps the module indices of all modules in the actual component to all explicit // imports of that module + (local_defs,dcl_modules,cs) = replace_icl_macros_by_dcl_macros mod_type def_macro_indices local_defs dcl_modules cs + cs = addGlobalDefinitionsToSymbolTable local_defs cs (dcls_import_list, dcl_modules, cs) - = addImportedSymbolsToSymbolTable nr_of_modules (Yes dcl_macros) modules_in_component_set - imports_ikh dcl_modules cs -// MV ... - (x_main_dcl_module,cs) - = cs!cs_x.x_main_dcl_module_n + = addImportedSymbolsToSymbolTable nr_of_modules (Yes dcl_macros) modules_in_component_set imports_ikh dcl_modules cs + + (x_main_dcl_module,cs) = cs!cs_x.x_main_dcl_module_n cs = cs -// <=< adjustPredefSymbol PD_ModuleType x_main_dcl_module STE_Type <=< adjustPredefSymbol PD_ModuleConsSymbol x_main_dcl_module STE_Constructor -// .. MV - (dcl_modules, icl_functions, hp_expression_heap, cs) - = checkExplicitImportCompleteness imports.si_explicit - dcl_modules icl_functions heaps.hp_expression_heap cs + (dcl_modules, icl_functions,macro_defs,hp_expression_heap, cs) + = checkExplicitImportCompleteness imports.si_explicit dcl_modules icl_functions macro_defs heaps.hp_expression_heap cs heaps = { heaps & hp_expression_heap=hp_expression_heap } - icl_imported - = { el \\ el<-dcls_import_list } - - (local_defs,dcl_modules,cs ) = replace_icl_macros_by_dcl_macros mod_type cdefs.def_macros local_defs dcl_modules cs - - (icl_common, dcl_modules, hp_type_heaps, hp_var_heap, cs) - = checkCommonDefinitions (Yes (copied_dcl_defs, nr_of_cached_modules)) main_dcl_module_n icl_common dcl_modules heaps.hp_type_heaps heaps.hp_var_heap cs -/* - (unexpanded_icl_type_defs, icl_common) - = copy_com_type_defs icl_common + icl_imported = { el \\ el<-dcls_import_list } - (com_type_defs, dcl_modules, hp_type_heaps, cs_error) - = expandSynonymTypes main_dcl_module_n icl_common.com_type_defs dcl_modules hp_type_heaps cs.cs_error - icl_common - = { icl_common & com_type_defs = com_type_defs } - cs - = { cs & cs_error = cs_error } -*/ + (_,icl_common, dcl_modules, hp_type_heaps, hp_var_heap, cs) + = checkCommonDefinitions (Yes (copied_dcl_defs, nr_of_cached_modules)) main_dcl_module_n icl_common dcl_modules heaps.hp_type_heaps heaps.hp_var_heap cs + (instance_types, icl_common, dcl_modules, hp_var_heap, hp_type_heaps, cs) = checkInstances main_dcl_module_n icl_common dcl_modules hp_var_heap hp_type_heaps cs heaps = { heaps & hp_type_heaps = hp_type_heaps, hp_var_heap = hp_var_heap } e_info = { ef_type_defs = icl_common.com_type_defs, ef_selector_defs = icl_common.com_selector_defs, ef_class_defs = icl_common.com_class_defs, - ef_cons_defs = icl_common.com_cons_defs, ef_member_defs = icl_common.com_member_defs, - ef_generic_defs = icl_common.com_generic_defs, //AA - ef_modules = dcl_modules, ef_is_macro_fun = False } + ef_cons_defs = icl_common.com_cons_defs, ef_member_defs = icl_common.com_member_defs, ef_generic_defs = icl_common.com_generic_defs, + ef_modules = dcl_modules, ef_macro_defs=macro_defs, ef_is_macro_fun = False } - (icl_functions, e_info, heaps, cs) = checkMacros main_dcl_module_n cdefs.def_macros icl_functions e_info heaps cs - (icl_functions, e_info, heaps, cs) = checkFunctions main_dcl_module_n cGlobalScope icl_global_function_range.ir_from icl_global_function_range.ir_to icl_functions e_info heaps cs + (icl_functions, e_info, heaps, cs) = checkAndPartitionateIclMacros main_dcl_module_n def_macro_indices local_functions_index_offset icl_functions e_info heaps cs + (icl_functions, e_info, heaps, cs) = checkGlobalFunctionsInRanges icl_global_functions_ranges main_dcl_module_n local_functions_index_offset icl_functions e_info heaps cs - cs = check_start_rule mod_type mod_name icl_global_function_range cs + cs = check_start_rule mod_type mod_name icl_global_functions_ranges cs cs = check_needed_modules_are_imported mod_name ".icl" cs (icl_functions, e_info, heaps, {cs_symbol_table, cs_predef_symbols, cs_error,cs_x }) - = checkInstanceBodies icl_instance_range icl_functions e_info heaps cs + = checkInstanceBodies icl_instances_ranges local_functions_index_offset icl_functions e_info heaps cs (icl_functions, hp_type_heaps, cs_error) - = foldSt checkSpecifiedInstanceType instance_types - (icl_functions, heaps.hp_type_heaps, cs_error) + = foldSt checkSpecifiedInstanceType instance_types (icl_functions, heaps.hp_type_heaps, cs_error) - heaps - = { heaps & hp_type_heaps = hp_type_heaps } + heaps = { heaps & hp_type_heaps = hp_type_heaps } cs_symbol_table = removeDeclarationsFromSymbolTable local_defs cGlobalScope cs_symbol_table @@ -1931,60 +2069,63 @@ check_module2 mod_name mod_modification_time mod_imported_objects mod_imports mo | cs_error.ea_ok # {hp_var_heap,hp_type_heaps=hp_type_heaps=:{th_vars},hp_expression_heap} = heaps - (spec_functions, dcl_modules, class_instances, icl_functions, new_nr_of_functions, dcl_icl_conversions, var_heap, th_vars, expr_heap) - = collect_specialized_functions_in_dcl_module dcl_modules icl_common.com_instance_defs icl_functions nr_of_functions main_dcl_module_n - hp_var_heap th_vars hp_expression_heap - icl_instances = icl_instance_range - icl_specials = {ir_from = nr_of_functions, ir_to = new_nr_of_functions} - icl_functions = copy_instance_types instance_types (array_plus_list icl_functions spec_functions) - (dcl_modules, class_instances, icl_functions, cs_predef_symbols) - = adjust_instance_types_of_array_functions_in_std_array_icl dcl_modules class_instances icl_functions main_dcl_module_n cs_predef_symbols + # class_instances = icl_common.com_instance_defs - (untransformed_fun_bodies, icl_functions) = copy_bodies icl_functions + (new_nr_of_functions, dcl_modules, icl_functions, var_heap, th_vars, expr_heap) + = collect_specialized_functions_in_dcl_module mod_type nr_of_functions main_dcl_module_n dcl_modules icl_functions hp_var_heap th_vars hp_expression_heap + + icl_specials = {ir_from = nr_of_functions,ir_to = new_nr_of_functions} + icl_functions = copy_instance_types instance_types icl_functions - (cached_functions_and_macros,icl_functions) = arrayCopyBegin icl_functions n_functions_and_macros_in_dcl_modules + (dcl_modules, class_instances, icl_functions, cs_predef_symbols) + = adjust_instance_types_of_array_functions_in_std_array_icl dcl_modules class_instances icl_functions main_dcl_module_n cs_predef_symbols - # (predef_symbols_for_transform, cs_predef_symbols) = get_predef_symbols_for_transform cs_predef_symbols - (groups, icl_functions, dcl_modules, var_heap, expr_heap, cs_symbol_table, cs_error) - = partitionateAndLiftFunctions [icl_global_function_range, icl_instances] main_dcl_module_n predef_symbols_for_transform icl_functions - dcl_modules var_heap expr_heap cs_symbol_table cs_error icl_common = { icl_common & com_type_defs = e_info.ef_type_defs, com_selector_defs = e_info.ef_selector_defs, com_class_defs = e_info.ef_class_defs, - com_cons_defs = e_info.ef_cons_defs, com_member_defs = e_info.ef_member_defs, - com_generic_defs = e_info.ef_generic_defs, // AA - com_instance_defs = class_instances } - icl_mod = { icl_name = mod_name, icl_functions = icl_functions, icl_common = icl_common, icl_instances = icl_instances, icl_specials = icl_specials, + com_cons_defs = e_info.ef_cons_defs, com_member_defs = e_info.ef_member_defs, + com_generic_defs = e_info.ef_generic_defs, com_instance_defs = class_instances } + icl_mod = { icl_name = mod_name, icl_functions = icl_functions, icl_common = icl_common, + icl_global_functions = icl_global_functions_ranges, icl_instances = icl_instances_ranges, icl_specials = icl_specials, icl_imported_objects = mod_imported_objects, icl_used_module_numbers = imported_module_numbers, icl_copied_from_dcl = copied_dcl_defs, icl_import = icl_imported, icl_modification_time = mod_modification_time} heaps = { heaps & hp_var_heap = var_heap, hp_expression_heap = expr_heap, hp_type_heaps = {hp_type_heaps & th_vars = th_vars}} + (main_dcl_module, dcl_modules) = dcl_modules![main_dcl_module_n] - (main_dcl_module, dcl_modules) - = dcl_modules![main_dcl_module_n] + (icl_mod, macro_defs, heaps, cs_error) + = compareDefImp main_dcl_module_n main_dcl_module n_exported_global_functions icl_mod e_info.ef_macro_defs heaps cs_error + + # (predef_symbols_for_transform, cs_predef_symbols) = get_predef_symbols_for_transform cs_predef_symbols + (groups, icl_functions, macro_defs, dcl_modules, var_heap, expr_heap, cs_symbol_table, cs_error) + = partitionateAndLiftFunctions (icl_global_functions_ranges++icl_instances_ranges) main_dcl_module_n predef_symbols_for_transform icl_mod.icl_functions macro_defs + dcl_modules heaps.hp_var_heap heaps.hp_expression_heap cs_symbol_table cs_error - (icl_mod, heaps, cs_error) - = compareDefImp icl_sizes_without_added_dcl_defs untransformed_fun_bodies main_dcl_module_n - /* unexpanded_icl_type_defs */ main_dcl_module icl_mod heaps cs_error + # heaps = {heaps & hp_var_heap=var_heap,hp_expression_heap=expr_heap} + # icl_mod = {icl_mod & icl_functions=icl_functions} - = (cs_error.ea_ok, icl_mod, dcl_modules, groups, dcl_icl_conversions, cached_functions_and_macros, cs_x.x_main_dcl_module_n, heaps, cs_predef_symbols, cs_symbol_table, cs_error.ea_file, directly_imported_dcl_modules) + = (cs_error.ea_ok, icl_mod, dcl_modules, groups, macro_defs, cs_x.x_main_dcl_module_n, heaps, cs_predef_symbols, cs_symbol_table, cs_error.ea_file, directly_imported_dcl_modules) # icl_common = { icl_common & com_type_defs = e_info.ef_type_defs, com_selector_defs = e_info.ef_selector_defs, com_class_defs = e_info.ef_class_defs, - com_cons_defs = e_info.ef_cons_defs, com_member_defs = e_info.ef_member_defs, - com_generic_defs = e_info.ef_generic_defs/*AA*/ } + com_cons_defs = e_info.ef_cons_defs, com_member_defs = e_info.ef_member_defs, com_generic_defs = e_info.ef_generic_defs } icl_mod = { icl_name = mod_name, icl_functions = icl_functions, icl_common = icl_common, - icl_instances = icl_instance_range, + icl_global_functions = icl_global_functions_ranges, icl_instances = icl_instances_ranges, icl_specials = {ir_from = nr_of_functions, ir_to = nr_of_functions}, icl_imported_objects = mod_imported_objects, icl_used_module_numbers = imported_module_numbers, icl_copied_from_dcl = copied_dcl_defs, - icl_import = icl_imported, icl_modification_time = mod_modification_time} - = (False, icl_mod, dcl_modules, {}, No, {}, cs_x.x_main_dcl_module_n,heaps, cs_predef_symbols, cs_symbol_table, cs_error.ea_file, directly_imported_dcl_modules) + icl_import = icl_imported ,icl_modification_time = mod_modification_time} + = (False, icl_mod, dcl_modules, {}, {}, cs_x.x_main_dcl_module_n,heaps, cs_predef_symbols, cs_symbol_table, cs_error.ea_file, directly_imported_dcl_modules) where - check_start_rule mod_kind mod_name {ir_from, ir_to} cs=:{cs_predef_symbols,cs_symbol_table,cs_x} + check_start_rule mod_kind mod_name icl_global_functions_ranges cs=:{cs_predef_symbols,cs_symbol_table,cs_x} # (pre_symb, cs_predef_symbols) = cs_predef_symbols![PD_Start] ({ste_kind, ste_index}, cs_symbol_table) = readPtr pre_symb.pds_ident.id_info cs_symbol_table cs = { cs & cs_predef_symbols = cs_predef_symbols, cs_symbol_table = cs_symbol_table } = case ste_kind of STE_FunctionOrMacro _ - | ir_from <= ste_index && ste_index < ir_to + | index_in_ranges ste_index icl_global_functions_ranges -> { cs & cs_predef_symbols = { cs.cs_predef_symbols & [PD_Start] = { pre_symb & pds_def = ste_index, pds_module = cs_x.x_main_dcl_module_n }}} + where + index_in_ranges index [{ir_from, ir_to}:ranges] + = (index>=ir_from && index < ir_to) || index_in_ranges index ranges; + index_in_ranges index [] + = False STE_Imported STE_DclFunction mod_index -> { cs & cs_predef_symbols = { cs.cs_predef_symbols & [PD_Start] = { pre_symb & pds_def = ste_index, pds_module = mod_index }}} _ @@ -1995,76 +2136,46 @@ check_module2 mod_name mod_modification_time mod_imported_objects mod_imports mo _ -> cs - check_predefined_module (Yes {mod_name={id_info}}) modules macro_and_fun_defs heaps cs=:{cs_symbol_table} + check_predefined_module (Yes {mod_name={id_info}}) modules macro_and_fun_defs macro_defs heaps cs=:{cs_symbol_table} # (entry, cs_symbol_table) = readPtr id_info cs_symbol_table # cs = { cs & cs_symbol_table = cs_symbol_table <:= (id_info, { entry & ste_kind = STE_ClosedModule })} {ste_kind = STE_Module mod, ste_index} = entry - solved_imports - = { si_explicit = [], si_implicit = [] } - (deferred_stuff, (_, modules, macro_and_fun_defs, heaps, cs)) - = checkDclModule EndNumbers [] (ikhInsert` False cPredefinedModuleIndex solved_imports ikhEmpty) cUndef False cDummyArray mod ste_index cDummyArray modules macro_and_fun_defs heaps cs + solved_imports = { si_explicit = [], si_implicit = [] } + imports_ikh = ikhInsert` False cPredefinedModuleIndex solved_imports ikhEmpty + (deferred_stuff, (_, modules, macro_and_fun_defs, macro_defs, heaps, cs)) + = checkDclModule EndNumbers [] imports_ikh cUndef False cDummyArray mod ste_index cDummyArray modules macro_and_fun_defs macro_defs heaps cs (modules, heaps, cs) - = doSomeThingsThatHaveToBeDoneAfterTheWholeComponentHasBeenChecked cPredefinedModuleIndex - deferred_stuff (modules, heaps, cs) + = checkInstancesOfDclModule cPredefinedModuleIndex deferred_stuff (modules, heaps, cs) ({dcl_declared={dcls_import,dcls_local,dcls_local_for_import}}, modules) = modules![ste_index] - = (modules, macro_and_fun_defs, heaps, + = (modules, macro_and_fun_defs, macro_defs, heaps, addDeclarationsOfDclModToSymbolTable ste_index dcls_local_for_import dcls_import cs) - check_predefined_module No modules macro_and_fun_defs heaps cs - = (modules, macro_and_fun_defs, heaps, cs) - - collect_specialized_functions_in_dcl_module :: !w:{# DclModule} !v:{# ClassInstance} !u:{# FunDef} !Index !Int !*VarHeap !*TypeVarHeap !*ExpressionHeap - -> (![FunDef], !w:{# DclModule}, !v:{# ClassInstance}, !u:{# FunDef}, !Index, !(Optional {# Index}), !*VarHeap, !*TypeVarHeap, !*ExpressionHeap) - collect_specialized_functions_in_dcl_module modules icl_instances icl_functions first_free_index main_dcl_module_n var_heap type_var_heap expr_heap + check_predefined_module No modules macro_and_fun_defs macro_defs heaps cs + = (modules, macro_and_fun_defs, macro_defs, heaps, cs) + + collect_specialized_functions_in_dcl_module :: ModuleKind !Index !Int !*{# DclModule} !*{# FunDef} !*VarHeap !*TypeVarHeap !*ExpressionHeap + -> (!Index, !*{# DclModule},!*{# FunDef},!*VarHeap,!*TypeVarHeap,!*ExpressionHeap) + collect_specialized_functions_in_dcl_module MK_Main first_free_index main_dcl_module_n modules icl_functions var_heap type_var_heap expr_heap + = (first_free_index, modules, icl_functions, var_heap, type_var_heap, expr_heap) + collect_specialized_functions_in_dcl_module _ first_free_index main_dcl_module_n modules icl_functions var_heap type_var_heap expr_heap # (dcl_mod, modules) = modules![main_dcl_module_n] # {dcl_specials,dcl_functions,dcl_common,dcl_conversions} = dcl_mod - = case dcl_conversions of - Yes conversion_table - # (new_conversion_table, icl_instances) - = build_conversion_table_for_instances_of_dcl_mod dcl_specials first_free_index - dcl_functions dcl_common.com_instance_defs conversion_table icl_instances - (spec_fun_defs, (icl_functions, last_index, (var_heap, type_var_heap, expr_heap))) - = collect_specialized_functions dcl_specials.ir_from dcl_specials.ir_to dcl_functions new_conversion_table - (icl_functions, first_free_index, (var_heap, type_var_heap, expr_heap)) - -> (spec_fun_defs, modules, icl_instances, icl_functions, last_index, Yes new_conversion_table, var_heap, type_var_heap, expr_heap) - No - -> ([], modules, icl_instances, icl_functions, first_free_index, No, var_heap, type_var_heap, expr_heap) + # (icl_functions, last_index, (var_heap, type_var_heap, expr_heap)) + = collect_specialized_functions dcl_specials.ir_from dcl_specials.ir_to dcl_functions + (icl_functions, first_free_index, (var_heap, type_var_heap, expr_heap)) + = (last_index, modules, icl_functions, var_heap, type_var_heap, expr_heap) where - build_conversion_table_for_instances_of_dcl_mod {ir_from,ir_to} first_free_index dcl_functions dcl_instances conversion_table icl_instances - #! nr_of_dcl_functions = size dcl_functions - # dcl_instances_table = conversion_table.[cInstanceDefs] - dcl_function_table = conversion_table.[cFunctionDefs] - new_table = { createArray nr_of_dcl_functions NoIndex & [i] = icl_index \\ icl_index <-: dcl_function_table & i <- [0..] } - index_diff = first_free_index - ir_from - new_table = { new_table & [i] = i + index_diff \\ i <- [ir_from .. ir_to - 1] } - = build_conversion_table_for_instances 0 dcl_instances dcl_instances_table icl_instances new_table - - build_conversion_table_for_instances dcl_class_inst_index dcl_instances class_instances_table icl_instances new_table - | dcl_class_inst_index < size class_instances_table - # icl_index = class_instances_table.[dcl_class_inst_index] - # (icl_instance, icl_instances) = icl_instances![icl_index] - dcl_instance = dcl_instances.[dcl_class_inst_index] - # new_table = build_conversion_table_for_instances_of_members 0 dcl_instance.ins_members icl_instance.ins_members new_table - = build_conversion_table_for_instances (inc dcl_class_inst_index) dcl_instances class_instances_table icl_instances new_table - = (new_table, icl_instances) - - build_conversion_table_for_instances_of_members mem_index dcl_members icl_members new_table - | mem_index < size dcl_members - # dcl_member = dcl_members.[mem_index] - icl_member = icl_members.[mem_index] - = build_conversion_table_for_instances_of_members (inc mem_index) dcl_members icl_members - { new_table & [dcl_member.ds_index] = icl_member.ds_index } - = new_table - - collect_specialized_functions spec_index last_index dcl_fun_types conversion_table (icl_functions, next_fun_index, heaps) + collect_specialized_functions spec_index last_index dcl_fun_types (icl_functions, next_fun_index, heaps) | spec_index < last_index # {ft_type,ft_specials = SP_FunIndex decl_index} = dcl_fun_types.[spec_index] - icl_index = conversion_table.[decl_index] + // icl_index = conversion_table.[decl_index] + icl_index = decl_index (icl_fun, icl_functions) = icl_functions![icl_index] (new_fun_def, heaps) = build_function next_fun_index icl_fun icl_index ft_type heaps - (new_fun_defs, funs_index_heaps) - = collect_specialized_functions (inc spec_index) last_index dcl_fun_types conversion_table (icl_functions, inc next_fun_index, heaps) - = ([new_fun_def : new_fun_defs], funs_index_heaps) - = ([], (icl_functions, next_fun_index, heaps)) + (icl_functions, next_fun_index, heaps) + = collect_specialized_functions (inc spec_index) last_index dcl_fun_types /*conversion_table*/ (icl_functions, inc next_fun_index, heaps) + # icl_functions = {icl_functions & [spec_index]=new_fun_def} + = (icl_functions, next_fun_index, heaps) + = (icl_functions, next_fun_index, heaps) build_function new_fun_index fun_def=:{fun_symb, fun_arity, fun_body = CheckedBody {cb_args}, fun_info} fun_index fun_type (var_heap, type_var_heap, expr_heap) @@ -2076,22 +2187,23 @@ check_module2 mod_name mod_modification_time mod_imported_objects mod_imports mo app_args = app_args, app_info_ptr = app_info_ptr } = ({ fun_def & fun_body = TransformedBody {tb_args = tb_args, tb_rhs = tb_rhs}, fun_type = Yes fun_type, - fun_info = { EmptyFunInfo & fi_calls = [ { fc_index = fun_index, fc_level = cGlobalScope }] }}, + fun_info = { EmptyFunInfo & fi_calls = [FunCall fun_index cGlobalScope] }}, (var_heap, type_var_heap, expr_heap)) - new_bound_var :: !FreeVar !*ExpressionHeap -> (!Expression, !*ExpressionHeap) - new_bound_var {fv_name,fv_info_ptr} expr_heap - # (var_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap - = (Var { var_name = fv_name, var_info_ptr = fv_info_ptr, var_expr_ptr = var_expr_ptr }, expr_heap) - - new_free_var :: !FreeVar *VarHeap -> (!FreeVar, !*VarHeap) - new_free_var fv var_heap - # (fv_info_ptr, var_heap) = newPtr VI_Empty var_heap - = ({ fv & fv_info_ptr = fv_info_ptr, fv_def_level = NotALevel, fv_count = 0}, var_heap) + new_bound_var :: !FreeVar !*ExpressionHeap -> (!Expression, !*ExpressionHeap) + new_bound_var {fv_name,fv_info_ptr} expr_heap + # (var_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap + = (Var { var_name = fv_name, var_info_ptr = fv_info_ptr, var_expr_ptr = var_expr_ptr }, expr_heap) + + new_free_var :: !FreeVar *VarHeap -> (!FreeVar, !*VarHeap) + new_free_var fv var_heap + # (fv_info_ptr, var_heap) = newPtr VI_Empty var_heap + = ({ fv & fv_info_ptr = fv_info_ptr, fv_def_level = NotALevel, fv_count = 0}, var_heap) copy_instance_types :: [(Index,SymbolType)] !*{# FunDef} -> !*{# FunDef} copy_instance_types types fun_defs = foldl copy_instance_type fun_defs types + copy_instance_type fun_defs (index, symbol_type) # (inst_def, fun_defs) = fun_defs![index] = { fun_defs & [index] = { inst_def & fun_type = Yes symbol_type }} @@ -2100,12 +2212,11 @@ check_module2 mod_name mod_modification_time mod_imported_objects mod_imports mo # ({pds_def}, predef_symbols) = predef_symbols![PD_StdArray] | pds_def == main_dcl_module_n #! nr_of_instances = size class_instances - # ({dcl_common, dcl_conversions = Yes conversion_table}, dcl_modules) = dcl_modules![main_dcl_module_n] + # ({dcl_common}, dcl_modules) = dcl_modules![main_dcl_module_n] ({pds_def}, predef_symbols) = predef_symbols![PD_ArrayClass] (offset_table, _, predef_symbols) = arrayFunOffsetToPD_IndexTable dcl_common.com_member_defs predef_symbols - array_class_index = conversion_table.[cClassDefs].[pds_def] (class_instances, fun_defs, predef_symbols) - = iFoldSt (adjust_instance_types_of_array_functions array_class_index offset_table) 0 nr_of_instances + = iFoldSt (adjust_instance_types_of_array_functions pds_def offset_table) 0 nr_of_instances (class_instances, fun_defs, predef_symbols) = (dcl_modules, class_instances, fun_defs, predef_symbols) = (dcl_modules, class_instances, fun_defs, predef_symbols) @@ -2126,57 +2237,36 @@ check_module2 mod_name mod_modification_time mod_imported_objects mod_imports mo (Yes symbol_type) = inst_def.fun_type = { instance_defs & [ds_index] = { inst_def & fun_type = Yes (makeElemTypeOfArrayFunctionStrict symbol_type ins_offset offset_table) } } - copy_bodies :: !*{# FunDef} -> (!.{!FunctionBody}, !*{# FunDef}) - copy_bodies fun_defs - #! size = size fun_defs - # new = createArray size NoBody - = iFoldSt (\i (dst, src=:{[i]=src_i})->({ dst & [i] = src_i.fun_body }, src)) 0 size (new, fun_defs) - - copy_com_type_defs icl_common=:{com_type_defs} - # (com_type_defs`, com_type_defs) - = memcpy com_type_defs - = (com_type_defs`, { icl_common & com_type_defs = com_type_defs }) - - checkSpecifiedInstanceType (index_of_member_fun, derived_symbol_type) - (icl_functions, type_heaps, cs_error) - # ({fun_type, fun_pos, fun_symb}, icl_functions) - = icl_functions![index_of_member_fun] - (cs_error, type_heaps) - = case fun_type of - No - -> (cs_error, type_heaps) - Yes specified_symbol_type - # (err_code, type_heaps) - = symbolTypesCorrespond specified_symbol_type derived_symbol_type - type_heaps - | err_code==CEC_Ok - -> (cs_error, type_heaps) - # cs_error - = pushErrorAdmin (newPosition fun_symb fun_pos) - cs_error - luxurious_explanation - = case err_code of - CEC_ResultNotOK -> "result type" - CEC_ArgNrNotOk -> "nr or arguments" - CEC_ContextNotOK -> "context" - CEC_AttrEnvNotOK -> "attribute environment" - 1 -> "first argument" - 2 -> "second argument" - 3 -> "third argument" - _ -> toString err_code+++"th argument" - cs_error - = checkError "the specified member type is incorrect (" - (luxurious_explanation+++" not ok)") cs_error - -> ( popErrorAdmin cs_error, type_heaps) + checkSpecifiedInstanceType (index_of_member_fun, derived_symbol_type) (icl_functions, type_heaps, cs_error) + # ({fun_type, fun_pos, fun_symb}, icl_functions) = icl_functions![index_of_member_fun] + # (cs_error, type_heaps) + = case fun_type of + No + -> (cs_error, type_heaps) + Yes specified_symbol_type + # (err_code, type_heaps) + = symbolTypesCorrespond specified_symbol_type derived_symbol_type type_heaps + | err_code==CEC_Ok + -> (cs_error, type_heaps) + # cs_error = pushErrorAdmin (newPosition fun_symb fun_pos) cs_error + luxurious_explanation + = case err_code of + CEC_ResultNotOK -> "result type" + CEC_ArgNrNotOk -> "nr or arguments" + CEC_ContextNotOK -> "context" + CEC_AttrEnvNotOK -> "attribute environment" + 1 -> "first argument" + 2 -> "second argument" + 3 -> "third argument" + _ -> toString err_code+++"th argument" + cs_error = checkError "the specified member type is incorrect ("(luxurious_explanation+++" not ok)") cs_error + -> ( popErrorAdmin cs_error, type_heaps) = (icl_functions, type_heaps, cs_error) - check_needed_modules_are_imported mod_name extension cs=:{cs_x={x_needed_modules}} -//AA.. # cs = case x_needed_modules bitand cNeedStdGeneric of 0 -> cs _ -> check_it PD_StdGeneric mod_name "" extension cs -//..AA # cs = case x_needed_modules bitand cNeedStdDynamic of 0 -> cs _ -> switch_dynamics (check_it PD_StdDynamic mod_name "" extension cs) (switched_off_Clean_feature PD_StdDynamic mod_name " (dynamics are disabled)" extension cs) @@ -2249,30 +2339,25 @@ makeElemTypeOfArrayFunctionStrict st=:{st_args,st_result} me_offset offset_table st_result = { st_result & at_type = TA tuple [{ elem & at_annotation = AN_Strict } : res_array]}} = st -initialDclModule ({mod_name, mod_modification_time, mod_defs=mod_defs=:{def_funtypes,def_macros}, mod_type}, sizes, all_defs) module_n +initialDclModule ({mod_name, mod_modification_time, mod_defs=mod_defs=:{def_funtypes,def_macro_indices}, mod_type}, sizes, all_defs) module_n # dcl_common= createCommonDefinitions mod_defs = { dcl_name = mod_name , dcl_functions = { function \\ function <- mod_defs.def_funtypes } - , dcl_macros = def_macros - , dcl_instances = { ir_from = 0, ir_to = 0 } + , dcl_macros = def_macro_indices + , dcl_instances = { ir_from = 0, ir_to = 0} , dcl_specials = { ir_from = 0, ir_to = 0 } , dcl_common = dcl_common , dcl_sizes = sizes + , dcl_dictionary_info = { n_dictionary_types=0,n_dictionary_constructors=0,n_dictionary_selectors=0 } , dcl_declared = { dcls_import = {} , dcls_local = all_defs , dcls_local_for_import = {local_declaration_for_import decl module_n \\ decl<-all_defs} } - , dcl_conversions = No -/* RWS ... - , dcl_is_system = case mod_type of - MK_System -> True - _ -> False -*/ + , dcl_macro_conversions = No , dcl_module_kind = mod_type , dcl_modification_time = mod_modification_time -// ... RWS , dcl_imported_module_numbers = EndNumbers } @@ -2522,45 +2607,19 @@ updateExplImpForMarkedLocalSymbol mod_index decl {ste_kind=STE_ExplImpComponentN updateExplImpForMarkedLocalSymbol _ _ entry dcl_modules expl_imp_infos cs_symbol_table = (dcl_modules, expl_imp_infos, cs_symbol_table) -//1.3 -memcpy :: u:(a b) -> (!.(c b),!v:(a b)) | Array a & createArray_u , createArrayc_u , size_u , update_u , uselect_u b & Array c, [u <= v]; -//3.1 -/*2.0 -memcpy :: u:(a b) -> (!.(c b),!u:(a b)) | Array c b & Array a b -0.2*/ -memcpy src - #! size - = size src - | size==0 - = ({}, src) - # (el0, src) - = src![0] - new - = createArray size el0 - = iFoldSt (\i (dst, src=:{[i]=src_i})->({ dst & [i] = src_i }, src)) 0 size (new, src) - -doSomeThingsThatHaveToBeDoneAfterTheWholeComponentHasBeenChecked - :: !.Int !(!.Int,.Int,.[FunType]) - !(!*{#.DclModule},!*Heaps,!*CheckState) - -> (!.{#DclModule},!.Heaps,!.CheckState); -doSomeThingsThatHaveToBeDoneAfterTheWholeComponentHasBeenChecked mod_index - (nr_of_dcl_functions_and_instances, nr_of_dcl_funs_insts_and_specs, rev_special_defs) - (dcl_modules, heaps=:{hp_type_heaps, hp_var_heap}, cs=:{cs_error}) - #! main_dcl_module_n - = cs.cs_x.x_main_dcl_module_n -/* # (dcl_modules, hp_type_heaps, cs_error) - = expand_syn_types_of_dcl_mod mod_index (dcl_modules, hp_type_heaps, cs_error) -*/ # (dcl_mod=:{dcl_functions, dcl_common}, dcl_modules) - = dcl_modules![mod_index] - nr_of_dcl_functions - = size dcl_functions +checkInstancesOfDclModule :: !.Int !(!.Int,.Int,.[FunType]) !(!*{#DclModule},!*Heaps,!*CheckState) + -> (!.{#DclModule},!.Heaps,!.CheckState); +checkInstancesOfDclModule mod_index (nr_of_dcl_functions_and_instances, nr_of_dcl_funs_insts_and_specs, rev_special_defs) (dcl_modules, heaps=:{hp_type_heaps, hp_var_heap}, cs=:{cs_error}) + #! main_dcl_module_n = cs.cs_x.x_main_dcl_module_n + # (dcl_mod=:{dcl_functions, dcl_common}, dcl_modules) = dcl_modules![mod_index] + nr_of_dcl_functions = size dcl_functions (memb_inst_defs, nr_of_dcl_functions_and_instances2, rev_spec_class_inst, com_instance_defs, com_class_defs, com_member_defs, com_generic_defs, dcl_modules, hp_type_heaps, hp_var_heap, cs) = determineTypesOfInstances nr_of_dcl_functions mod_index - (fst (memcpy dcl_common.com_instance_defs)) - (fst (memcpy dcl_common.com_class_defs)) - (fst (memcpy dcl_common.com_member_defs)) - (fst (memcpy dcl_common.com_generic_defs)) + {d \\ d<-:dcl_common.com_instance_defs} + {d \\ d<-:dcl_common.com_class_defs} + {d \\ d<-:dcl_common.com_member_defs} + {d \\ d<-:dcl_common.com_generic_defs} dcl_modules hp_type_heaps hp_var_heap { cs & cs_error = cs_error } heaps = { heaps & hp_type_heaps = hp_type_heaps, hp_var_heap = hp_var_heap } @@ -2583,33 +2642,16 @@ doSomeThingsThatHaveToBeDoneAfterTheWholeComponentHasBeenChecked mod_index True -> adjust_instance_types_of_array_functions_in_std_array_dcl mod_index com_member_defs com_instance_defs dcl_functions cs - dcl_mod - = { dcl_mod & - dcl_functions = dcl_functions, - dcl_specials = { ir_from = nr_of_dcl_functions_and_instances, - ir_to = nr_of_dcl_funs_insts_and_specs }, - dcl_common = - { dcl_common & com_instance_defs = com_instance_defs, - com_class_defs = com_class_defs, com_member_defs = com_member_defs, - com_generic_defs = com_generic_defs }} - dcl_modules - = { dcl_modules & [mod_index] = dcl_mod } + dcl_mod = { dcl_mod & dcl_functions = dcl_functions, + dcl_specials = { ir_from = nr_of_dcl_functions_and_instances, + ir_to = nr_of_dcl_funs_insts_and_specs }, + dcl_common = + { dcl_common & com_instance_defs = com_instance_defs, + com_class_defs = com_class_defs, com_member_defs = com_member_defs, + com_generic_defs = com_generic_defs }} + dcl_modules = { dcl_modules & [mod_index] = dcl_mod } = (dcl_modules, heaps, cs) where -/* - expand_syn_types_of_dcl_mod mod_index (dcl_modules, hp_type_heaps, cs_error) - # (type_defs, dcl_modules) - = dcl_modules![mod_index].dcl_common.com_type_defs - dcl_modules - = { dcl_modules & [mod_index].dcl_common.com_unexpanded_type_defs = type_defs } - unique_type_defs - = { el \\ el <-:type_defs } - (expanded_type_defs, dcl_modules, hp_type_heaps, cs_error) - = expandSynonymTypes mod_index unique_type_defs dcl_modules hp_type_heaps cs_error - dcl_modules - = { dcl_modules & [mod_index].dcl_common.com_type_defs = expanded_type_defs } - = (dcl_modules, hp_type_heaps, cs_error) -*/ adjust_instance_types_of_array_functions_in_std_array_dcl array_mod_index class_members class_instances fun_types cs=:{cs_predef_symbols} #! nr_of_instances = size class_instances # ({pds_def}, cs_predef_symbols) = cs_predef_symbols![PD_ArrayClass] @@ -2637,38 +2679,33 @@ doSomeThingsThatHaveToBeDoneAfterTheWholeComponentHasBeenChecked mod_index checkDclModule :: !NumberSet ![Int] !(IntKeyHashtable SolvedImports) !Int !Bool !LargeBitvect - !(Module (CollectedDefinitions ClassInstance IndexRange)) !Index - !*ExplImpInfos !*{#DclModule} !*{#FunDef} !*Heaps !*CheckState - -> (!(!Int,!Index,![FunType]), !(!*ExplImpInfos, !*{#DclModule}, !*{#FunDef}, !*Heaps, !*CheckState)) + !(Module (CollectedDefinitions ClassInstance IndexRange)) !Index !*ExplImpInfos !*{#DclModule} !*{#FunDef} !*{#*{#FunDef}} !*Heaps !*CheckState + -> (!(!Int,!Index,![FunType]), !(!*ExplImpInfos, !*{#DclModule}, !*{#FunDef},!*{#*{#FunDef}},!*Heaps, !*CheckState)) checkDclModule dcl_imported_module_numbers super_components imports_ikh component_nr is_on_cycle modules_in_component_set - {mod_name,mod_imports,mod_defs} mod_index - expl_imp_info modules icl_functions heaps=:{hp_var_heap, hp_type_heaps,hp_expression_heap} cs + {mod_name,mod_imports,mod_defs} mod_index expl_imp_info modules icl_functions macro_defs heaps=:{hp_var_heap, hp_type_heaps,hp_expression_heap} cs // | False--->("checkDclModule", mod_name, mod_index) //, modules.[mod_index].dcl_declared.dcls_local) // = undef # (dcl_mod, modules) = modules![mod_index] dcl_defined = dcl_mod.dcl_declared.dcls_local dcl_common = createCommonDefinitions mod_defs - dcl_macros = mod_defs.def_macros + dcl_macros = mod_defs.def_macro_indices cs = addGlobalDefinitionsToSymbolTable dcl_defined cs (dcls_import_list, modules, cs) = addImportedSymbolsToSymbolTable mod_index No modules_in_component_set imports_ikh modules cs - dcls_import - = { el \\ el<-dcls_import_list } + dcls_import = { el \\ el<-dcls_import_list } cs = { cs & cs_x.x_needed_modules = 0 } nr_of_dcl_functions = size dcl_mod.dcl_functions - #! main_dcl_module_n = cs.cs_x.x_main_dcl_module_n - - # (dcl_common, modules, hp_type_heaps, hp_var_heap, cs) + # (dictionary_info,dcl_common, modules, hp_type_heaps, hp_var_heap, cs) = checkCommonDefinitions No mod_index dcl_common modules hp_type_heaps hp_var_heap cs - heaps - = { heaps & hp_type_heaps = hp_type_heaps, hp_var_heap = hp_var_heap, hp_expression_heap=hp_expression_heap} + # dcl_mod = {dcl_mod & dcl_dictionary_info=dictionary_info} + heaps = { heaps & hp_type_heaps = hp_type_heaps, hp_var_heap = hp_var_heap, hp_expression_heap=hp_expression_heap} | not cs.cs_error.ea_ok - = ((0, 0, []), (expl_imp_info, modules, icl_functions, heaps, cs)) - #!nr_of_members - = count_members mod_index dcl_common.com_instance_defs dcl_common.com_class_defs modules - # nr_of_dcl_functions_and_instances - = nr_of_dcl_functions+nr_of_members + = ((0, 0, []), (expl_imp_info, modules, icl_functions, macro_defs, heaps, cs)) + + #!nr_of_members = count_members mod_index dcl_common.com_instance_defs dcl_common.com_class_defs modules + # nr_of_dcl_functions_and_instances = nr_of_dcl_functions+nr_of_members + (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 cs @@ -2677,12 +2714,11 @@ checkDclModule dcl_imported_module_numbers super_components imports_ikh componen com_member_defs = dcl_common.com_member_defs e_info = { ef_type_defs = com_type_defs, ef_selector_defs = dcl_common.com_selector_defs, ef_class_defs = com_class_defs, - ef_cons_defs = dcl_common.com_cons_defs, ef_member_defs = com_member_defs, - ef_generic_defs = dcl_common.com_generic_defs, // AA - ef_modules = modules, ef_is_macro_fun = False } + ef_cons_defs = dcl_common.com_cons_defs, ef_member_defs = com_member_defs, ef_generic_defs = dcl_common.com_generic_defs, + ef_modules = modules, ef_macro_defs=macro_defs, ef_is_macro_fun = False } - (icl_functions, e_info=:{ef_modules=modules}, heaps=:{hp_expression_heap}, cs) - = checkMacros mod_index dcl_macros icl_functions e_info heaps cs + (icl_functions, e_info=:{ef_modules=modules,ef_macro_defs=macro_defs}, heaps=:{hp_expression_heap}, cs) + = checkAndPartitionateDclMacros mod_index dcl_macros icl_functions e_info heaps cs cs = check_needed_modules_are_imported mod_name ".dcl" cs @@ -2691,33 +2727,32 @@ checkDclModule dcl_imported_module_numbers super_components imports_ikh componen (ef_member_defs, com_instance_defs, dcl_functions, cs) = adjust_predefined_symbols mod_index e_info.ef_member_defs com_instance_defs dcl_functions cs - (modules, icl_functions, hp_expression_heap, cs) + (modules, icl_functions, macro_defs, hp_expression_heap, cs) = case is_on_cycle of - False -> checkExplicitImportCompleteness (ikhSearch` mod_index imports_ikh).si_explicit - modules icl_functions hp_expression_heap cs - True -> (modules, icl_functions, hp_expression_heap, cs) + False + # decls_explicit = (ikhSearch` mod_index imports_ikh).si_explicit + -> checkExplicitImportCompleteness decls_explicit modules icl_functions macro_defs hp_expression_heap cs + True + -> (modules, icl_functions, macro_defs, hp_expression_heap, cs) heaps = { heaps & hp_expression_heap = hp_expression_heap } dcl_common = { dcl_common & com_type_defs = e_info.ef_type_defs, com_selector_defs = e_info.ef_selector_defs, com_class_defs = e_info.ef_class_defs, com_instance_defs = com_instance_defs, com_cons_defs = e_info.ef_cons_defs, com_member_defs = e_info.ef_member_defs, - com_generic_defs = e_info.ef_generic_defs //AA + com_generic_defs = e_info.ef_generic_defs } (modules, expl_imp_info, cs_symbol_table) - = updateExplImpInfo super_components mod_index dcls_import dcl_mod.dcl_declared.dcls_local_for_import - modules expl_imp_info cs.cs_symbol_table + = updateExplImpInfo super_components mod_index dcls_import dcl_mod.dcl_declared.dcls_local_for_import modules expl_imp_info cs.cs_symbol_table - cs_symbol_table - = removeDeclarationsFromSymbolTable dcl_defined cModuleScope cs_symbol_table + cs_symbol_table = removeDeclarationsFromSymbolTable dcl_defined cModuleScope cs_symbol_table + cs_symbol_table = foldlArraySt removeImportedSymbolsFromSymbolTable dcls_import cs_symbol_table - cs_symbol_table - = foldlArraySt removeImportedSymbolsFromSymbolTable dcls_import cs_symbol_table dcl_mod = { dcl_mod & dcl_declared = { dcl_mod.dcl_declared & dcls_import = dcls_import }, dcl_common = dcl_common, dcl_functions = dcl_functions, dcl_instances = { ir_from = nr_of_dcl_functions, ir_to = nr_of_dcl_functions_and_instances }, dcl_specials = { ir_from = cUndef, ir_to = cUndef }, dcl_imported_module_numbers = dcl_imported_module_numbers} = ((nr_of_dcl_functions_and_instances, nr_of_dcl_funs_insts_and_specs, rev_special_defs), - (expl_imp_info, { modules & [ mod_index ] = dcl_mod }, icl_functions, heaps, { cs & cs_symbol_table = cs_symbol_table })) + (expl_imp_info, { modules & [ mod_index ] = dcl_mod }, icl_functions, macro_defs, heaps, { cs & cs_symbol_table = cs_symbol_table })) where adjust_predefined_symbols mod_index class_members class_instances fun_types cs=:{cs_predef_symbols} # (pre_mod, cs_predef_symbols) = cs_predef_symbols![PD_StdArray] @@ -2755,14 +2790,11 @@ where <=< adjustPredefSymbol PD_unify mod_index STE_DclFunction <=< adjustPredefSymbol PD_coerce mod_index STE_DclFunction <=< adjustPredefSymbol PD_undo_indirections mod_index STE_DclFunction -// MV ... <=< adjustPredefSymbol PD_DynamicTemp mod_index STE_Type <=< adjustPredefSymbol PD_DynamicType mod_index (STE_Field unused) <=< adjustPredefSymbol PD_DynamicValue mod_index (STE_Field unused) - <=< adjustPredefSymbol PD_TypeID mod_index STE_Type <=< adjustPredefSymbol PD_ModuleID mod_index STE_Constructor) -// ... MV // AA.. # (pre_mod, cs_predef_symbols) = cs_predef_symbols![PD_StdGeneric] # (pd_type_iso, cs_predef_symbols) = cs_predef_symbols![PD_TypeISO] @@ -2799,14 +2831,10 @@ where = (class_members, class_instances, fun_types, { cs & cs_predef_symbols = cs_predef_symbols} <=< adjustPredefSymbol PD_abort mod_index STE_DclFunction <=< adjustPredefSymbol PD_undef mod_index STE_DclFunction) -// ..AA - = (class_members, class_instances, fun_types, { cs & cs_predef_symbols = cs_predef_symbols}) - + = (class_members, class_instances, fun_types, { cs & cs_predef_symbols = cs_predef_symbols}) where -// MV ... unused = { id_name = "unused", id_info = nilPtr } -// ... MV adjust_predef_symbols next_symb last_symb mod_index symb_kind cs=:{cs_predef_symbols, cs_symbol_table, cs_error} | next_symb > last_symb @@ -2822,11 +2850,8 @@ where = sum count_members_of_instance mod_index {ins_class,ins_is_generic} (sum, com_class_defs, modules) -//AA.. | ins_is_generic = (1 + sum, com_class_defs, modules) - | otherwise -//..AA # ({class_members}, com_class_defs, modules) = getClassDef ins_class mod_index com_class_defs modules = (size class_members + sum, com_class_defs, modules) @@ -2850,10 +2875,6 @@ NewEntry symbol_table symb_ptr def_kind def_index level previous :== file_and_status {ea_file,ea_ok} = (ea_file, ea_ok) -instance <<< FunCall -where - (<<<) file {fc_index} = file <<< fc_index - instance <<< AuxiliaryPattern where (<<<) file (AP_Algebraic symbol index patterns var) @@ -2973,8 +2994,6 @@ groupify { dag_nr_of_nodes, dag_get_children } component_numbers nr_of_component array_to_list a = [el\\el<-:a] -Ste_Empty :== STE_Empty - dummy_decl =: { decl_ident = { id_name = "", id_info = nilPtr }, decl_pos = NoPos, decl_kind = STE_Empty, decl_index = cUndef } diff --git a/frontend/checkFunctionBodies.dcl b/frontend/checkFunctionBodies.dcl index fd75a04..3701527 100644 --- a/frontend/checkFunctionBodies.dcl +++ b/frontend/checkFunctionBodies.dcl @@ -9,16 +9,15 @@ import syntax, checksupport , es_calls :: ![FunCall] , es_dynamics :: ![ExprInfoPtr] , es_fun_defs :: !.{# FunDef} -// MV ... , es_dynamic_expr_count :: !Int // used to give each dynamic expr an unique id -// ... MV } :: ExpressionInput = { ei_expr_level :: !Level - , ei_fun_index :: !Index + , ei_fun_index :: !FunctionOrMacroIndex , ei_fun_level :: !Level , ei_mod_index :: !Index + , ei_local_functions_index_offset :: !Int } checkFunctionBodies :: !FunctionBody !Ident !.ExpressionInput !*ExpressionState !*ExpressionInfo !*CheckState diff --git a/frontend/checkFunctionBodies.icl b/frontend/checkFunctionBodies.icl index 93afa69..4dfdaa7 100644 --- a/frontend/checkFunctionBodies.icl +++ b/frontend/checkFunctionBodies.icl @@ -2,7 +2,7 @@ implementation module checkFunctionBodies import syntax, typesupport, parse, checksupport, utilities, checktypes, transform, predef //, RWSDebug import explicitimports, comparedefimp, mergecases -from check import checkFunctions +from check import checkFunctions,checkDclMacros cIsInExpressionList :== True cIsNotInExpressionList :== False @@ -17,22 +17,20 @@ cEndWithSelection :== False , es_calls :: ![FunCall] , es_dynamics :: ![ExprInfoPtr] , es_fun_defs :: !.{# FunDef} -// MV ... , es_dynamic_expr_count :: !Int // used to give each dynamic expr an unique id -// ... MV } :: ExpressionInput = { ei_expr_level :: !Level - , ei_fun_index :: !Index + , ei_fun_index :: !FunctionOrMacroIndex , ei_fun_level :: !Level , ei_mod_index :: !Index -// , ei_fun_kind :: !FunKind + , ei_local_functions_index_offset :: !Int } :: PatternState = { ps_var_heap :: !.VarHeap - , ps_fun_defs :: !.{# FunDef} + , ps_fun_defs :: !.{#FunDef} } :: PatternInput = @@ -125,8 +123,7 @@ make_case_guards cons_symbol type_symbol alg_patterns expr_heap cs checkFunctionBodies :: !FunctionBody !Ident !.ExpressionInput !*ExpressionState !*ExpressionInfo !*CheckState -> (FunctionBody,[FreeVar],!.ExpressionState,.ExpressionInfo,!.CheckState); checkFunctionBodies (ParsedBody [{pb_args,pb_rhs={rhs_alts,rhs_locals}, pb_position} : bodies]) function_ident_for_errors e_input=:{ei_expr_level,ei_mod_index} e_state=:{es_var_heap, es_fun_defs} e_info cs - - # (aux_patterns, (var_env, array_patterns), {ps_var_heap, ps_fun_defs}, e_info, cs) + # (aux_patterns, (var_env, array_patterns), {ps_var_heap,ps_fun_defs}, e_info, cs) = check_patterns pb_args {pi_def_level = ei_expr_level, pi_mod_index = ei_mod_index, pi_is_node_pattern = False} ([], []) {ps_var_heap = es_var_heap, ps_fun_defs = es_fun_defs} e_info cs @@ -174,11 +171,11 @@ where check_function_bodies free_vars fun_args [{pb_args,pb_rhs={rhs_alts,rhs_locals},pb_position} : bodies] e_input=:{ei_expr_level,ei_mod_index} e_state=:{es_var_heap,es_fun_defs} e_info cs # cs = pushErrorAdmin (newPosition function_ident_for_errors pb_position) cs - # (aux_patterns, (var_env, array_patterns), {ps_var_heap, ps_fun_defs}, e_info, cs) + # (aux_patterns, (var_env, array_patterns), {ps_var_heap,ps_fun_defs}, e_info, cs) = check_patterns pb_args { pi_def_level = ei_expr_level, pi_mod_index = ei_mod_index, pi_is_node_pattern = False } ([], []) - {ps_var_heap = es_var_heap, ps_fun_defs = es_fun_defs} e_info cs + {ps_var_heap = es_var_heap,ps_fun_defs = es_fun_defs} e_info cs # cs = popErrorAdmin cs - e_state = { e_state & es_var_heap = ps_var_heap, es_fun_defs = ps_fun_defs} + e_state = { e_state & es_var_heap = ps_var_heap,es_fun_defs = ps_fun_defs} (rhs_expr, free_vars, e_state, e_info, cs) = checkRhs free_vars rhs_alts rhs_locals e_input e_state e_info cs (rhs_expr, free_vars, e_state=:{es_dynamics=dynamics_in_rhs}, e_info, cs) = addArraySelections array_patterns rhs_expr free_vars e_input e_state e_info cs @@ -311,12 +308,27 @@ where # (var_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap = (Var { var_name = fv_name, var_info_ptr = fv_info_ptr, var_expr_ptr = var_expr_ptr }, result_expr, expr_heap) +checkFunctionBodies _ function_ident_for_errors e_input=:{ei_expr_level,ei_mod_index} e_state=:{es_var_heap, es_fun_defs} e_info cs + = abort ("checkFunctionBodies "+++toString function_ident_for_errors) + + +removeLocalsFromSymbolTable :: !Index !Level ![Ident] !LocalDefs !Int !*{#FunDef} !*{#*{#FunDef}} !*(Heap SymbolTableEntry) + -> (!.{#FunDef},!.{#.{#FunDef}},!.Heap SymbolTableEntry) +removeLocalsFromSymbolTable module_index level loc_vars (CollectedLocalDefs {loc_functions,loc_in_icl_module}) local_functions_index_offset fun_defs macro_defs symbol_table + # loc_functions={ir_from=loc_functions.ir_from+local_functions_index_offset,ir_to=loc_functions.ir_to+local_functions_index_offset} + # symbol_table=removeLocalIdentsFromSymbolTable level loc_vars symbol_table + | loc_in_icl_module + # (fun_defs,symbol_table) = removeLocalFunctionsFromSymbolTable level loc_functions fun_defs symbol_table + = (fun_defs,macro_defs,symbol_table) + # (macro_defs,symbol_table) = removeLocalDclMacrosFromSymbolTable level module_index loc_functions macro_defs symbol_table + = (fun_defs,macro_defs,symbol_table) + checkRhs :: [FreeVar] OptGuardedAlts LocalDefs ExpressionInput *ExpressionState *ExpressionInfo *CheckState -> *(!Expression,![FreeVar],!*ExpressionState,!*ExpressionInfo,!*CheckState); -checkRhs free_vars rhs_alts rhs_locals e_input=:{ei_expr_level,ei_mod_index} e_state e_info cs +checkRhs free_vars rhs_alts rhs_locals e_input=:{ei_expr_level,ei_mod_index,ei_local_functions_index_offset} e_state e_info cs # ei_expr_level = inc ei_expr_level - (loc_defs, (var_env, array_patterns), e_state, e_info, cs) = checkLhssOfLocalDefs ei_expr_level ei_mod_index rhs_locals e_state e_info cs + (loc_defs, (var_env, array_patterns), e_state, e_info, cs) = checkLhssOfLocalDefs ei_expr_level ei_mod_index rhs_locals ei_local_functions_index_offset e_state e_info cs (es_fun_defs, e_info, heaps, cs) - = checkLocalFunctions ei_mod_index ei_expr_level rhs_locals e_state.es_fun_defs e_info + = checkLocalFunctions ei_mod_index ei_expr_level rhs_locals ei_local_functions_index_offset e_state.es_fun_defs e_info { hp_var_heap = e_state.es_var_heap, hp_expression_heap = e_state.es_expr_heap, hp_type_heaps = e_state.es_type_heaps } cs (rhs_expr, free_vars, e_state, e_info, cs) = check_opt_guarded_alts free_vars rhs_alts { e_input & ei_expr_level = ei_expr_level } @@ -325,8 +337,8 @@ checkRhs free_vars rhs_alts rhs_locals e_input=:{ei_expr_level,ei_mod_index} e_s (expr, free_vars, e_state, e_info, cs) = addArraySelections array_patterns rhs_expr free_vars e_input e_state e_info cs (expr, free_vars, e_state, e_info, cs) = checkRhssAndTransformLocalDefs free_vars loc_defs expr e_input e_state e_info cs - (es_fun_defs, cs_symbol_table) = removeLocalsFromSymbolTable ei_expr_level var_env rhs_locals e_state.es_fun_defs cs.cs_symbol_table - = (expr, free_vars, { e_state & es_fun_defs = es_fun_defs}, e_info, { cs & cs_symbol_table = cs_symbol_table }) + (es_fun_defs,macro_defs,cs_symbol_table) = removeLocalsFromSymbolTable ei_mod_index ei_expr_level var_env rhs_locals ei_local_functions_index_offset e_state.es_fun_defs e_info.ef_macro_defs cs.cs_symbol_table + = (expr, free_vars, { e_state & es_fun_defs = es_fun_defs}, {e_info & ef_macro_defs=macro_defs}, { cs & cs_symbol_table = cs_symbol_table }) where check_opt_guarded_alts free_vars (GuardedAlts guarded_alts default_expr) e_input e_state e_info cs # (let_vars_list, rev_guarded_exprs, last_expr_level, free_vars, e_state, e_info, cs) @@ -386,10 +398,10 @@ where = (let_vars_list, [(let_binds, guard, expr, alt_ident) : rev_guarded_exprs], ei_expr_level, free_vars, e_state, e_info, cs ) check_unguarded_expression :: [FreeVar] ExprWithLocalDefs ExpressionInput *ExpressionState *ExpressionInfo *CheckState -> *(!Expression,![FreeVar],!*ExpressionState,!*ExpressionInfo,!*CheckState); - check_unguarded_expression free_vars {ewl_nodes,ewl_expr,ewl_locals,ewl_position} e_input=:{ei_expr_level,ei_mod_index} e_state e_info cs + check_unguarded_expression free_vars {ewl_nodes,ewl_expr,ewl_locals,ewl_position} e_input=:{ei_expr_level,ei_mod_index,ei_local_functions_index_offset} e_state e_info cs # this_expr_level = inc ei_expr_level (loc_defs, (var_env, array_patterns), e_state, e_info, cs) - = checkLhssOfLocalDefs this_expr_level ei_mod_index ewl_locals e_state e_info cs + = checkLhssOfLocalDefs this_expr_level ei_mod_index ewl_locals ei_local_functions_index_offset e_state e_info cs (binds, let_vars_list, rhs_expr_level, free_vars, e_state, e_info, cs) = check_sequential_lets free_vars ewl_nodes [] { e_input & ei_expr_level = this_expr_level } e_state e_info cs cs = pushErrorAdmin2 "" ewl_position cs (expr, free_vars, e_state, e_info, cs) = checkExpression free_vars ewl_expr { e_input & ei_expr_level = rhs_expr_level } e_state e_info cs @@ -401,11 +413,11 @@ where (expr, free_vars, e_state, e_info, cs) = checkRhssAndTransformLocalDefs free_vars loc_defs seq_let_expr e_input { e_state & es_expr_heap = es_expr_heap} e_info cs (es_fun_defs, e_info, heaps, cs) - = checkLocalFunctions ei_mod_index rhs_expr_level ewl_locals e_state.es_fun_defs e_info + = checkLocalFunctions ei_mod_index rhs_expr_level ewl_locals ei_local_functions_index_offset e_state.es_fun_defs e_info { hp_var_heap = e_state.es_var_heap, hp_expression_heap = e_state.es_expr_heap, hp_type_heaps = e_state.es_type_heaps } cs - (es_fun_defs, cs_symbol_table) = removeLocalsFromSymbolTable this_expr_level var_env ewl_locals es_fun_defs cs.cs_symbol_table + (es_fun_defs,macro_defs,cs_symbol_table) = removeLocalsFromSymbolTable ei_mod_index this_expr_level var_env ewl_locals ei_local_functions_index_offset es_fun_defs e_info.ef_macro_defs cs.cs_symbol_table = (expr, free_vars, {e_state & es_fun_defs = es_fun_defs, es_var_heap = heaps.hp_var_heap, - es_expr_heap = heaps.hp_expression_heap, es_type_heaps = heaps.hp_type_heaps }, e_info, { cs & cs_symbol_table = cs_symbol_table} ) + es_expr_heap = heaps.hp_expression_heap, es_type_heaps = heaps.hp_type_heaps }, {e_info & ef_macro_defs=macro_defs}, { cs & cs_symbol_table = cs_symbol_table} ) remove_seq_let_vars level [] symbol_table = symbol_table @@ -438,21 +450,21 @@ where = ([], let_vars_list, ei_expr_level, free_vars, e_state, e_info, cs) check_sequential_let :: [FreeVar] NodeDefWithLocals ExpressionInput *ExpressionState *ExpressionInfo *CheckState -> *(!Expression,!AuxiliaryPattern,!(![Ident],![ArrayPattern]),![FreeVar],!*ExpressionState,!*ExpressionInfo,!*CheckState); - check_sequential_let free_vars {ndwl_def={bind_src,bind_dst},ndwl_locals, ndwl_position} e_input=:{ei_expr_level,ei_mod_index} e_state e_info cs + check_sequential_let free_vars {ndwl_def={bind_src,bind_dst},ndwl_locals, ndwl_position} e_input=:{ei_expr_level,ei_mod_index,ei_local_functions_index_offset} e_state e_info cs # cs = pushErrorAdmin (newPosition {id_name="node definition", id_info=nilPtr} ndwl_position) cs - (loc_defs, (loc_env, loc_array_patterns), e_state, e_info, cs) = checkLhssOfLocalDefs ei_expr_level ei_mod_index ndwl_locals e_state e_info cs + (loc_defs, (loc_env, loc_array_patterns), e_state, e_info, cs) = checkLhssOfLocalDefs ei_expr_level ei_mod_index ndwl_locals ei_local_functions_index_offset e_state e_info cs (src_expr, free_vars, e_state, e_info, cs) = checkExpression free_vars bind_src e_input e_state e_info cs (src_expr, free_vars, e_state, e_info, cs) = addArraySelections loc_array_patterns src_expr free_vars e_input e_state e_info cs (src_expr, free_vars, e_state, e_info, cs) = checkRhssAndTransformLocalDefs free_vars loc_defs src_expr e_input e_state e_info cs (es_fun_defs, e_info, {hp_var_heap,hp_expression_heap,hp_type_heaps}, cs) - = checkLocalFunctions ei_mod_index ei_expr_level ndwl_locals e_state.es_fun_defs e_info + = checkLocalFunctions ei_mod_index ei_expr_level ndwl_locals ei_local_functions_index_offset e_state.es_fun_defs e_info { hp_var_heap = e_state.es_var_heap, hp_expression_heap = e_state.es_expr_heap, hp_type_heaps = e_state.es_type_heaps } cs - (es_fun_defs, cs_symbol_table) = removeLocalsFromSymbolTable ei_expr_level loc_env ndwl_locals es_fun_defs cs.cs_symbol_table + (es_fun_defs,macro_defs,cs_symbol_table) = removeLocalsFromSymbolTable ei_mod_index ei_expr_level loc_env ndwl_locals ei_local_functions_index_offset es_fun_defs e_info.ef_macro_defs cs.cs_symbol_table (pattern, accus, {ps_fun_defs,ps_var_heap}, e_info, cs) = checkPattern bind_dst No { pi_def_level = ei_expr_level, pi_mod_index = ei_mod_index, pi_is_node_pattern = True } ([], []) - {ps_var_heap = hp_var_heap, ps_fun_defs = es_fun_defs } e_info { cs & cs_symbol_table = cs_symbol_table } - e_state = { e_state & es_var_heap = ps_var_heap, es_expr_heap = hp_expression_heap, es_type_heaps = hp_type_heaps, es_fun_defs = ps_fun_defs } + {ps_var_heap = hp_var_heap,ps_fun_defs = es_fun_defs } {e_info & ef_macro_defs=macro_defs} { cs & cs_symbol_table = cs_symbol_table } + e_state = { e_state & es_var_heap = ps_var_heap, es_expr_heap = hp_expression_heap, es_type_heaps = hp_type_heaps,es_fun_defs = ps_fun_defs } = (src_expr, pattern, accus, free_vars, e_state, e_info, popErrorAdmin cs) build_sequential_lets :: ![(![LetBind],![LetBind])] !Expression !Position !*ExpressionHeap -> (!Position, !Expression, !*ExpressionHeap) @@ -463,10 +475,14 @@ where (let_expr, expr_heap) = buildLetExpression strict_binds lazy_binds let_expr let_expr_position expr_heap = (if (isEmpty strict_binds && isEmpty lazy_binds) let_expr_position NoPos, let_expr, expr_heap) -checkLocalFunctions :: !Index !Level !LocalDefs !*{#FunDef} !*ExpressionInfo !*Heaps !*CheckState - -> (!.{#FunDef},!.ExpressionInfo,!.Heaps,!.CheckState); -checkLocalFunctions mod_index level (CollectedLocalDefs {loc_functions={ir_from,ir_to}}) fun_defs e_info heaps cs - = checkFunctions mod_index level ir_from ir_to fun_defs e_info heaps cs +checkLocalFunctions :: !Index !Level !LocalDefs !Int !*{#FunDef} !*ExpressionInfo !*Heaps !*CheckState + -> (!.{#FunDef},!.ExpressionInfo,!.Heaps,!.CheckState); +checkLocalFunctions mod_index level (CollectedLocalDefs {loc_functions={ir_from,ir_to},loc_in_icl_module}) local_functions_index_offset fun_defs e_info heaps cs + # ir_from=ir_from+local_functions_index_offset + # ir_to=ir_to+local_functions_index_offset + | loc_in_icl_module + = checkFunctions mod_index level ir_from ir_to local_functions_index_offset fun_defs e_info heaps cs + = checkDclMacros mod_index level ir_from ir_to fun_defs e_info heaps cs checkExpression :: ![FreeVar] !ParsedExpr !ExpressionInput !*ExpressionState !*ExpressionInfo !*CheckState -> *(!Expression, ![FreeVar], !*ExpressionState, !*ExpressionInfo, !*CheckState); @@ -579,22 +595,22 @@ where # (result_expr, e_state, cs_error) = buildApplication symb 2 2 is_fun [left,result_expr] e_state cs_error = build_final_expression left_appls result_expr e_state cs_error -checkExpression free_vars (PE_Let strict let_locals expr) e_input=:{ei_expr_level,ei_mod_index} e_state e_info cs +checkExpression free_vars (PE_Let strict let_locals expr) e_input=:{ei_expr_level,ei_mod_index,ei_local_functions_index_offset} e_state e_info cs # ei_expr_level = inc ei_expr_level (loc_defs, (var_env, array_patterns), e_state, e_info, cs) - = checkLhssOfLocalDefs ei_expr_level ei_mod_index let_locals e_state e_info cs + = checkLhssOfLocalDefs ei_expr_level ei_mod_index let_locals ei_local_functions_index_offset e_state e_info cs e_input = { e_input & ei_expr_level = ei_expr_level } (let_expr, free_vars, e_state, e_info, cs) = checkExpression free_vars expr e_input e_state e_info cs (expr, free_vars, e_state=:{es_dynamics,es_expr_heap,es_var_heap}, e_info, cs) = addArraySelections array_patterns let_expr free_vars e_input e_state e_info cs (expr, free_vars, e_state, e_info, cs) = checkRhssAndTransformLocalDefs free_vars loc_defs expr e_input e_state e_info cs (es_fun_defs, e_info, heaps, cs) - = checkLocalFunctions ei_mod_index ei_expr_level let_locals e_state.es_fun_defs e_info + = checkLocalFunctions ei_mod_index ei_expr_level let_locals ei_local_functions_index_offset e_state.es_fun_defs e_info { hp_var_heap = e_state.es_var_heap, hp_expression_heap = e_state.es_expr_heap, hp_type_heaps = e_state.es_type_heaps } cs - (es_fun_defs, cs_symbol_table) = removeLocalsFromSymbolTable ei_expr_level var_env let_locals es_fun_defs cs.cs_symbol_table + (es_fun_defs,macro_defs,cs_symbol_table) = removeLocalsFromSymbolTable ei_mod_index ei_expr_level var_env let_locals ei_local_functions_index_offset es_fun_defs e_info.ef_macro_defs cs.cs_symbol_table = (expr, free_vars, { e_state & es_fun_defs = es_fun_defs, es_var_heap = heaps.hp_var_heap, es_expr_heap = heaps.hp_expression_heap, - es_type_heaps = heaps.hp_type_heaps }, e_info, { cs & cs_symbol_table = cs_symbol_table }) + es_type_heaps = heaps.hp_type_heaps }, {e_info & ef_macro_defs=macro_defs}, { cs & cs_symbol_table = cs_symbol_table }) checkExpression free_vars (PE_Case case_ident expr alts) e_input e_state e_info cs # (pattern_expr, free_vars, e_state, e_info, cs) = checkExpression free_vars expr e_input e_state e_info cs @@ -619,8 +635,8 @@ where e_input=:{ei_expr_level,ei_mod_index} e_state=:{es_fun_defs,es_var_heap} e_info cs # (pattern, (var_env, array_patterns), {ps_fun_defs,ps_var_heap}, e_info, cs) = checkPattern calt_pattern No { pi_def_level = ei_expr_level, pi_mod_index = ei_mod_index, pi_is_node_pattern = False } ([], []) - {ps_var_heap = es_var_heap, ps_fun_defs = es_fun_defs} e_info cs - e_state = { e_state & es_var_heap = ps_var_heap, es_fun_defs = ps_fun_defs } + {ps_var_heap = es_var_heap,ps_fun_defs = es_fun_defs} e_info cs + e_state = { e_state & es_var_heap = ps_var_heap,es_fun_defs = ps_fun_defs } (rhs_expr, free_vars, e_state, e_info, cs) = checkRhs free_vars rhs_alts rhs_locals e_input e_state e_info cs (expr_with_array_selections, free_vars, e_state=:{es_dynamics,es_expr_heap,es_var_heap}, e_info, cs) @@ -1156,7 +1172,6 @@ where checkExpression free_vars (PE_Ident id) e_input e_state e_info cs = checkIdentExpression cIsNotInExpressionList free_vars id e_input e_state e_info cs -// AA.. checkExpression free_vars (PE_Generic id=:{id_name,id_info} kind) e_input e_state e_info cs=:{cs_symbol_table, cs_x} //= checkIdentExpression cIsNotInExpressionList free_vars id e_input e_state e_info cs # (entry, cs_symbol_table) = readPtr id_info cs_symbol_table @@ -1213,7 +1228,6 @@ checkExpression free_vars (PE_Generic id=:{id_name,id_info} kind) e_input e_stat #! th_vars = writePtr gen_kinds_ptr (TVI_Kinds kinds) th_vars #! e_state = { e_state & es_type_heaps = {es_type_heaps & th_vars = th_vars}} = (generic_defs, e_state) -// ..AA checkExpression free_vars expr e_input e_state e_info cs = abort "checkExpression (checkFunctionBodies.icl, line 868)" // <<- expr @@ -1258,15 +1272,12 @@ where #! (var_expr_ptr, es_expr_heap) = newPtr EI_Empty es_expr_heap = (Var {var_name = id, var_info_ptr = info_ptr, var_expr_ptr = var_expr_ptr}, free_vars, {e_state & es_expr_heap = es_expr_heap}, e_info, cs) -// AA.. check_id_expression {ste_kind = STE_Generic} is_expr_list free_vars id e_input e_state e_info cs=:{cs_error} = (EE, free_vars, e_state, e_info, { cs & cs_error = checkError id "generic: missing kind argument" cs_error}) check_id_expression {ste_kind = STE_Imported STE_Generic _} is_expr_list free_vars id e_input e_state e_info cs=:{cs_error} = (EE, free_vars, e_state, e_info, - { cs & cs_error = checkError id "generic: missing kind argument" cs_error}) -// ..AA - + { cs & cs_error = checkError id "generic: missing kind argument" cs_error}) check_id_expression entry is_expr_list free_vars id=:{id_info} e_input e_state e_info cs # (symb_kind, arity, priority, is_a_function, e_state, e_info, cs) = determine_info_of_symbol entry id_info e_input e_state e_info cs symbol = { symb_name = id, symb_kind = symb_kind, symb_arity = 0 } @@ -1278,51 +1289,53 @@ where determine_info_of_symbol :: !SymbolTableEntry !SymbolPtr !ExpressionInput !*ExpressionState !u:ExpressionInfo !*CheckState -> (!SymbKind, !Int, !Priority, !Bool, !*ExpressionState, !u:ExpressionInfo,!*CheckState) determine_info_of_symbol entry=:{ste_kind=STE_FunctionOrMacro calls,ste_index,ste_def_level} symb_info - e_input=:{ei_fun_index, ei_mod_index} e_state=:{es_fun_defs,es_calls} e_info cs=:{cs_symbol_table,cs_x} - # ({fun_symb,fun_arity,fun_kind,fun_priority,fun_info={fi_properties}}, es_fun_defs) = es_fun_defs![ste_index] + e_input=:{ei_fun_index} e_state=:{es_calls} e_info cs=:{cs_symbol_table,cs_x} + # (fun_def,e_state) = e_state!es_fun_defs.[ste_index] + # {fun_symb,fun_arity,fun_kind,fun_priority,fun_info={fi_properties}}=fun_def # index = { glob_object = ste_index, glob_module = cs_x.x_main_dcl_module_n } + # symbol_kind = convert_DefOrImpFunKind_to_icl_SymbKind fun_kind index fi_properties | is_called_before ei_fun_index calls - | case fun_kind of FK_DefMacro->True ; FK_ImpMacro->True; _ -> False - = (SK_Macro index, fun_arity, fun_priority, cIsAFunction, { e_state & es_fun_defs = es_fun_defs }, e_info, cs) - # symbol_kind = if (fi_properties bitand FI_IsMacroFun <> 0) (SK_LocalMacroFunction ste_index) (SK_Function index) - = (symbol_kind, fun_arity, fun_priority, cIsAFunction, { e_state & es_fun_defs = es_fun_defs }, e_info, cs) + = (symbol_kind, fun_arity, fun_priority, cIsAFunction, e_state, e_info, cs) # cs = { cs & cs_symbol_table = cs_symbol_table <:= (symb_info, { entry & ste_kind = STE_FunctionOrMacro [ ei_fun_index : calls ]})} - e_state = { e_state & es_fun_defs = es_fun_defs, es_calls = [{ fc_index = ste_index, fc_level = ste_def_level} : es_calls ]} - # symbol_kind = case fun_kind of - FK_DefMacro - -> SK_Macro index; - FK_ImpMacro - -> SK_Macro index; - _ - | fi_properties bitand FI_IsMacroFun <> 0 - -> SK_LocalMacroFunction ste_index - -> SK_Function index + # e_state = { e_state & es_calls = [FunCall ste_index ste_def_level : es_calls ]} + = (symbol_kind, fun_arity, fun_priority, cIsAFunction, e_state, e_info, cs) + determine_info_of_symbol entry=:{ste_kind=STE_DclMacroOrLocalMacroFunction calls,ste_index,ste_def_level} symb_info + e_input=:{ei_fun_index, ei_mod_index} e_state=:{es_calls} e_info cs=:{cs_symbol_table} + # (macro_def,e_info) = e_info!ef_macro_defs.[ei_mod_index,ste_index] + # {fun_symb,fun_arity,fun_kind,fun_priority,fun_info={fi_properties}}=macro_def + # index = { glob_object = ste_index, glob_module = ei_mod_index } + # symbol_kind = convert_DefOrImpFunKind_to_dcl_SymbKind fun_kind index fi_properties + | is_called_before ei_fun_index calls + = (symbol_kind, fun_arity, fun_priority, cIsAFunction, e_state, e_info, cs) + # cs = { cs & cs_symbol_table = cs_symbol_table <:= (symb_info, { entry & ste_kind = STE_DclMacroOrLocalMacroFunction [ ei_fun_index : calls ]})} + # e_state = { e_state & es_calls = [MacroCall ei_mod_index ste_index ste_def_level : es_calls ]} + = (symbol_kind, fun_arity, fun_priority, cIsAFunction, e_state, e_info, cs) + determine_info_of_symbol entry=:{ste_kind=STE_Imported (STE_DclMacroOrLocalMacroFunction calls) macro_mod_index,ste_index,ste_def_level} symb_info + e_input=:{ei_fun_index} e_state=:{es_calls} e_info cs=:{cs_symbol_table} + # (macro_def,e_info) = e_info!ef_macro_defs.[macro_mod_index,ste_index] + # {fun_symb,fun_arity,fun_kind,fun_priority,fun_info={fi_properties}}=macro_def + # index = { glob_object = ste_index, glob_module = macro_mod_index } + # symbol_kind = convert_DefOrImpFunKind_to_dcl_SymbKind fun_kind index fi_properties + | is_called_before ei_fun_index calls + = (symbol_kind, fun_arity, fun_priority, cIsAFunction, e_state, e_info, cs) + # cs = { cs & cs_symbol_table = cs_symbol_table <:= (symb_info, { entry & ste_kind = STE_Imported (STE_DclMacroOrLocalMacroFunction [ ei_fun_index : calls ]) macro_mod_index})} + # e_state = { e_state & es_calls = [MacroCall macro_mod_index ste_index ste_def_level : es_calls ]} = (symbol_kind, fun_arity, fun_priority, cIsAFunction, e_state, e_info, cs) - where - is_called_before caller_index [] - = False - is_called_before caller_index [called_index : calls] - = caller_index == called_index || is_called_before caller_index calls - determine_info_of_symbol entry=:{ste_kind=STE_Imported kind mod_index,ste_index} symb_index e_input e_state e_info=:{ef_modules} cs # (mod_def, ef_modules) = ef_modules![mod_index] # (kind, arity, priotity, is_fun) = ste_kind_to_symbol_kind kind ste_index mod_index mod_def = (kind, arity, priotity, is_fun, e_state, { e_info & ef_modules = ef_modules }, cs) where ste_kind_to_symbol_kind :: !STE_Kind !Index !Index !DclModule -> (!SymbKind, !Int, !Priority, !Bool); - ste_kind_to_symbol_kind STE_DclFunction def_index mod_index {dcl_functions,dcl_conversions} + ste_kind_to_symbol_kind STE_DclFunction def_index mod_index {dcl_functions} # {ft_type={st_arity},ft_priority} = dcl_functions.[def_index] - # def_index = convertIndex def_index (toInt STE_DclFunction) dcl_conversions = (SK_Function { glob_object = def_index, glob_module = mod_index }, st_arity, ft_priority, cIsAFunction) - ste_kind_to_symbol_kind STE_Member def_index mod_index {dcl_common={com_member_defs},dcl_conversions} + ste_kind_to_symbol_kind STE_Member def_index mod_index {dcl_common={com_member_defs}} # {me_type={st_arity},me_priority} = com_member_defs.[def_index] - # def_index = convertIndex def_index (toInt STE_Member) dcl_conversions = (SK_OverloadedFunction { glob_object = def_index, glob_module = mod_index }, st_arity, me_priority, cIsAFunction) - ste_kind_to_symbol_kind STE_Constructor def_index mod_index {dcl_common={com_cons_defs},dcl_conversions} + ste_kind_to_symbol_kind STE_Constructor def_index mod_index {dcl_common={com_cons_defs}} # {cons_type={st_arity},cons_priority} = com_cons_defs.[def_index] - # def_index = convertIndex def_index (toInt STE_Constructor) dcl_conversions = (SK_Constructor { glob_object = def_index, glob_module = mod_index }, st_arity, cons_priority, cIsNotAFunction) - determine_info_of_symbol {ste_kind=STE_Member, ste_index} _ e_input=:{ei_mod_index} e_state e_info=:{ef_member_defs} cs # ({me_type={st_arity},me_priority}, ef_member_defs) = ef_member_defs![ste_index] = (SK_OverloadedFunction { glob_object = ste_index, glob_module = ei_mod_index}, st_arity, me_priority, cIsAFunction, @@ -1334,10 +1347,28 @@ where determine_info_of_symbol {ste_kind=STE_DclFunction, ste_index} _ e_input=:{ei_mod_index} e_state e_info=:{ef_modules} cs # (mod_def, ef_modules) = ef_modules![ei_mod_index] # {ft_type={st_arity},ft_priority} = mod_def.dcl_functions.[ste_index] - def_index = convertIndex ste_index (toInt STE_DclFunction) mod_def.dcl_conversions - = (SK_Function { glob_object = def_index, glob_module = ei_mod_index}, st_arity, ft_priority, cIsAFunction, + = (SK_Function { glob_object = ste_index, glob_module = ei_mod_index}, st_arity, ft_priority, cIsAFunction, e_state, { e_info & ef_modules = ef_modules }, cs) + is_called_before caller_index [] + = False + is_called_before caller_index [called_index : calls] + = caller_index == called_index || is_called_before caller_index calls + + convert_DefOrImpFunKind_to_icl_SymbKind FK_Macro index fi_properties + = SK_IclMacro index.glob_object; + convert_DefOrImpFunKind_to_icl_SymbKind _ index fi_properties + | fi_properties bitand FI_IsMacroFun <> 0 + = SK_LocalMacroFunction index.glob_object + = SK_Function index + + convert_DefOrImpFunKind_to_dcl_SymbKind FK_Macro index fi_properties + = SK_DclMacro index; + convert_DefOrImpFunKind_to_dcl_SymbKind _ index fi_properties + | fi_properties bitand FI_IsMacroFun <> 0 + = SK_LocalDclMacroFunction index + = SK_Function index + checkPattern :: !ParsedExpr !(Optional (Bind Ident VarInfoPtr)) !PatternInput !(![Ident], ![ArrayPattern]) !*PatternState !*ExpressionInfo !*CheckState -> (!AuxiliaryPattern, !(![Ident], ![ArrayPattern]), !*PatternState, !*ExpressionInfo, !*CheckState) checkPattern (PE_List [exp]) opt_var p_input accus ps e_info cs=:{cs_symbol_table} @@ -1443,7 +1474,7 @@ checkPattern (PE_List [exp1, exp2 : exps]) opt_var p_input accus ps e_info cs = case first_expr of AP_Constant kind constant=:{glob_object={ds_ident,ds_arity}} _ | ds_arity == nr_of_args || (case kind of - APK_Macro -> True + APK_Macro _ -> True _ -> False) # (pattern, ps, e_info, cs) = buildPattern mod_index kind constant args opt_var ps e_info cs -> (pattern, ps, e_info, cs) @@ -1572,23 +1603,31 @@ checkPattern (PE_ArrayPattern selections) opt_var p_input (var_env, array_patter checkPattern expr opt_var p_input accus ps e_info cs = abort "checkPattern: do not know how to handle pattern" ---> expr -checkPatternConstructor :: !Index !Bool !SymbolTableEntry !Ident !(Optional (Bind Ident VarInfoPtr)) !*PatternState !*ExpressionInfo !*CheckState - -> (!AuxiliaryPattern, !*PatternState, !*ExpressionInfo, !*CheckState); -checkPatternConstructor _ _ {ste_kind = STE_Empty} ident _ ps e_info cs=:{cs_error} - = (AP_Empty ident, ps, e_info, { cs & cs_error = checkError ident "not defined" cs_error }) -checkPatternConstructor mod_index is_expr_list {ste_kind = STE_FunctionOrMacro _,ste_index} ident opt_var ps=:{ps_fun_defs} e_info cs=:{cs_error,cs_x} - # ({fun_symb,fun_arity,fun_kind,fun_priority},ps_fun_defs) = ps_fun_defs![ste_index] - ps = { ps & ps_fun_defs = ps_fun_defs } - | case fun_kind of FK_DefMacro->True ; FK_ImpMacro->True; _ -> False +checkMacroPatternConstructor macro=:{fun_symb,fun_arity,fun_kind,fun_priority} macro_mod_index mod_index is_dcl_macro is_expr_list ste_index ident opt_var ps e_info cs=:{cs_error} + | case fun_kind of FK_Macro->True; _ -> False | is_expr_list - # macro_symbol = { glob_object = MakeDefinedSymbol fun_symb ste_index fun_arity, glob_module = cs_x.x_main_dcl_module_n } - = (AP_Constant APK_Macro macro_symbol fun_priority, ps, e_info, cs) + # macro_symbol = { glob_object = MakeDefinedSymbol fun_symb ste_index fun_arity, glob_module = macro_mod_index } + = (AP_Constant (APK_Macro is_dcl_macro) macro_symbol fun_priority, ps, e_info, cs) | fun_arity == 0 # (pattern, ps, ef_modules, ef_cons_defs, cs_error) - = unfoldPatternMacro mod_index ste_index [] opt_var ps e_info.ef_modules e_info.ef_cons_defs cs_error + = unfoldPatternMacro macro mod_index [] opt_var ps e_info.ef_modules e_info.ef_cons_defs cs_error = (pattern, ps, { e_info & ef_modules = ef_modules, ef_cons_defs = ef_cons_defs }, { cs & cs_error = cs_error }) = (AP_Empty ident, ps, e_info, { cs & cs_error = checkError ident "not defined" cs_error }) = (AP_Empty ident, ps, e_info, { cs & cs_error = checkError fun_symb "not allowed in a pattern" cs_error }) + +checkPatternConstructor :: !Index !Bool !SymbolTableEntry !Ident !(Optional (Bind Ident VarInfoPtr)) !*PatternState !*ExpressionInfo !*CheckState + -> (!AuxiliaryPattern, !*PatternState, !*ExpressionInfo, !*CheckState); +checkPatternConstructor _ _ {ste_kind = STE_Empty} ident _ ps e_info cs=:{cs_error} + = (AP_Empty ident, ps, e_info, { cs & cs_error = checkError ident "not defined" cs_error }) +checkPatternConstructor mod_index is_expr_list {ste_kind = STE_FunctionOrMacro _,ste_index} ident opt_var ps e_info cs=:{cs_x} + # (macro,ps) = ps!ps_fun_defs.[ste_index] + = checkMacroPatternConstructor macro cs_x.x_main_dcl_module_n mod_index False is_expr_list ste_index ident opt_var ps e_info cs +checkPatternConstructor mod_index is_expr_list {ste_kind = STE_DclMacroOrLocalMacroFunction _,ste_index} ident opt_var ps e_info cs=:{cs_x} + # (macro,e_info) = e_info!ef_macro_defs.[mod_index,ste_index] + = checkMacroPatternConstructor macro mod_index mod_index True is_expr_list ste_index ident opt_var ps e_info cs +checkPatternConstructor mod_index is_expr_list {ste_kind = STE_Imported (STE_DclMacroOrLocalMacroFunction _) macro_module_index,ste_index} ident opt_var ps e_info cs + # (macro,e_info) = e_info!ef_macro_defs.[macro_module_index,ste_index] + = checkMacroPatternConstructor macro macro_module_index mod_index True is_expr_list ste_index ident opt_var ps e_info cs checkPatternConstructor mod_index is_expr_list {ste_index, ste_kind} cons_symb opt_var ps e_info=:{ef_cons_defs,ef_modules} cs=:{cs_error} # (cons_index, cons_module, cons_arity, cons_priority, cons_type_index, ef_cons_defs, ef_modules, cs_error) @@ -1605,9 +1644,8 @@ where # ({cons_type={st_arity},cons_priority, cons_type_index}, cons_defs) = cons_defs![id_index] = (id_index, mod_index, st_arity, cons_priority, cons_type_index, cons_defs, modules, error) determine_pattern_symbol mod_index id_index (STE_Imported STE_Constructor import_mod_index) id_name cons_defs modules error - # ({dcl_common,dcl_conversions},modules) = modules![import_mod_index] + # ({dcl_common},modules) = modules![import_mod_index] {cons_type={st_arity},cons_priority, cons_type_index} = dcl_common.com_cons_defs.[id_index] - id_index = convertIndex id_index (toInt STE_Constructor) dcl_conversions = (id_index, import_mod_index, st_arity, cons_priority, cons_type_index, cons_defs, modules, error) determine_pattern_symbol mod_index id_index id_kind id_name cons_defs modules error = (id_index, NoIndex, 0, NoPrio, NoIndex, cons_defs, modules, checkError id_name "constructor expected" error) @@ -1835,26 +1873,17 @@ transfromPatternIntoBind mod_index def_level (AP_WildCard _) src_expr _ var_stor transfromPatternIntoBind _ _ pattern src_expr _ var_store expr_heap e_info cs = ([], var_store, expr_heap, e_info, { cs & cs_error = checkError "<pattern>" "illegal node pattern" cs.cs_error}) - - -unfoldPatternMacro mod_index macro_index all_macro_args opt_var ps=:{ps_var_heap, ps_fun_defs} modules cons_defs error - # (macro, ps_fun_defs) = ps_fun_defs![macro_index] - = case macro.fun_body of - TransformedBody {tb_args,tb_rhs} - | no_sharing tb_args - # length_macro_args = length tb_args - (macro_args, extra_args) - = if (length all_macro_args==length_macro_args) - (all_macro_args, []) - (splitAt length_macro_args all_macro_args) - ums = { ums_var_heap = fold2St bind_var tb_args macro_args ps_var_heap, ums_modules = modules, ums_cons_defs = cons_defs, ums_error = error } - (pattern, {ums_var_heap,ums_modules,ums_cons_defs,ums_error}) = unfold_pattern_macro mod_index macro.fun_symb opt_var extra_args tb_rhs ums - -> (pattern, { ps_fun_defs = ps_fun_defs, ps_var_heap = ums_var_heap}, ums_modules, ums_cons_defs, ums_error) - -> (AP_Empty macro.fun_symb, { ps_fun_defs = ps_fun_defs, ps_var_heap = ps_var_heap}, - modules, cons_defs, checkError macro.fun_symb "sharing not allowed" error) - _ - -> (AP_Empty macro.fun_symb, { ps_fun_defs = ps_fun_defs, ps_var_heap = ps_var_heap}, - modules, cons_defs, checkError macro.fun_symb "illegal macro in pattern" error) +unfoldPatternMacro macro=:{fun_body=TransformedBody {tb_args,tb_rhs}} mod_index all_macro_args opt_var ps=:{ps_var_heap} modules cons_defs error + | no_sharing tb_args + # length_macro_args = length tb_args + (macro_args, extra_args) + = if (length all_macro_args==length_macro_args) + (all_macro_args, []) + (splitAt length_macro_args all_macro_args) + ums = { ums_var_heap = fold2St bind_var tb_args macro_args ps_var_heap, ums_modules = modules, ums_cons_defs = cons_defs, ums_error = error } + (pattern, {ums_var_heap,ums_modules,ums_cons_defs,ums_error}) = unfold_pattern_macro mod_index macro.fun_symb opt_var extra_args tb_rhs ums + = (pattern, { ps & ps_var_heap = ums_var_heap}, ums_modules, ums_cons_defs, ums_error) + = (AP_Empty macro.fun_symb, { ps & ps_var_heap = ps_var_heap}, modules, cons_defs, checkError macro.fun_symb "sharing not allowed" error) where no_sharing [{fv_count} : args] = fv_count <= 1 && no_sharing args @@ -1886,9 +1915,9 @@ where | mod_index == cons_mod # (cons_def, cons_defs) = cons_defs![cons_index] = (cons_def, cons_index, cons_defs, modules) - # ({dcl_common,dcl_conversions}, modules) = modules![cons_mod] + # ({dcl_common}, modules) = modules![cons_mod] cons_def = dcl_common.com_cons_defs.[cons_index] - = (cons_def, convertIndex cons_index (toInt STE_Constructor) dcl_conversions, cons_defs, modules) + = (cons_def, cons_index, cons_defs, modules) unfold_pattern_macro mod_index macro_ident opt_var extra_args (BasicExpr bv bt) ums=:{ums_error} | not (isEmpty extra_args) @@ -1896,7 +1925,9 @@ where = (AP_Basic bv opt_var, ums) unfold_pattern_macro mod_index macro_ident opt_var _ expr ums=:{ums_error} = (AP_Empty macro_ident, { ums & ums_error = checkError macro_ident "illegal rhs for a pattern macro" ums_error }) - +unfoldPatternMacro macro mod_index all_macro_args opt_var ps=:{ps_var_heap} modules cons_defs error + = (AP_Empty macro.fun_symb, { ps & ps_var_heap = ps_var_heap}, modules, cons_defs, checkError macro.fun_symb "illegal macro in pattern" error) + checkSelectors end_with_update free_vars [ selector : selectors ] e_input e_state e_info cs | isEmpty selectors # (selector, free_vars, e_state, e_info, cs) = check_selector end_with_update free_vars selector e_input e_state e_info cs @@ -2059,8 +2090,6 @@ where field_error {bind_dst=(field_id,_)} error = checkError field_id "field is either multiply used or not a part of this record" error - - checkRhssAndTransformLocalDefs free_vars [] rhs_expr e_input e_state e_info cs = (rhs_expr, free_vars, e_state, e_info, cs) checkRhssAndTransformLocalDefs free_vars loc_defs rhs_expr e_input e_state e_info cs @@ -2068,13 +2097,18 @@ checkRhssAndTransformLocalDefs free_vars loc_defs rhs_expr e_input e_state e_inf (rhs_expr, es_expr_heap) = buildLetExpression [] binds rhs_expr NoPos e_state.es_expr_heap = (rhs_expr, free_vars, { e_state & es_expr_heap = es_expr_heap }, e_info, cs) -checkLhssOfLocalDefs :: .Int .Int LocalDefs *ExpressionState *ExpressionInfo *CheckState -> (!.[NodeDef AuxiliaryPattern],!(![Ident],![ArrayPattern]),!.ExpressionState,!.ExpressionInfo,!.CheckState); -checkLhssOfLocalDefs def_level mod_index (CollectedLocalDefs {loc_functions={ir_from,ir_to},loc_nodes}) e_state=:{es_var_heap,es_fun_defs} e_info=:{ef_is_macro_fun} cs +checkLhssOfLocalDefs :: .Int .Int LocalDefs Int *ExpressionState *ExpressionInfo *CheckState -> (!.[NodeDef AuxiliaryPattern],!(![Ident],![ArrayPattern]),!.ExpressionState,!.ExpressionInfo,!.CheckState); +checkLhssOfLocalDefs def_level mod_index (CollectedLocalDefs {loc_functions={ir_from,ir_to},loc_nodes,loc_in_icl_module}) local_functions_index_offset e_state=:{es_var_heap,es_fun_defs} e_info=:{ef_is_macro_fun} cs + # ir_from=ir_from+local_functions_index_offset + # ir_to=ir_to+local_functions_index_offset # (loc_defs, accus, {ps_fun_defs,ps_var_heap}, e_info, cs) = check_patterns loc_nodes {pi_def_level = def_level, pi_mod_index = mod_index, pi_is_node_pattern = True } ([], []) {ps_fun_defs = es_fun_defs, ps_var_heap = es_var_heap} e_info cs - (es_fun_defs, cs_symbol_table, cs_error) = addLocalFunctionDefsToSymbolTable def_level ir_from ir_to ef_is_macro_fun ps_fun_defs cs.cs_symbol_table cs.cs_error - = (loc_defs, accus, { e_state & es_fun_defs = es_fun_defs, es_var_heap = ps_var_heap }, e_info, { cs & cs_symbol_table = cs_symbol_table, cs_error = cs_error }) + | loc_in_icl_module + # (fun_defs, cs_symbol_table, cs_error) = addLocalFunctionDefsToSymbolTable def_level ir_from ir_to ef_is_macro_fun ps_fun_defs cs.cs_symbol_table cs.cs_error + = (loc_defs, accus, { e_state & es_fun_defs = fun_defs, es_var_heap = ps_var_heap }, e_info, { cs & cs_symbol_table = cs_symbol_table, cs_error = cs_error }) + # (macro_defs, cs_symbol_table, cs_error) = addLocalDclMacroDefsToSymbolTable def_level mod_index ir_from ir_to e_info.ef_macro_defs cs.cs_symbol_table cs.cs_error + = (loc_defs, accus, { e_state & es_fun_defs = ps_fun_defs, es_var_heap = ps_var_heap }, {e_info & ef_macro_defs=macro_defs}, { cs & cs_symbol_table = cs_symbol_table, cs_error = cs_error }) where check_patterns [ node_def : node_defs ] p_input accus var_store e_info cs # (pattern, accus, var_store, e_info, cs) = checkPattern node_def.nd_dst No p_input accus var_store e_info cs @@ -2170,8 +2204,6 @@ buildLetExpression let_strict_binds let_lazy_binds expr let_expr_position expr_h = (Let {let_strict_binds = let_strict_binds, let_lazy_binds = let_lazy_binds, let_expr = expr, let_info_ptr = let_expr_ptr, let_expr_position = let_expr_position }, expr_heap) - - buildApplication :: !SymbIdent !Int !Int !Bool ![Expression] !*ExpressionState !*ErrorAdmin -> (!Expression,!*ExpressionState,!*ErrorAdmin) buildApplication symbol form_arity act_arity is_fun args e_state=:{es_expr_heap} error | is_fun @@ -2188,10 +2220,16 @@ buildApplication symbol form_arity act_arity is_fun args e_state=:{es_expr_heap} buildPattern mod_index (APK_Constructor type_index) cons_symb args opt_var ps e_info cs = (AP_Algebraic cons_symb type_index args opt_var, ps, e_info, cs) -buildPattern mod_index APK_Macro {glob_object} args opt_var ps e_info=:{ef_modules,ef_cons_defs} cs=:{cs_error} - # (pattern, ps, ef_modules, ef_cons_defs, cs_error) - = unfoldPatternMacro mod_index glob_object.ds_index args opt_var ps ef_modules ef_cons_defs cs_error - = (pattern, ps, { e_info & ef_modules = ef_modules, ef_cons_defs = ef_cons_defs }, { cs & cs_error = cs_error }) +buildPattern mod_index (APK_Macro is_dcl_macro) {glob_module,glob_object} args opt_var ps e_info=:{ef_modules,ef_macro_defs,ef_cons_defs} cs=:{cs_error} + | is_dcl_macro + # (macro,ef_macro_defs) = ef_macro_defs![glob_module,glob_object.ds_index] + # (pattern, ps, ef_modules, ef_cons_defs, cs_error) + = unfoldPatternMacro macro mod_index args opt_var ps ef_modules ef_cons_defs cs_error + = (pattern, ps, { e_info & ef_modules = ef_modules, ef_macro_defs=ef_macro_defs, ef_cons_defs = ef_cons_defs }, { cs & cs_error = cs_error }) + # (macro,ps) = ps!ps_fun_defs.[glob_object.ds_index] + # (pattern, ps, ef_modules, ef_cons_defs, cs_error) + = unfoldPatternMacro macro mod_index args opt_var ps ef_modules ef_cons_defs cs_error + = (pattern, ps, { e_info & ef_modules = ef_modules, ef_macro_defs=ef_macro_defs, ef_cons_defs = ef_cons_defs }, { cs & cs_error = cs_error }) getPredefinedGlobalSymbol :: !Index !Index !STE_Kind !Int !*CheckState -> (!Global DefinedSymbol, !*CheckState) getPredefinedGlobalSymbol symb_index module_index req_ste_kind arity cs=:{cs_predef_symbols,cs_symbol_table} diff --git a/frontend/checksupport.dcl b/frontend/checksupport.dcl index 5057176..c96b9f7 100644 --- a/frontend/checksupport.dcl +++ b/frontend/checksupport.dcl @@ -41,23 +41,21 @@ cConstructorDefs :== 1 cSelectorDefs :== 2 cClassDefs :== 3 cMemberDefs :== 4 -cGenericDefs :== 5 // AA +cGenericDefs :== 5 cInstanceDefs :== 6 cFunctionDefs :== 7 cMacroDefs :== 8 -cConversionTableSize :== 9 // AA +cConversionTableSize :== 9 :: CommonDefs = { com_type_defs :: !.{# CheckedTypeDef} -// , com_unexpanded_type_defs :: !{# CheckedTypeDef} , com_cons_defs :: !.{# ConsDef} , com_selector_defs :: !.{# SelectorDef} , com_class_defs :: !.{# ClassDef} , com_member_defs :: !.{# MemberDef} , com_instance_defs :: !.{# ClassInstance} -// , com_instance_types :: !.{ SymbolType} - , com_generic_defs :: !.{# GenericDef} // AA + , com_generic_defs :: !.{# GenericDef} } :: Declarations = { @@ -88,7 +86,8 @@ cConversionTableSize :== 9 // AA :: IclModule = { icl_name :: !Ident , icl_functions :: !.{# FunDef } - , icl_instances :: !IndexRange + , icl_global_functions :: ![IndexRange] + , icl_instances :: ![IndexRange] , icl_specials :: !IndexRange , icl_common :: !.CommonDefs , icl_import :: !{!Declaration} @@ -108,15 +107,16 @@ cConversionTableSize :== 9 // AA , dcl_specials :: !IndexRange , dcl_common :: !CommonDefs , dcl_sizes :: !{# Int} + , dcl_dictionary_info :: !DictionaryInfo , dcl_declared :: !Declarations - , dcl_conversions :: !Optional ConversionTable -// RWS ... , dcl_is_system :: !Bool + , dcl_macro_conversions :: !Optional {#Index} , dcl_module_kind :: !ModuleKind , dcl_modification_time:: !{#Char} -// ... RWS , dcl_imported_module_numbers :: !NumberSet } +:: DictionaryInfo = { n_dictionary_types :: !Int, n_dictionary_constructors :: !Int, n_dictionary_selectors :: !Int } + class Erroradmin state where pushErrorAdmin :: !IdentPos *state -> *state @@ -149,30 +149,32 @@ instance <<< IdentPos, ExplImpInfo, DeclarationInfo , ef_cons_defs :: !.{# ConsDef} , ef_member_defs :: !.{# MemberDef} , ef_class_defs :: !.{# ClassDef} - , ef_generic_defs :: !.{# GenericDef} // AA + , ef_generic_defs :: !.{# GenericDef} , ef_modules :: !.{# DclModule} + , ef_macro_defs :: !.{#.{#FunDef}} , ef_is_macro_fun :: !Bool } -convertIndex :: !Index !Index !(Optional ConversionTable) -> !Index +//convertIndex :: !Index !Index !(Optional ConversionTable) -> !Index retrieveGlobalDefinition :: !SymbolTableEntry !STE_Kind !Index -> (!Index, !Index) -//retrieveAndRemoveImportsFromSymbolTable :: !Index ![(.a,.Declarations)] !Int ![Declaration] !*ExplImpInfos !*(Heap SymbolTableEntry) -// -> (!Int, ![Declaration], !.ExplImpInfos, !.Heap SymbolTableEntry); + addLocalFunctionDefsToSymbolTable :: !Level !Index !Index !Bool !*{#FunDef} !*SymbolTable !*ErrorAdmin -> (!*{# FunDef}, !*SymbolTable, !*ErrorAdmin) +addLocalDclMacroDefsToSymbolTable :: !Level !Int !Index !Index !*{#*{#FunDef}} !*SymbolTable !*ErrorAdmin -> (!*{#*{#FunDef}}, !*SymbolTable, !*ErrorAdmin) addDefToSymbolTable :: !Level !Index !Ident !STE_Kind !*SymbolTable !*ErrorAdmin -> (!* SymbolTable, !*ErrorAdmin) addDeclarationsOfDclModToSymbolTable :: .Int !{!Declaration} !{!Declaration} !*CheckState -> .CheckState; addGlobalDefinitionsToSymbolTable :: ![Declaration] !*CheckState -> .CheckState; addSymbol :: !(Optional a) !Ident !Position !STE_Kind !STE_Kind !.Int !.Int !Int !*CheckState -> (!Bool, !.CheckState) addImportedFunctionOrMacro :: !(Optional IndexRange) !Ident !Int !*CheckState -> (!Bool, !.CheckState) + removeImportedSymbolsFromSymbolTable :: Declaration !*SymbolTable -> .SymbolTable removeFieldFromSelectorDefinition :: !Ident .Int .Int !*(Heap SymbolTableEntry) -> .Heap SymbolTableEntry; removeDeclarationsFromSymbolTable :: ![Declaration] !Int !*SymbolTable -> *SymbolTable removeLocalIdentsFromSymbolTable :: .Int !.[Ident] !*(Heap SymbolTableEntry) -> .Heap SymbolTableEntry; removeIdentFromSymbolTable :: !.Int !Ident !*(Heap SymbolTableEntry) -> .Heap SymbolTableEntry; removeImportsAndLocalsOfModuleFromSymbolTable :: !Declarations !*(Heap SymbolTableEntry) -> .Heap SymbolTableEntry -removeLocalsFromSymbolTable :: !Level ![Ident] !LocalDefs !u:{# FunDef} !*(Heap SymbolTableEntry) - -> (!u:{# FunDef}, !.Heap SymbolTableEntry) +removeLocalFunctionsFromSymbolTable :: !Level !IndexRange !*{# FunDef} !*(Heap SymbolTableEntry) -> (!.{# FunDef}, !.Heap SymbolTableEntry) +removeLocalDclMacrosFromSymbolTable :: !Level !Index !IndexRange !*{#*{#FunDef}} !*(Heap SymbolTableEntry) -> (!.{#.{#FunDef}}, !.Heap SymbolTableEntry) newFreeVariable :: !FreeVar ![FreeVar] ->(!Bool, ![FreeVar]) diff --git a/frontend/checksupport.icl b/frontend/checksupport.icl index 49f2d07..d63ade8 100644 --- a/frontend/checksupport.icl +++ b/frontend/checksupport.icl @@ -3,7 +3,6 @@ implementation module checksupport import StdEnv, compare_constructor import syntax, predef, containers import utilities -from check import checkFunctions //import RWSDebug @@ -60,6 +59,7 @@ where toInt (STE_Instance _) = cInstanceDefs toInt STE_DclFunction = cFunctionDefs toInt (STE_FunctionOrMacro _) = cMacroDefs + toInt (STE_DclMacroOrLocalMacroFunction _)= cMacroDefs toInt _ = NoIndex :: CommonDefs = @@ -101,7 +101,8 @@ where :: IclModule = { icl_name :: !Ident , icl_functions :: !.{# FunDef } - , icl_instances :: !IndexRange + , icl_global_functions :: ![IndexRange] + , icl_instances :: ![IndexRange] , icl_specials :: !IndexRange , icl_common :: !.CommonDefs , icl_import :: !{!Declaration} @@ -121,15 +122,16 @@ where , dcl_specials :: !IndexRange , dcl_common :: !CommonDefs , dcl_sizes :: !{# Int} + , dcl_dictionary_info :: !DictionaryInfo , dcl_declared :: !Declarations - , dcl_conversions :: !Optional ConversionTable -// RWS ... , dcl_is_system :: !Bool + , dcl_macro_conversions :: !Optional {#Index} , dcl_module_kind :: !ModuleKind , dcl_modification_time:: !{#Char} -// ... RWS , dcl_imported_module_numbers :: !NumberSet } +:: DictionaryInfo = { n_dictionary_types :: !Int, n_dictionary_constructors :: !Int, n_dictionary_selectors :: !Int } + class Erroradmin state // PK... where pushErrorAdmin :: !IdentPos *state -> *state @@ -221,16 +223,19 @@ where , ef_cons_defs :: !.{# ConsDef} , ef_member_defs :: !.{# MemberDef} , ef_class_defs :: !.{# ClassDef} - , ef_generic_defs :: !.{# GenericDef} // AA + , ef_generic_defs :: !.{# GenericDef} , ef_modules :: !.{# DclModule} + , ef_macro_defs :: !.{#.{#FunDef}} , ef_is_macro_fun :: !Bool } +/* convertIndex :: !Index !Index !(Optional ConversionTable) -> !Index convertIndex index table_index (Yes tables) = tables.[table_index].[index] convertIndex index table_index No = index +*/ retrieveGlobalDefinition :: !SymbolTableEntry !STE_Kind !Index -> (!Index, !Index) retrieveGlobalDefinition {ste_kind = STE_Imported kind decl_index, ste_def_level, ste_index} requ_kind mod_index @@ -317,6 +322,15 @@ addLocalFunctionDefsToSymbolTable level from_index to_index is_macro_fun fun_def = addLocalFunctionDefsToSymbolTable level (inc from_index) to_index is_macro_fun fun_defs symbol_table error = addLocalFunctionDefsToSymbolTable level (inc from_index) to_index is_macro_fun fun_defs symbol_table error +addLocalDclMacroDefsToSymbolTable :: !Level !Int !Index !Index !*{#*{#FunDef}} !*SymbolTable !*ErrorAdmin -> (!*{#*{#FunDef}}, !*SymbolTable, !*ErrorAdmin) +addLocalDclMacroDefsToSymbolTable level module_index from_index to_index macro_defs symbol_table error + | from_index == to_index + = (macro_defs, symbol_table, error) + # (macro_def, macro_defs) = macro_defs![module_index,from_index] + # (symbol_table, error) = addDefToSymbolTable level from_index macro_def.fun_symb (STE_DclMacroOrLocalMacroFunction []) symbol_table error + # macro_defs = {macro_defs & [module_index].[from_index].fun_info.fi_properties = macro_def.fun_info.fi_properties bitor FI_IsMacroFun } + = addLocalDclMacroDefsToSymbolTable level module_index (inc from_index) to_index macro_defs symbol_table error + NewEntry symbol_table symb_ptr def_kind def_index level previous :== symbol_table <:= (symb_ptr,{ ste_kind = def_kind, ste_index = def_index, ste_def_level = level, ste_previous = previous }) @@ -498,21 +512,33 @@ removeIdentFromSymbolTable level {id_name,id_info} symbol_table = symbol_table <:= (id_info,ste_previous) // ---> ("removeIdentFromSymbolTable", id_name) = symbol_table // ---> ("NO removeIdentFromSymbolTable", id_name) -removeLocalsFromSymbolTable :: !Level ![Ident] !LocalDefs !u:{# FunDef} !*(Heap SymbolTableEntry) - -> (!u:{# FunDef}, !.Heap SymbolTableEntry) -removeLocalsFromSymbolTable level loc_vars (CollectedLocalDefs {loc_functions={ir_from,ir_to}}) defs symbol_table - = remove_defs_from_symbol_table level ir_from ir_to defs (removeLocalIdentsFromSymbolTable level loc_vars symbol_table) +removeLocalDclMacrosFromSymbolTable :: !Level !Index !IndexRange !*{#*{#FunDef}} !*(Heap SymbolTableEntry) -> (!.{#.{#FunDef}}, !.Heap SymbolTableEntry) +removeLocalDclMacrosFromSymbolTable level module_index {ir_from,ir_to} defs symbol_table + = remove_macro_defs_from_symbol_table level ir_from ir_to defs symbol_table where - remove_defs_from_symbol_table level from_index to_index defs symbol_table + remove_macro_defs_from_symbol_table level from_index to_index defs symbol_table + | from_index == to_index + = (defs, symbol_table) + #! def = defs.[module_index,from_index] + id_info = (toIdent def).id_info + entry = sreadPtr id_info symbol_table + | level == entry.ste_def_level + = remove_macro_defs_from_symbol_table level (inc from_index) to_index defs (symbol_table <:= (id_info, entry.ste_previous)) + = remove_macro_defs_from_symbol_table level (inc from_index) to_index defs symbol_table + +removeLocalFunctionsFromSymbolTable :: !Level !IndexRange !*{# FunDef} !*(Heap SymbolTableEntry) -> (!.{# FunDef}, !.Heap SymbolTableEntry) +removeLocalFunctionsFromSymbolTable level {ir_from,ir_to} defs symbol_table + = remove_fun_defs_from_symbol_table level ir_from ir_to defs symbol_table +where + remove_fun_defs_from_symbol_table level from_index to_index defs symbol_table | from_index == to_index = (defs, symbol_table) #! def = defs.[from_index] id_info = (toIdent def).id_info # (entry, symbol_table) = readPtr id_info symbol_table | level == entry.ste_def_level - = remove_defs_from_symbol_table level (inc from_index) to_index defs (symbol_table <:= (id_info, entry.ste_previous)) - = remove_defs_from_symbol_table level (inc from_index) to_index defs symbol_table - + = remove_fun_defs_from_symbol_table level (inc from_index) to_index defs (symbol_table <:= (id_info, entry.ste_previous)) + = remove_fun_defs_from_symbol_table level (inc from_index) to_index defs symbol_table newFreeVariable :: !FreeVar ![FreeVar] ->(!Bool, ![FreeVar]) newFreeVariable new_var vars=:[free_var=:{fv_def_level,fv_info_ptr}: free_vars] @@ -601,7 +627,9 @@ where instance == STE_Kind where (==) (STE_FunctionOrMacro _) STE_DclFunction = True + (==) (STE_FunctionOrMacro _) (STE_DclMacroOrLocalMacroFunction _) = True (==) STE_DclFunction (STE_FunctionOrMacro _) = True + (==) (STE_DclMacroOrLocalMacroFunction _) (STE_FunctionOrMacro _) = True (==) sk1 sk2 = equal_constructor sk1 sk2 instance <<< IdentPos diff --git a/frontend/checktypes.dcl b/frontend/checktypes.dcl index a228699..1baadf1 100644 --- a/frontend/checktypes.dcl +++ b/frontend/checktypes.dcl @@ -20,7 +20,7 @@ checkSuperClasses :: ![TypeVar] ![TypeContext] !Index !u:{# CheckedTypeDef} !v:{ checkDynamicTypes :: !Index ![ExprInfoPtr] !(Optional SymbolType) !u:{# CheckedTypeDef} !u:{# DclModule} !*TypeHeaps !*ExpressionHeap !*CheckState -> (!u:{# CheckedTypeDef}, !u:{# DclModule}, !*TypeHeaps, !*ExpressionHeap, !*CheckState) -createClassDictionaries :: !Index !*{#ClassDef} !u:{#.DclModule} !Index !Index !Index !*TypeVarHeap !*VarHeap !*SymbolTable - -> (!*{#ClassDef}, !u:{#DclModule}, ![CheckedTypeDef], ![SelectorDef], ![ConsDef], !*TypeVarHeap, !*VarHeap, !*SymbolTable) +createClassDictionaries :: !Bool !Index !Index !Index !Index !*{#CheckedTypeDef} !*{# SelectorDef} !*{# ConsDef} !*{#ClassDef} !*{#DclModule} !*TypeVarHeap !*VarHeap !*SymbolTable + -> (![CheckedTypeDef],![SelectorDef],![ConsDef],!DictionaryInfo,!*{#CheckedTypeDef},!*{# SelectorDef},!*{# ConsDef},!*{#ClassDef},!*{#DclModule},!*TypeVarHeap,!*VarHeap,!*SymbolTable) removeVariablesFromSymbolTable :: !Int ![TypeVar] !*SymbolTable -> *SymbolTable diff --git a/frontend/checktypes.icl b/frontend/checktypes.icl index b738b5c..d3bff5a 100644 --- a/frontend/checktypes.icl +++ b/frontend/checktypes.icl @@ -388,9 +388,8 @@ getTypeDef type_index type_module module_index type_defs modules | type_module == module_index # (type_def, type_defs) = type_defs![type_index] = (type_def, type_index, type_defs, modules) - # ({dcl_common={com_type_defs},dcl_conversions}, modules) = modules![type_module] + # ({dcl_common={com_type_defs}}, modules) = modules![type_module] type_def = com_type_defs.[type_index] - type_index = convertIndex type_index (toInt STE_Type) dcl_conversions = (type_def, type_index, type_defs, modules) checkArityOfType act_arity form_arity (SynType _) @@ -404,9 +403,8 @@ getClassDef class_index type_module module_index class_defs modules #! si = size class_defs # (class_def, class_defs) = class_defs![class_index] = (class_def, class_index, class_defs, modules) - # ({dcl_common={com_class_defs},dcl_conversions}, modules) = modules![type_module] + # ({dcl_common={com_class_defs}}, modules) = modules![type_module] class_def = com_class_defs.[class_index] - class_index = convertIndex class_index (toInt STE_Class) dcl_conversions = (class_def, class_index, class_defs, modules) getGenericDef :: !Index !Index !Index !u:{# GenericDef} !v:{# DclModule} -> (!GenericDef, !Index , !u:{# GenericDef}, !v:{# DclModule}) @@ -415,9 +413,8 @@ getGenericDef generic_index type_module module_index generic_defs modules #! si = size generic_defs # (generic_def, generic_defs) = generic_defs![generic_index] = (generic_def, generic_index, generic_defs, modules) - # ({dcl_common={com_generic_defs},dcl_conversions}, modules) = modules![type_module] + # ({dcl_common={com_generic_defs}}, modules) = modules![type_module] generic_def = com_generic_defs.[generic_index] - generic_index = convertIndex generic_index (toInt STE_Generic) dcl_conversions = (generic_def, generic_index, generic_defs, modules) checkTypeVar :: !Level !DemandedAttributeKind !TypeVar !TypeAttribute !(!*OpenTypeInfo, !*CheckState) @@ -1196,41 +1193,107 @@ removeVariablesFromSymbolTable scope vars symbol_table makeAttributedType attr annot type :== { at_attribute = attr, at_annotation = annot, at_type = type } -createClassDictionaries :: !Index !*{#ClassDef} !u:{#.DclModule} !Index !Index !Index !*TypeVarHeap !*VarHeap !*SymbolTable - -> (!*{#ClassDef}, !u:{#DclModule}, ![CheckedTypeDef], ![SelectorDef], ![ConsDef], !*TypeVarHeap, !*VarHeap, !*SymbolTable) -createClassDictionaries mod_index class_defs modules first_type_index first_selector_index first_cons_index type_var_heap var_heap symbol_table - # (class_defs, modules, rev_dictionary_list, indexes, type_var_heap, var_heap, symbol_table) - = create_class_dictionaries mod_index 0 class_defs modules [] - { index_type = first_type_index, index_cons= first_cons_index, index_selector = first_selector_index } type_var_heap var_heap symbol_table - (type_defs, sel_defs, cons_defs, symbol_table) = foldSt collect_type_def rev_dictionary_list ([], [], [], symbol_table) - = (class_defs, modules, type_defs, sel_defs, cons_defs, type_var_heap, var_heap, symbol_table) -where +createClassDictionaries :: !Bool !Index !Index !Index !Index !*{#CheckedTypeDef} !*{# SelectorDef} !*{# ConsDef} !*{#ClassDef} !*{#DclModule} !*TypeVarHeap !*VarHeap !*SymbolTable + -> (![CheckedTypeDef],![SelectorDef],![ConsDef],!DictionaryInfo,!*{#CheckedTypeDef},!*{# SelectorDef},!*{# ConsDef},!*{#ClassDef},!*{#DclModule},!*TypeVarHeap,!*VarHeap,!*SymbolTable) +createClassDictionaries is_dcl mod_index first_type_index first_selector_index first_cons_index type_defs selector_defs cons_defs class_defs modules type_var_heap var_heap symbol_table + | is_dcl + # indexes = { index_type = first_type_index, index_cons= first_cons_index, index_selector = first_selector_index } + # (class_defs, modules, rev_dictionary_list, indexes, type_var_heap, var_heap, symbol_table) + = create_class_dictionaries mod_index 0 class_defs modules [] indexes type_var_heap var_heap symbol_table + (type_def_list, sel_def_list, cons_def_list, symbol_table) = foldSt collect_type_def rev_dictionary_list ([], [], [], symbol_table) + dictionary_info = { n_dictionary_types = indexes.index_type-first_type_index, + n_dictionary_constructors = indexes.index_cons-first_cons_index, + n_dictionary_selectors = indexes.index_selector-first_selector_index + } + = (type_def_list, sel_def_list, cons_def_list, dictionary_info, type_defs, selector_defs, cons_defs, class_defs, modules, type_var_heap, var_heap, symbol_table) + + # (dcl_class_defs,modules) = modules![mod_index].dcl_common.com_class_defs + + #! first_dcl_dictionary_cons_index = modules.[mod_index].dcl_sizes.[cConstructorDefs] + #! first_dcl_dictionary_selector_index = modules.[mod_index].dcl_sizes.[cSelectorDefs] + + # indexes = { index_type = first_type_index, index_cons = first_dcl_dictionary_cons_index, index_selector = first_dcl_dictionary_selector_index } + # (type_defs, class_defs, modules, rev_dictionary_list, indexes, type_var_heap, var_heap, symbol_table) + = create_exported_icl_class_dictionaries mod_index 0 dcl_class_defs type_defs class_defs modules [] indexes type_var_heap var_heap symbol_table + + # indexes = { index_type = first_type_index, index_cons= first_cons_index, index_selector = first_selector_index } + # (class_defs, modules, rev_dictionary_list, indexes, type_var_heap, var_heap, symbol_table) + = create_icl_class_dictionaries mod_index 0 class_defs modules rev_dictionary_list indexes type_var_heap var_heap symbol_table + + # (size_type_defs,type_defs) = usize type_defs + (type_def_list, sel_def_list, cons_def_list, selector_defs, cons_defs, symbol_table) + = foldSt (collect_type_def_in_icl_module size_type_defs) rev_dictionary_list ([], [], [], selector_defs, cons_defs, symbol_table) + # (dictionary_info,modules)=modules![mod_index].dcl_dictionary_info + = (type_def_list, sel_def_list, cons_def_list, dictionary_info, type_defs, selector_defs, cons_defs, class_defs, modules, type_var_heap, var_heap, symbol_table) +where collect_type_def type_ptr (type_defs, sel_defs, cons_defs, symbol_table) # ({ ste_kind = STE_DictType type_def }, symbol_table) = readPtr type_ptr symbol_table (RecordType {rt_constructor, rt_fields}) = type_def.td_rhs ({ ste_kind = STE_DictCons cons_def }, symbol_table) = readPtr rt_constructor.ds_ident.id_info symbol_table (sel_defs, symbol_table) = collect_fields 0 rt_fields (sel_defs, symbol_table) = ( [type_def : type_defs ] , sel_defs, [cons_def : cons_defs], symbol_table) - where - collect_fields field_nr fields (sel_defs, symbol_table) - | field_nr < size fields - # (sel_defs, symbol_table) = collect_fields (inc field_nr) fields (sel_defs, symbol_table) - ({ ste_kind = STE_DictField sel_def }, symbol_table) = readPtr fields.[field_nr].fs_name.id_info symbol_table - = ( [ sel_def : sel_defs ], symbol_table) - = ( sel_defs, symbol_table) - + + collect_type_def_in_icl_module size_type_defs type_ptr (type_defs, sel_def_list, cons_def_list, selector_defs, cons_defs, symbol_table) + # ({ ste_kind = STE_DictType type_def,ste_index}, symbol_table) = readPtr type_ptr symbol_table + (RecordType {rt_constructor, rt_fields}) = type_def.td_rhs + ({ ste_kind = STE_DictCons cons_def }, symbol_table) = readPtr rt_constructor.ds_ident.id_info symbol_table + | ste_index < size_type_defs + # cons_defs = {cons_defs & [rt_constructor.ds_index] = cons_def} + # (selector_defs, symbol_table) = store_fields_in_selector_array 0 rt_fields (selector_defs, symbol_table) + = (type_defs , sel_def_list, cons_def_list, selector_defs, cons_defs, symbol_table) + # (sel_def_list, symbol_table) = collect_fields 0 rt_fields (sel_def_list, symbol_table) + = ([type_def : type_defs ] , sel_def_list, [cons_def : cons_def_list], selector_defs, cons_defs, symbol_table) + + collect_fields field_nr fields (sel_defs, symbol_table) + | field_nr < size fields + # (sel_defs, symbol_table) = collect_fields (inc field_nr) fields (sel_defs, symbol_table) + ({ ste_kind = STE_DictField sel_def }, symbol_table) = readPtr fields.[field_nr].fs_name.id_info symbol_table + = ( [ sel_def : sel_defs ], symbol_table) + = ( sel_defs, symbol_table) + + store_fields_in_selector_array field_nr fields (sel_defs, symbol_table) + | field_nr < size fields + # field = fields.[field_nr] + # ({ ste_kind = STE_DictField sel_def }, symbol_table) = readPtr field.fs_name.id_info symbol_table + # sel_defs = {sel_defs & [field.fs_index] = sel_def } + = store_fields_in_selector_array (inc field_nr) fields (sel_defs, symbol_table) + = ( sel_defs, symbol_table) + create_class_dictionaries mod_index class_index class_defs modules rev_dictionary_list indexes type_var_heap var_heap cs | class_index < size class_defs - # (class_defs, modules, rev_dictionary_list, indexes, type_var_heap, var_heap, cs) = - create_class_dictionary mod_index class_index class_defs modules rev_dictionary_list indexes type_var_heap var_heap cs + # (class_defs, modules, type_id_info, indexes, type_var_heap, var_heap, cs) + = create_class_dictionary mod_index class_index class_defs modules indexes type_var_heap var_heap cs + # rev_dictionary_list = [ type_id_info : rev_dictionary_list ] = create_class_dictionaries mod_index (inc class_index) class_defs modules rev_dictionary_list indexes type_var_heap var_heap cs - = (class_defs, modules, rev_dictionary_list, indexes, type_var_heap, var_heap, cs) - - create_class_dictionary :: !Index !Index !*{#ClassDef} !w:{#DclModule} !v:[SymbolPtr] !u:Indexes !*TypeVarHeap !*VarHeap !*SymbolTable - -> (!*{#ClassDef}, !w:{#DclModule}, !v:[SymbolPtr], !u:Indexes, !*TypeVarHeap, !*VarHeap, !*SymbolTable) - create_class_dictionary mod_index class_index class_defs =:{[class_index] = class_def } modules rev_dictionary_list - indexes type_var_heap var_heap symbol_table - # {class_name,class_args,class_arity,class_members,class_context,class_dictionary=ds=:{ds_ident={id_name}}} = class_def + = (class_defs, modules, rev_dictionary_list, indexes, type_var_heap, var_heap, cs) + + create_exported_icl_class_dictionaries mod_index dcl_class_index dcl_class_defs type_defs class_defs modules rev_dictionary_list indexes type_var_heap var_heap symbol_table + | dcl_class_index < size dcl_class_defs + # icl_class_index = dcl_class_index + # dcl_dictionary_index = dcl_class_defs.[dcl_class_index].class_dictionary.ds_index + # indexes = {indexes & index_type=dcl_dictionary_index} + # (class_defs, modules, type_id_info, indexes, type_var_heap, var_heap, symbol_table) + = create_class_dictionary mod_index icl_class_index class_defs modules indexes type_var_heap var_heap symbol_table + # ({ ste_kind = STE_DictType type_def }, symbol_table) = readPtr type_id_info symbol_table + # type_defs = {type_defs & [type_def.td_index]=type_def} + # rev_dictionary_list = [ type_id_info : rev_dictionary_list ] + = create_exported_icl_class_dictionaries mod_index (inc dcl_class_index) dcl_class_defs type_defs class_defs modules rev_dictionary_list indexes type_var_heap var_heap symbol_table + = (type_defs, class_defs, modules, rev_dictionary_list, indexes, type_var_heap, var_heap, symbol_table) + + create_icl_class_dictionaries mod_index class_index class_defs modules rev_dictionary_list indexes type_var_heap var_heap symbol_table + | class_index < size class_defs + | class_defs.[class_index].class_dictionary.ds_index==NoIndex + # (class_defs, modules, type_id_info, indexes, type_var_heap, var_heap, symbol_table) + = create_class_dictionary mod_index class_index class_defs modules indexes type_var_heap var_heap symbol_table + # rev_dictionary_list = [ type_id_info : rev_dictionary_list ] + = create_icl_class_dictionaries mod_index (inc class_index) class_defs modules rev_dictionary_list indexes type_var_heap var_heap symbol_table + = create_icl_class_dictionaries mod_index (inc class_index) class_defs modules rev_dictionary_list indexes type_var_heap var_heap symbol_table + = (class_defs, modules, rev_dictionary_list, indexes, type_var_heap, var_heap, symbol_table) + + create_class_dictionary :: !Index !Index !*{#ClassDef} !w:{#DclModule} !u:Indexes !*TypeVarHeap !*VarHeap !*SymbolTable + -> (!*{#ClassDef}, !w:{#DclModule}, !SymbolPtr, !u:Indexes, !*TypeVarHeap, !*VarHeap, !*SymbolTable) + create_class_dictionary mod_index class_index class_defs =:{[class_index] = class_def } modules indexes type_var_heap var_heap symbol_table + # {class_name,class_args,class_arity,class_members,class_context,class_dictionary=ds=:{ds_ident={id_name,id_info}}} = class_def # (type_id_info, symbol_table) = newPtr EmptySymbolTableEntry symbol_table nr_of_members = size class_members nr_of_fields = nr_of_members + length class_context @@ -1257,7 +1320,6 @@ where (td_args, type_var_heap) = mapSt new_attributed_type_variable class_args type_var_heap - type_def = { td_name = rec_type_id , td_index = index_type @@ -1285,7 +1347,7 @@ where } = ({ class_defs & [class_index] = { class_def & class_dictionary = { class_dictionary & ds_index = index_type }}}, modules, - [ type_id_info : rev_dictionary_list ], { index_type = inc index_type, index_cons = inc index_cons, index_selector = index_selector }, + type_id_info, { index_type = inc index_type, index_cons = inc index_cons, index_selector = index_selector }, type_var_heap, var_heap, symbol_table <:= (type_id_info, { ste_kind = STE_DictType type_def, ste_index = index_type, ste_def_level = NotALevel, ste_previous = abort "empty SymbolTableEntry" }) diff --git a/frontend/comparedefimp.dcl b/frontend/comparedefimp.dcl index b371c14..15d59ca 100644 --- a/frontend/comparedefimp.dcl +++ b/frontend/comparedefimp.dcl @@ -4,8 +4,8 @@ import syntax, checksupport // compare definition and implementation module -compareDefImp :: !{#Int} !{!FunctionBody} !Int !DclModule !*IclModule !*Heaps !*ErrorAdmin - -> (!.IclModule,!.Heaps,!.ErrorAdmin) +compareDefImp :: /*!{#Int}*/ !Int !DclModule !Int !*IclModule !*{#*{#FunDef}} !*Heaps !*ErrorAdmin + -> (!.IclModule,!.{#.{#FunDef}},!.Heaps,!.ErrorAdmin) symbolTypesCorrespond :: !SymbolType !SymbolType !*TypeHeaps -> (!ComparisionErrorCode, !.TypeHeaps) diff --git a/frontend/comparedefimp.icl b/frontend/comparedefimp.icl index 466f07c..1d5c92e 100644 --- a/frontend/comparedefimp.icl +++ b/frontend/comparedefimp.icl @@ -309,38 +309,24 @@ where = attr_var_heap <:= (av_info_ptr, AVI_Empty) :: TypesCorrespondState = - { tc_type_vars - :: !.HeapWithNumber TypeVarInfo - , tc_attr_vars - :: !.HeapWithNumber AttrVarInfo - , tc_ignore_strictness - :: !Bool + { tc_type_vars :: !.HeapWithNumber TypeVarInfo + , tc_attr_vars :: !.HeapWithNumber AttrVarInfo + , tc_ignore_strictness :: !Bool } :: TypesCorrespondMonad :== !*TypesCorrespondState -> *(!Bool, !*TypesCorrespondState) :: ExpressionsCorrespondState = - { ec_correspondences // ec_correspondences.[i]==j <=> (functions i and j are already compared - :: !.{# Int } // || j==cNoCorrespondence) - , ec_var_heap - :: !.HeapWithNumber VarInfo - , ec_expr_heap - :: !.ExpressionHeap - , ec_icl_functions - :: !.{# FunDef } - , ec_error_admin - :: !.ErrorAdmin - , ec_tc_state - :: !.TypesCorrespondState - , ec_untransformed - :: !{! FunctionBody } - , ec_function_conversions - :: !Conversions - , ec_main_dcl_module_n - :: !Int - , ec_dcl_macro_range - :: !IndexRange + { ec_icl_correspondences :: !.{# Int }, + ec_dcl_correspondences :: !.{# Int } + , ec_var_heap :: !.HeapWithNumber VarInfo + , ec_expr_heap :: !.ExpressionHeap + , ec_icl_functions :: !.{#FunDef} + , ec_macro_defs :: !.{#.{#FunDef}} + , ec_error_admin :: !.ErrorAdmin + , ec_tc_state :: !.TypesCorrespondState + , ec_main_dcl_module_n :: !Int } :: ExpressionsCorrespondMonad @@ -349,10 +335,8 @@ where :: Conversions :== {#Index} :: HeapWithNumber a - = { hwn_heap - :: !.Heap a - , hwn_number - :: !Int + = { hwn_heap :: !.Heap a + , hwn_number :: !Int } :: OptionalCorrespondenceNumber = CorrespondenceNumber !Int | Unbound @@ -366,9 +350,9 @@ CEC_ContextNotOK :== -3 CEC_AttrEnvNotOK :== -4 class t_corresponds a :: !a !a -> *TypesCorrespondMonad - // whether two types correspond class e_corresponds a :: !a !a -> ExpressionsCorrespondMonad // check for correspondence of expressions + // whether two types correspond class getIdentPos a :: a -> IdentPos @@ -378,136 +362,78 @@ class CorrespondenceNumber a where initial_hwn hwn_heap = { hwn_heap = hwn_heap, hwn_number = 0 } -compareDefImp :: !{#Int} !{!FunctionBody} !Int !DclModule !*IclModule !*Heaps !*ErrorAdmin - -> (!.IclModule,!.Heaps,!.ErrorAdmin) -compareDefImp size_uncopied_icl_defs untransformed main_dcl_module_n main_dcl_module - icl_module heaps error_admin - - = case main_dcl_module.dcl_conversions of - No -> (icl_module, heaps, error_admin) - Yes conversion_table - # {dcl_functions, dcl_macros, dcl_common} = main_dcl_module - {icl_common, icl_functions, icl_copied_from_dcl = {copied_type_defs,copied_class_defs}} - = icl_module - {hp_var_heap, hp_expression_heap, hp_type_heaps={th_vars, th_attrs}} - = heaps - { com_cons_defs=icl_com_cons_defs, com_type_defs = icl_com_type_defs, - com_selector_defs=icl_com_selector_defs, com_class_defs = icl_com_class_defs, - com_member_defs=icl_com_member_defs, com_instance_defs = icl_com_instance_defs } - = icl_common - comp_st - = { comp_type_var_heap = th_vars - , comp_attr_var_heap = th_attrs - , comp_error = error_admin - } - - (icl_com_type_defs, icl_com_cons_defs, comp_st) - = compareTypeDefs main_dcl_module.dcl_sizes copied_type_defs dcl_common.com_type_defs dcl_common.com_cons_defs - icl_com_type_defs icl_com_cons_defs comp_st - (icl_com_class_defs, icl_com_member_defs, comp_st) - = compareClassDefs main_dcl_module.dcl_sizes copied_class_defs dcl_common.com_class_defs dcl_common.com_member_defs - icl_com_class_defs icl_com_member_defs comp_st - - (icl_com_instance_defs, comp_st) - = compareInstanceDefs main_dcl_module.dcl_sizes dcl_common.com_instance_defs icl_com_instance_defs comp_st - +compareDefImp :: !Int !DclModule !Int !*IclModule !*{#*{#FunDef}} !*Heaps !*ErrorAdmin + -> (!.IclModule,!.{#.{#FunDef}},!.Heaps,!.ErrorAdmin) +compareDefImp main_dcl_module_n main_dcl_module=:{dcl_macro_conversions=No} n_exported_global_functions icl_module macro_defs heaps error_admin + = (icl_module, macro_defs,heaps, error_admin) +compareDefImp main_dcl_module_n main_dcl_module=:{dcl_macro_conversions=Yes macro_conversion_table} n_exported_global_functions icl_module macro_defs heaps error_admin +// | print_function_body_array icl_module.icl_functions +// && print_function_body_array macro_defs.[main_dcl_module_n] + + # {dcl_functions,dcl_macros,dcl_common} = main_dcl_module + {icl_common, icl_functions, icl_copied_from_dcl = {copied_type_defs,copied_class_defs}} + = icl_module + {hp_var_heap, hp_expression_heap, hp_type_heaps={th_vars, th_attrs}} + = heaps + { com_cons_defs=icl_com_cons_defs, com_type_defs = icl_com_type_defs, + com_selector_defs=icl_com_selector_defs, com_class_defs = icl_com_class_defs, + com_member_defs=icl_com_member_defs, com_instance_defs = icl_com_instance_defs } + = icl_common + comp_st + = { comp_type_var_heap = th_vars + , comp_attr_var_heap = th_attrs + , comp_error = error_admin + } + + (icl_com_type_defs, icl_com_cons_defs, comp_st) + = compareTypeDefs main_dcl_module.dcl_sizes copied_type_defs dcl_common.com_type_defs dcl_common.com_cons_defs + icl_com_type_defs icl_com_cons_defs comp_st + (icl_com_class_defs, icl_com_member_defs, comp_st) + = compareClassDefs main_dcl_module.dcl_sizes copied_class_defs dcl_common.com_class_defs dcl_common.com_member_defs + icl_com_class_defs icl_com_member_defs comp_st + + (icl_com_instance_defs, comp_st) + = compareInstanceDefs main_dcl_module.dcl_sizes dcl_common.com_instance_defs icl_com_instance_defs comp_st + + { comp_type_var_heap = th_vars, comp_attr_var_heap = th_attrs, comp_error = error_admin } = comp_st -/* - (icl_com_type_defs, tc_state, error_admin) - = compareWithConversions - size_uncopied_icl_defs.[cTypeDefs] conversion_table.[cTypeDefs] -// dcl_common.com_unexpanded_type_defs icl_com_type_defs tc_state error_admin - dcl_common.com_type_defs icl_com_type_defs tc_state error_admin - (icl_com_cons_defs, tc_state, error_admin) - = compareWithConversions - size_uncopied_icl_defs.[cConstructorDefs] conversion_table.[cConstructorDefs] - dcl_common.com_cons_defs icl_com_cons_defs tc_state error_admin - (icl_com_selector_defs, tc_state, error_admin) - = compareWithConversions - size_uncopied_icl_defs.[cSelectorDefs] conversion_table.[cSelectorDefs] - dcl_common.com_selector_defs icl_com_selector_defs tc_state error_admin - (icl_com_class_defs, tc_state, error_admin) - = compareWithConversions - size_uncopied_icl_defs.[cClassDefs] conversion_table.[cClassDefs] - dcl_common.com_class_defs icl_com_class_defs tc_state error_admin - (icl_com_member_defs, tc_state, error_admin) - = compareWithConversions - size_uncopied_icl_defs.[cMemberDefs] conversion_table.[cMemberDefs] - dcl_common.com_member_defs icl_com_member_defs tc_state error_admin - (icl_com_instance_defs, tc_state, error_admin) - = compareWithConversions - size_uncopied_icl_defs.[cInstanceDefs] conversion_table.[cInstanceDefs] - dcl_common.com_instance_defs icl_com_instance_defs tc_state error_admin -*/ - - { comp_type_var_heap = th_vars, comp_attr_var_heap = th_attrs, comp_error = error_admin } = comp_st - - tc_state - = { tc_type_vars = initial_hwn th_vars - , tc_attr_vars = initial_hwn th_attrs - , tc_ignore_strictness = False - } - (icl_functions, hp_var_heap, hp_expression_heap, tc_state, error_admin) - = compareMacrosWithConversion main_dcl_module_n - conversion_table.[cMacroDefs] conversion_table.[cFunctionDefs] - dcl_macros untransformed - icl_functions hp_var_heap hp_expression_heap tc_state error_admin - (icl_functions, tc_state, error_admin) - = compareFunctionTypesWithConversions conversion_table.[cFunctionDefs] - dcl_functions icl_functions tc_state error_admin - { tc_type_vars, tc_attr_vars } - = tc_state - icl_common - = { icl_common & com_cons_defs=icl_com_cons_defs, com_type_defs = icl_com_type_defs, - com_selector_defs=icl_com_selector_defs, com_class_defs=icl_com_class_defs, - com_member_defs=icl_com_member_defs, com_instance_defs = icl_com_instance_defs } - heaps - = { hp_var_heap = hp_var_heap, hp_expression_heap = hp_expression_heap, - hp_type_heaps = { th_vars = tc_type_vars.hwn_heap, th_attrs = tc_attr_vars.hwn_heap}} - -> ({ icl_module & icl_common = icl_common, icl_functions = icl_functions }, - heaps, error_admin ) - -compareWithConversions size_uncopied_icl_defs conversions dclDefs iclDefs tc_state error_admin - = iFoldSt (compareWithConversion size_uncopied_icl_defs conversions dclDefs) 0 (size conversions) - (iclDefs, tc_state, error_admin) - -compareWithConversion :: !Int !{#Int} !(d c) !Int !(!u:(b c), !*TypesCorrespondState, !*ErrorAdmin) - -> (!u:(b c), !.TypesCorrespondState, !.ErrorAdmin) -//1.3 - | Array b & Array d & getIdentPos , select_u , t_corresponds , uselect_u c -//3.1 -/*2.0 - | Array b c & Array d c & t_corresponds, getIdentPos c -0.2*/ -compareWithConversion size_uncopied_icl_defs conversions dclDefs dclIndex (iclDefs, tc_state, error_admin) - # icl_index = conversions.[dclIndex] - | icl_index>=size_uncopied_icl_defs - = (iclDefs, tc_state, error_admin) - # (iclDef, iclDefs) = iclDefs![icl_index] - (corresponds, tc_state) = t_corresponds dclDefs.[dclIndex] iclDef tc_state - | corresponds - = (iclDefs, tc_state, error_admin) - = generate_error error_message iclDef iclDefs tc_state error_admin - -compareFunctionTypesWithConversions conversions dcl_fun_types icl_functions tc_state error_admin - = iFoldSt (compareTwoFunctionTypes conversions dcl_fun_types) 0 (size conversions) - (icl_functions, tc_state, error_admin) - -compareTwoFunctionTypes :: !{#Int} !{#FunType} !Int !*(!u:{#FunDef},!*TypesCorrespondState,!*ErrorAdmin) + tc_state + = { tc_type_vars = initial_hwn th_vars + , tc_attr_vars = initial_hwn th_attrs + , tc_ignore_strictness = False + } + (icl_functions, macro_defs, hp_var_heap, hp_expression_heap, tc_state, error_admin) + = compareMacrosWithConversion main_dcl_module_n macro_conversion_table dcl_macros icl_functions macro_defs hp_var_heap hp_expression_heap tc_state error_admin + (icl_functions, tc_state, error_admin) + = compareFunctionTypes n_exported_global_functions dcl_functions icl_functions tc_state error_admin + { tc_type_vars, tc_attr_vars } + = tc_state + icl_common + = { icl_common & com_cons_defs=icl_com_cons_defs, com_type_defs = icl_com_type_defs, + com_selector_defs=icl_com_selector_defs, com_class_defs=icl_com_class_defs, + com_member_defs=icl_com_member_defs, com_instance_defs = icl_com_instance_defs } + heaps + = { hp_var_heap = hp_var_heap, hp_expression_heap = hp_expression_heap, + hp_type_heaps = { th_vars = tc_type_vars.hwn_heap, th_attrs = tc_attr_vars.hwn_heap}} + = ({ icl_module & icl_common = icl_common, icl_functions = icl_functions },macro_defs,heaps, error_admin ) + +compareFunctionTypes n_exported_global_functions dcl_fun_types icl_functions tc_state error_admin + = iFoldSt (compareTwoFunctionTypes dcl_fun_types) 0 n_exported_global_functions (icl_functions, tc_state, error_admin) + +compareTwoFunctionTypes :: /*!{#Int}*/ !{#FunType} !Int !*(!u:{#FunDef},!*TypesCorrespondState,!*ErrorAdmin) -> (!v:{#FunDef},!.TypesCorrespondState,!.ErrorAdmin) , [u <= v] -compareTwoFunctionTypes conversions dcl_fun_types dclIndex (icl_functions, tc_state, error_admin) - # (fun_def=:{fun_type, fun_priority}, icl_functions) = icl_functions![conversions.[dclIndex]] +compareTwoFunctionTypes /*conversions*/ dcl_fun_types dclIndex (icl_functions, tc_state, error_admin) + # (fun_def=:{fun_type, fun_priority}, icl_functions) = icl_functions![dclIndex] = case fun_type of No -> generate_error "type of exported function is missing" fun_def icl_functions tc_state error_admin Yes icl_symbol_type - # {ft_type=dcl_symbol_type, ft_priority} = dcl_fun_types.[dclIndex] - tc_state - = init_symbol_type_vars dcl_symbol_type icl_symbol_type tc_state + # {ft_type=dcl_symbol_type, ft_priority,ft_symb} = dcl_fun_types.[dclIndex] + # tc_state = init_symbol_type_vars dcl_symbol_type icl_symbol_type tc_state (corresponds, tc_state) = t_corresponds dcl_symbol_type icl_symbol_type tc_state // --->("comparing:", dcl_symbol_type ,icl_symbol_type) | corresponds && fun_priority==ft_priority -> (icl_functions, tc_state, error_admin) - -> generate_error error_message fun_def icl_functions tc_state error_admin + -> generate_error ErrorMessage fun_def icl_functions tc_state error_admin symbolTypesCorrespond :: !SymbolType !SymbolType !*TypeHeaps -> (!ComparisionErrorCode, !.TypeHeaps) symbolTypesCorrespond symbol_type_1 symbol_type_2 type_heaps=:{th_vars, th_attrs} @@ -564,34 +490,33 @@ generate_error message iclDef iclDefs tc_state error_admin error_admin = checkError ident_pos.ip_ident message error_admin = (iclDefs, tc_state, popErrorAdmin error_admin) -compareMacrosWithConversion main_dcl_module_n conversions function_conversions macro_range untransformed - icl_functions var_heap expr_heap tc_state error_admin - #! nr_of_functions = size icl_functions - # correspondences = createArray nr_of_functions cNoCorrespondence - ec_state = { ec_correspondences = correspondences, ec_var_heap = initial_hwn var_heap, - ec_expr_heap = expr_heap, ec_icl_functions = icl_functions, +compareMacrosWithConversion main_dcl_module_n conversions macro_range icl_functions macro_defs var_heap expr_heap tc_state error_admin + #! n_icl_functions = size icl_functions + #! n_dcl_macros_and_functions = size macro_defs.[main_dcl_module_n] + # ec_state = { ec_icl_correspondences = createArray n_icl_functions cNoCorrespondence, + ec_dcl_correspondences = createArray n_dcl_macros_and_functions cNoCorrespondence, + ec_var_heap = initial_hwn var_heap, + ec_expr_heap = expr_heap, ec_icl_functions = icl_functions,ec_macro_defs=macro_defs, ec_error_admin = error_admin, ec_tc_state = tc_state, - ec_untransformed = untransformed, - ec_function_conversions = function_conversions, - ec_main_dcl_module_n = main_dcl_module_n, - ec_dcl_macro_range = macro_range } - ec_state = iFoldSt (compareMacroWithConversion conversions macro_range.ir_from) macro_range.ir_from macro_range.ir_to - ec_state - {ec_icl_functions, ec_var_heap, ec_expr_heap, ec_error_admin, ec_tc_state} = ec_state - = (ec_icl_functions, ec_var_heap.hwn_heap, ec_expr_heap, ec_tc_state, ec_error_admin) - -compareMacroWithConversion conversions ir_from dclIndex ec_state - = compareTwoMacroFuns dclIndex conversions.[dclIndex-ir_from] ec_state - -compareTwoMacroFuns :: !.Int !.Int !*ExpressionsCorrespondState -> .ExpressionsCorrespondState; -compareTwoMacroFuns dclIndex iclIndex - ec_state=:{ec_correspondences, ec_icl_functions, ec_untransformed} - | dclIndex==iclIndex + ec_main_dcl_module_n = main_dcl_module_n } + ec_state = iFoldSt (compareMacroWithConversion conversions macro_range.ir_from) macro_range.ir_from macro_range.ir_to ec_state + with + compareMacroWithConversion conversions ir_from dclIndex ec_state=:{ec_main_dcl_module_n} + = compareTwoMacroFuns ec_main_dcl_module_n dclIndex conversions.[dclIndex-ir_from] ec_state + {ec_icl_functions,ec_macro_defs,ec_var_heap, ec_expr_heap, ec_error_admin, ec_tc_state} = ec_state + = (ec_icl_functions,ec_macro_defs, ec_var_heap.hwn_heap, ec_expr_heap, ec_tc_state, ec_error_admin) + +compareTwoMacroFuns :: !Int !Int !Int !*ExpressionsCorrespondState -> .ExpressionsCorrespondState; +compareTwoMacroFuns macro_module_index dclIndex iclIndex ec_state=:{ec_icl_functions,ec_macro_defs,ec_main_dcl_module_n} + | macro_module_index<>ec_main_dcl_module_n + # (dcl_function,ec_macro_defs) = ec_macro_defs![macro_module_index,dclIndex] + = { ec_state & ec_macro_defs=ec_macro_defs,ec_error_admin = checkErrorWithIdentPos (getIdentPos dcl_function) ErrorMessage ec_state.ec_error_admin } + | iclIndex==NoIndex = ec_state - # (dcl_function, ec_icl_functions) = ec_icl_functions![dclIndex] + # (dcl_function, ec_macro_defs) = ec_macro_defs![macro_module_index,dclIndex] (icl_function, ec_icl_functions) = ec_icl_functions![iclIndex] - ec_correspondences = { ec_correspondences & [dclIndex]=iclIndex, [iclIndex]=dclIndex } - ec_state = { ec_state & ec_correspondences = ec_correspondences, ec_icl_functions = ec_icl_functions } + ec_state = { ec_state & ec_icl_correspondences.[iclIndex]=dclIndex, ec_dcl_correspondences.[dclIndex]=iclIndex, + ec_icl_functions = ec_icl_functions,ec_macro_defs=ec_macro_defs } need_to_be_compared = case (dcl_function.fun_body, icl_function.fun_body) of (TransformedBody _, CheckedBody _) @@ -600,22 +525,14 @@ compareTwoMacroFuns dclIndex iclIndex _ -> True | not need_to_be_compared = ec_state - # adjusted_icl_body - = case (dcl_function.fun_body, icl_function.fun_body) of - (CheckedBody _, TransformedBody _) - // the macro definition in the icl module is has been transformed but not the dcl - // module's definition: use the untransformed icl original for comparision - -> ec_untransformed.[iclIndex] - _ -> icl_function.fun_body - ident_pos = getIdentPos dcl_function + # ident_pos = getIdentPos dcl_function ec_error_admin = pushErrorAdmin ident_pos ec_state.ec_error_admin ec_state = { ec_state & ec_error_admin = ec_error_admin } -// Sjaak : | dcl_function.fun_info.fi_is_macro_fun<>icl_function.fun_info.fi_is_macro_fun || | dcl_function.fun_info.fi_properties bitand FI_IsMacroFun <> icl_function.fun_info.fi_properties bitand FI_IsMacroFun || dcl_function.fun_priority<>icl_function.fun_priority # ec_state = give_error dcl_function.fun_symb ec_state - = { ec_state & ec_error_admin = popErrorAdmin ec_state.ec_error_admin } - # ec_state = e_corresponds dcl_function.fun_body adjusted_icl_body ec_state + = { ec_state & ec_error_admin = popErrorAdmin ec_state.ec_error_admin } + # ec_state = e_corresponds dcl_function.fun_body icl_function.fun_body ec_state = { ec_state & ec_error_admin = popErrorAdmin ec_state.ec_error_admin } instance getIdentPos (TypeDef a) where @@ -1049,7 +966,6 @@ instance e_corresponds Expression where e_corresponds _ _ = give_error "" - instance e_corresponds Let where e_corresponds dclLet iclLet = e_corresponds dclLet.let_strict_binds iclLet.let_strict_binds @@ -1168,7 +1084,7 @@ e_corresponds_VarInfoPtr ident dclPtr iclPtr ec_state=:{ec_var_heap} # (unifiable, ec_var_heap) = tryToUnifyVars dclPtr iclPtr ec_var_heap ec_state = { ec_state & ec_var_heap = ec_var_heap } | not unifiable - = { ec_state & ec_error_admin = checkError ident error_message ec_state.ec_error_admin } + = { ec_state & ec_error_admin = checkError ident ErrorMessage ec_state.ec_error_admin } = ec_state /* e_corresponds_app_symb checks correspondence of the function symbols in an App expression. @@ -1180,15 +1096,7 @@ e_corresponds_app_symb dcl_app_symb=:{symb_name, symb_kind=SK_Function dcl_glob_ ec_state #! main_dcl_module_n = ec_state.ec_main_dcl_module_n | dcl_glob_index.glob_module==main_dcl_module_n && icl_glob_index.glob_module==main_dcl_module_n - # dcl_glob_object = dcl_glob_index.glob_object -/* - is_indeed_a_macro = ec_state.ec_dcl_macro_range.ir_from <= dcl_glob_object - && dcl_glob_object < ec_state.ec_dcl_macro_range.ir_to - | is_indeed_a_macro - = continuation_for_possibly_twice_defined_macros - dcl_app_symb dcl_glob_object icl_app_symb icl_glob_index.glob_object ec_state -*/ - | ec_state.ec_function_conversions.[dcl_glob_object]<>icl_glob_index.glob_object + | dcl_glob_index.glob_object<>icl_glob_index.glob_object = give_error symb_name ec_state = ec_state | dcl_glob_index<>icl_glob_index @@ -1200,42 +1108,40 @@ e_corresponds_app_symb dcl_app_symb=:{symb_name, symb_kind=SK_OverloadedFunction | dcl_glob_index<>icl_glob_index = give_error symb_name ec_state = ec_state -e_corresponds_app_symb dcl_app_symb=:{symb_kind=SK_LocalMacroFunction dcl_index} - icl_app_symb=:{symb_kind=SK_LocalMacroFunction icl_index} - ec_state - = continuation_for_possibly_twice_defined_macros - dcl_app_symb dcl_index icl_app_symb icl_index ec_state -e_corresponds_app_symb dcl_app_symb=:{symb_kind=SK_Macro dcl_glob_index} - icl_app_symb=:{symb_kind=SK_Macro icl_glob_index} - ec_state - = continuation_for_possibly_twice_defined_macros - dcl_app_symb dcl_glob_index.glob_object icl_app_symb icl_glob_index.glob_object ec_state -e_corresponds_app_symb {symb_name=dcl_symb_name, symb_kind=SK_Constructor dcl_glob_index} - {symb_name=icl_symb_name, symb_kind=SK_Constructor icl_glob_index} - ec_state +e_corresponds_app_symb dcl_app_symb=:{symb_kind=SK_DclMacro dcl_glob_index} icl_app_symb=:{symb_kind=SK_IclMacro icl_index} ec_state + = continuation_for_possibly_twice_defined_macros dcl_app_symb dcl_glob_index.glob_module dcl_glob_index.glob_object icl_app_symb icl_index ec_state +e_corresponds_app_symb dcl_app_symb=:{symb_name,symb_kind=SK_DclMacro dcl_glob_index} icl_app_symb=:{symb_kind=SK_DclMacro icl_glob_index} ec_state + | dcl_glob_index==icl_glob_index + = ec_state + = give_error symb_name ec_state +e_corresponds_app_symb dcl_app_symb=:{symb_kind=SK_LocalDclMacroFunction dcl_glob_index} icl_app_symb=:{symb_kind=SK_LocalMacroFunction icl_index} ec_state + = continuation_for_possibly_twice_defined_macros dcl_app_symb dcl_glob_index.glob_module dcl_glob_index.glob_object icl_app_symb icl_index ec_state +e_corresponds_app_symb {symb_name=dcl_symb_name, symb_kind=SK_Constructor dcl_glob_index} {symb_name=icl_symb_name, symb_kind=SK_Constructor icl_glob_index} ec_state | dcl_glob_index.glob_module==icl_glob_index.glob_module && dcl_symb_name.id_name==icl_symb_name.id_name = ec_state - = give_error icl_symb_name ec_state -e_corresponds_app_symb {symb_name} _ ec_state + = give_error icl_symb_name ec_state +//e_corresponds_app_symb {symb_name} _ ec_state +e_corresponds_app_symb {symb_name,symb_kind} {symb_kind=symb_kind2} ec_state = give_error symb_name ec_state -continuation_for_possibly_twice_defined_macros dcl_app_symb dcl_index icl_app_symb icl_index - ec_state - | dcl_index==icl_index +continuation_for_possibly_twice_defined_macros dcl_app_symb dcl_module_index dcl_index icl_app_symb icl_index ec_state + | icl_index==NoIndex = ec_state // two different functions were referenced. In case of macro functions they still could correspond - | not (names_are_compatible dcl_index icl_index ec_state.ec_icl_functions) + | not (names_are_compatible dcl_index icl_index ec_state.ec_icl_functions ec_state.ec_macro_defs) = give_error icl_app_symb.symb_name ec_state - | both_funs_have_not_been_checked_before dcl_index icl_index ec_state.ec_correspondences - // going into recursion is save - = compareTwoMacroFuns dcl_index icl_index ec_state - | both_funs_correspond dcl_index icl_index ec_state.ec_correspondences + | dcl_module_index<>ec_state.ec_main_dcl_module_n + = give_error icl_app_symb.symb_name ec_state + | ec_state.ec_dcl_correspondences.[dcl_index]==icl_index && ec_state.ec_icl_correspondences.[icl_index]==dcl_index = ec_state + | ec_state.ec_dcl_correspondences.[dcl_index]==cNoCorrespondence && ec_state.ec_icl_correspondences.[icl_index]==cNoCorrespondence + // going into recursion is save + = compareTwoMacroFuns dcl_module_index dcl_index icl_index ec_state = give_error icl_app_symb.symb_name ec_state where - names_are_compatible :: Int Int {#FunDef} -> Bool; - names_are_compatible dcl_index icl_index icl_functions - # dcl_function = icl_functions.[dcl_index] + names_are_compatible :: Int Int {#FunDef} {#{#FunDef}} -> Bool; + names_are_compatible dcl_index icl_index icl_functions macro_defs + # dcl_function = macro_defs.[dcl_module_index,dcl_index] icl_function = icl_functions.[icl_index] dcl_name_is_loc_dependent = name_is_location_dependent dcl_function.fun_kind icl_name_is_loc_dependent = name_is_location_dependent icl_function.fun_kind @@ -1243,18 +1149,10 @@ continuation_for_possibly_twice_defined_macros dcl_app_symb dcl_index icl_app_sy && (implies (not dcl_name_is_loc_dependent) (dcl_function.fun_symb.id_name==icl_function.fun_symb.id_name)) // functions that originate from e.g. lambda expressions can correspond although their names differ where - name_is_location_dependent (FK_ImpFunction name_is_loc_dependent) - = name_is_loc_dependent - name_is_location_dependent (FK_DefFunction name_is_loc_dependent) + name_is_location_dependent (FK_Function name_is_loc_dependent) = name_is_loc_dependent name_is_location_dependent _ = False - - both_funs_have_not_been_checked_before dcl_index icl_index correspondences - = correspondences.[dcl_index]==cNoCorrespondence && correspondences.[icl_index]==cNoCorrespondence - - both_funs_correspond dcl_index icl_index correspondences - = correspondences.[dcl_index]==icl_index && correspondences.[icl_index]==dcl_index init_attr_vars attr_vars tc_state=:{tc_attr_vars} # hwn_heap = foldSt init_attr_var attr_vars tc_attr_vars.hwn_heap @@ -1264,7 +1162,7 @@ init_attr_vars attr_vars tc_state=:{tc_attr_vars} init_attr_var {av_info_ptr} attr_heap = writePtr av_info_ptr AVI_Empty attr_heap -error_message :== "definition in the impl module conflicts with the def module" +ErrorMessage = "definition in the impl module conflicts with the def module" cNoCorrespondence :== -1 implies a b :== not a || b @@ -1295,7 +1193,16 @@ do_nothing ec_state = ec_state give_error s ec_state - = { ec_state & ec_error_admin = checkError s error_message ec_state.ec_error_admin } + = { ec_state & ec_error_admin = checkError s ErrorMessage ec_state.ec_error_admin } + +/* +instance <<< Priority + where + (<<<) file NoPrio = file <<< "NoPrio" + (<<<) file (Prio LeftAssoc i) = file <<< "Prio LeftAssoc " <<< i + (<<<) file (Prio RightAssoc i) = file <<< "Prio RightAssoc " <<< i + (<<<) file (Prio NoAssoc i) = file <<< "Prio NoAssoc " <<< i +*/ /* print_function_body_array function_bodies diff --git a/frontend/convertcases.icl b/frontend/convertcases.icl index 4901f0b..513df80 100644 --- a/frontend/convertcases.icl +++ b/frontend/convertcases.icl @@ -730,7 +730,7 @@ newFunctionWithType opt_id fun_bodies local_vars fun_type group_index (cs_next_f , fun_body = fun_bodies , fun_type = Yes fun_type , fun_pos = NoPos - , fun_kind = FK_ImpFunction cNameNotLocationDependent + , fun_kind = FK_Function cNameNotLocationDependent , fun_lifted = 0 , fun_info = { EmptyFunInfo & fi_group_index = group_index, fi_local_vars = local_vars } } diff --git a/frontend/convertimportedtypes.icl b/frontend/convertimportedtypes.icl index a8151f0..904521a 100644 --- a/frontend/convertimportedtypes.icl +++ b/frontend/convertimportedtypes.icl @@ -7,9 +7,9 @@ cDontRemoveAnnotations :== False convertDclModule :: !Int !{# DclModule} !{# CommonDefs} !*{#{# CheckedTypeDef}} !ImportedConstructors !*VarHeap !*TypeHeaps -> (!*{#{# CheckedTypeDef}}, !ImportedConstructors, !*VarHeap, !*TypeHeaps) convertDclModule main_dcl_module_n dcl_mods common_defs imported_types imported_conses var_heap type_heaps - # {dcl_functions,dcl_common=dcl_common=:{com_type_defs,com_cons_defs,com_selector_defs},dcl_conversions} = dcl_mods.[main_dcl_module_n] - = case dcl_conversions of - Yes conversion_table + # {dcl_functions,dcl_common=dcl_common=:{com_type_defs,com_cons_defs,com_selector_defs},dcl_macro_conversions} = dcl_mods.[main_dcl_module_n] + = case dcl_macro_conversions of + Yes _ # (icl_type_defs, imported_types) = imported_types![main_dcl_module_n] common_defs = { common \\ common <-: common_defs } common_defs = { common_defs & [main_dcl_module_n] = dcl_common } @@ -56,14 +56,14 @@ convertIclModule main_dcl_module_n common_defs imported_types imported_conses va convertImportedTypeSpecifications :: !Int !{# DclModule} !{# {# FunType} } !{# CommonDefs} !ImportedConstructors !ImportedFunctions !*{# {#CheckedTypeDef}} !*TypeHeaps !*VarHeap -> (!*{#{#CheckedTypeDef}}, !*TypeHeaps, !*VarHeap) convertImportedTypeSpecifications main_dcl_module_n dcl_mods dcl_functions common_defs imported_conses imported_functions imported_types type_heaps var_heap - # {dcl_common={com_type_defs},dcl_conversions} = dcl_mods.[main_dcl_module_n] - = case dcl_conversions of - Yes conversion_table + # {dcl_common={com_type_defs},dcl_macro_conversions} = dcl_mods.[main_dcl_module_n] + = case dcl_macro_conversions of + Yes _ # abstract_type_indexes = iFoldSt (determine_abstract_type com_type_defs) 0 (size com_type_defs) [] | isEmpty abstract_type_indexes -> convert_imported_type_specs dcl_functions common_defs imported_conses imported_functions imported_types type_heaps var_heap # (icl_type_defs, imported_types) = imported_types![main_dcl_module_n] - type_defs = foldSt (insert_abstract_type conversion_table.[cTypeDefs]) abstract_type_indexes { icl_type_def \\ icl_type_def <-: icl_type_defs } + type_defs = foldSt (insert_abstract_type /*conversion_table.[cTypeDefs]*/) abstract_type_indexes { icl_type_def \\ icl_type_def <-: icl_type_defs } (imported_types, type_heaps, var_heap) = convert_imported_type_specs dcl_functions common_defs imported_conses imported_functions { imported_types & [main_dcl_module_n] = type_defs } type_heaps var_heap @@ -81,9 +81,10 @@ where _ -> abstract_type_indexes - insert_abstract_type conversion_table type_index type_defs - # icl_index = conversion_table.[type_index] - (type_def, type_defs) = type_defs![icl_index] + insert_abstract_type /*conversion_table*/ type_index type_defs +// # icl_index = conversion_table.[type_index] + # icl_index=type_index + # (type_def, type_defs) = type_defs![icl_index] = { type_defs & [icl_index] = { type_def & td_rhs = AbstractType cAllBitsClear }} convert_imported_type_specs dcl_functions common_defs imported_conses imported_functions imported_types type_heaps var_heap diff --git a/frontend/explicitimports.dcl b/frontend/explicitimports.dcl index fe0030a..8562e5e 100644 --- a/frontend/explicitimports.dcl +++ b/frontend/explicitimports.dcl @@ -26,6 +26,6 @@ solveExplicitImports :: !(IntKeyHashtable [(Int,Position,[ImportNrAndIdents])]) !*(!v:{#DclModule},!*{#Int},!{!*ExplImpInfo},!*CheckState) -> (!.SolvedImports,!(!v:{#DclModule},!.{#Int},!{!.ExplImpInfo},!.CheckState)) -checkExplicitImportCompleteness :: ![([Declaration], Position)] !*{#DclModule} !*{#FunDef} !*ExpressionHeap !*CheckState - -> (!.{#DclModule},!.{#FunDef},!.ExpressionHeap,!.CheckState) +checkExplicitImportCompleteness :: ![([Declaration], Position)] !*{#DclModule} !*{#FunDef} !*{#*{#FunDef}} !*ExpressionHeap !*CheckState + -> (!.{#DclModule},!.{#FunDef},!*{#*{#FunDef}},!.ExpressionHeap,!.CheckState) diff --git a/frontend/explicitimports.icl b/frontend/explicitimports.icl index c453e2c..46b1ffd 100644 --- a/frontend/explicitimports.icl +++ b/frontend/explicitimports.icl @@ -479,14 +479,16 @@ get_eei_ident (eii=:ExplImpInfo eii_ident _) = (eii_ident, eii) :: CheckCompletenessState = { ccs_dcl_modules :: !.{#DclModule} , ccs_icl_functions :: !.{#FunDef} + , ccs_macro_defs :: !.{#.{#FunDef}} , ccs_set_of_visited_icl_funs :: !.{#Bool} // ccs_set_of_visited_icl_funs.[i] <=> function nr i has been considered + , ccs_set_of_visited_macros :: !.{#.{#Bool}} , ccs_expr_heap :: !.ExpressionHeap , ccs_symbol_table :: !.SymbolTable , ccs_error :: !.ErrorAdmin , ccs_heap_changes_accu :: ![SymbolPtr] } -:: *CheckCompletenessStateBox = { box_ccs :: !*CheckCompletenessState } +:: CheckCompletenessStateBox = { box_ccs :: !.CheckCompletenessState } :: CheckCompletenessInput = { cci_import_position :: !Position @@ -495,13 +497,14 @@ get_eei_ident (eii=:ExplImpInfo eii_ident _) = (eii_ident, eii) :: CheckCompletenessInputBox = { box_cci :: !CheckCompletenessInput } -checkExplicitImportCompleteness :: ![([Declaration], Position)] !*{#DclModule} !*{#FunDef} !*ExpressionHeap !*CheckState - -> (!.{#DclModule},!.{#FunDef},!.ExpressionHeap,!.CheckState) -checkExplicitImportCompleteness dcls_explicit dcl_modules icl_functions expr_heap - cs=:{cs_symbol_table, cs_error} +checkExplicitImportCompleteness :: ![([Declaration], Position)] !*{#DclModule} !*{#FunDef} !*{#*{#FunDef}} !*ExpressionHeap !*CheckState + -> (!.{#DclModule},!.{#FunDef},!*{#*{#FunDef}},!.ExpressionHeap,!.CheckState) +checkExplicitImportCompleteness dcls_explicit dcl_modules icl_functions macro_defs expr_heap cs=:{cs_symbol_table, cs_error} #! nr_icl_functions = size icl_functions - box_ccs = { ccs_dcl_modules = dcl_modules, ccs_icl_functions = icl_functions, + #! n_dcl_modules = size dcl_modules + # box_ccs = { ccs_dcl_modules = dcl_modules, ccs_icl_functions = icl_functions, ccs_macro_defs=macro_defs, ccs_set_of_visited_icl_funs = createArray nr_icl_functions False, + ccs_set_of_visited_macros = { {} \\ module_n<-[0..n_dcl_modules-1]}, ccs_expr_heap = expr_heap, ccs_symbol_table = cs_symbol_table, ccs_error = cs_error, ccs_heap_changes_accu = [] } main_dcl_module_n @@ -511,12 +514,11 @@ checkExplicitImportCompleteness dcls_explicit dcl_modules icl_functions expr_hea -> foldSt (checkCompleteness main_dcl_module_n position) dcls ccs) dcls_explicit { box_ccs = box_ccs } - { ccs_dcl_modules, ccs_icl_functions, ccs_expr_heap, ccs_symbol_table, ccs_error, ccs_heap_changes_accu } - = ccs.box_ccs + { ccs_dcl_modules, ccs_icl_functions,ccs_macro_defs,ccs_expr_heap, ccs_symbol_table, ccs_error, ccs_heap_changes_accu } = ccs.box_ccs // repair heap contents ccs_symbol_table = foldSt replace_ste_with_previous ccs_heap_changes_accu ccs_symbol_table cs = { cs & cs_symbol_table = ccs_symbol_table, cs_error = ccs_error } - = (ccs_dcl_modules, ccs_icl_functions, ccs_expr_heap, cs) + = (ccs_dcl_modules, ccs_icl_functions,ccs_macro_defs, ccs_expr_heap, cs) where checkCompleteness :: !Int !Position !Declaration !*CheckCompletenessStateBox -> *CheckCompletenessStateBox checkCompleteness main_dcl_module_n import_position (Declaration {decl_ident, decl_index, decl_kind=STE_FunctionOrMacro _}) ccs @@ -544,6 +546,9 @@ checkExplicitImportCompleteness dcls_explicit dcl_modules icl_functions expr_hea = check_completeness dcl_common.com_instance_defs.[decl_index] cci ccs continuation STE_DclFunction dcl_common dcl_functions cci ccs = check_completeness dcl_functions.[decl_index] cci ccs + continuation (STE_DclMacroOrLocalMacroFunction _) dcl_common dcl_functions cci ccs + # (macro,ccs) = ccs!box_ccs.ccs_macro_defs.[mod_index,decl_index] + = check_completeness macro cci ccs checkCompletenessOfMacro :: !Ident !Index !Int !Position !*CheckCompletenessStateBox -> *CheckCompletenessStateBox checkCompletenessOfMacro decl_ident decl_index main_dcl_module_n import_position ccs @@ -772,38 +777,63 @@ instance check_completeness SymbIdent where = case symb_kind of SK_Constructor _ -> check_whether_ident_is_imported symb_name STE_Constructor cci ccs - SK_Function global_index - -> check_completeness_for_function symb_name global_index ste_fun_or_macro cci ccs + SK_Function global_index + -> check_completeness_for_function symb_name global_index cci ccs + SK_DclMacro global_index + -> check_completeness_for_macro symb_name global_index cci ccs + SK_LocalDclMacroFunction global_index + -> check_completeness_for_local_dcl_macro symb_name global_index cci ccs SK_LocalMacroFunction function_index - -> check_completeness_for_local_macro_function symb_name function_index ste_fun_or_macro cci ccs + -> check_completeness_for_local_macro_function symb_name function_index cci ccs SK_OverloadedFunction global_index - -> check_completeness_for_function symb_name global_index STE_Member cci ccs - SK_Macro global_index - -> check_completeness_for_function symb_name global_index ste_fun_or_macro cci ccs + -> check_whether_ident_is_imported symb_name STE_Member cci ccs where - check_completeness_for_function symb_name {glob_object,glob_module} wanted_ste_kind cci ccs + check_completeness_for_function symb_name {glob_object,glob_module} cci ccs | glob_module<>cci.box_cci.cci_main_dcl_module_n // the function that is referred from within a macro is a DclFunction // -> must be global -> has to be imported - = check_whether_ident_is_imported symb_name wanted_ste_kind cci ccs - #! (fun_def, ccs) = ccs!box_ccs.ccs_icl_functions.[glob_object] + = check_whether_ident_is_imported symb_name (STE_FunctionOrMacro []) cci ccs // otherwise the function was defined locally in a macro // it is not a consequence, but it's type and body are consequences ! #! (already_visited, ccs) = ccs!box_ccs.ccs_set_of_visited_icl_funs.[glob_object] | /* ccs.box_ccs.ccs_set_of_visited_icl_funs.[glob_object] */ already_visited = ccs - #! ccs = { ccs & box_ccs.ccs_set_of_visited_icl_funs.[glob_object] = True } - = check_completeness fun_def cci ccs + # ccs = { ccs & box_ccs.ccs_set_of_visited_icl_funs.[glob_object] = True } + # (fun_def, ccs) = ccs!box_ccs.ccs_icl_functions.[glob_object] + = check_completeness fun_def cci ccs + + check_completeness_for_macro symb_name global_index cci ccs + | global_index.glob_module<>cci.box_cci.cci_main_dcl_module_n + = check_whether_ident_is_imported symb_name (STE_DclMacroOrLocalMacroFunction []) cci ccs + = check_completeness_for_local_dcl_macro symb_name global_index cci ccs + + check_completeness_for_local_dcl_macro symb_name {glob_module,glob_object} cci ccs + | size ccs.box_ccs.ccs_set_of_visited_macros.[glob_module]==0 +// #! n_macros_in_dcl_module=size ccs.box_ccs.ccs_macro_defs.[glob_module] + # (n_macros_in_dcl_module,ccs) = get_n_macros_in_dcl_module ccs glob_module + with + get_n_macros_in_dcl_module :: *CheckCompletenessStateBox Int -> (!Int,!*CheckCompletenessStateBox) + get_n_macros_in_dcl_module ccs glob_module + #! n_macros_in_dcl_module=size ccs.box_ccs.ccs_macro_defs.[glob_module] + = (n_macros_in_dcl_module,ccs) + # visited_dcl_macros = {createArray n_macros_in_dcl_module False & [glob_object]=True} + # ccs= {ccs & box_ccs.ccs_set_of_visited_macros.[glob_module]=visited_dcl_macros} + # (macro_def, ccs) = ccs!box_ccs.ccs_macro_defs.[glob_module,glob_object] + = check_completeness macro_def cci ccs + | ccs.box_ccs.ccs_set_of_visited_macros.[glob_module].[glob_object] + = ccs + # ccs = {ccs & box_ccs.ccs_set_of_visited_macros.[glob_module].[glob_object]=True} + # (macro_def, ccs) = ccs!box_ccs.ccs_macro_defs.[glob_module,glob_object] + = check_completeness macro_def cci ccs - check_completeness_for_local_macro_function symb_name glob_object wanted_ste_kind cci ccs - #! (fun_def, ccs) = ccs!box_ccs.ccs_icl_functions.[glob_object] + check_completeness_for_local_macro_function symb_name glob_object cci ccs // otherwise the function was defined locally in a macro // it is not a consequence, but it's type and body are consequences ! - #! (already_visited, ccs) = ccs!box_ccs.ccs_set_of_visited_icl_funs.[glob_object] - | already_visited + | ccs.box_ccs.ccs_set_of_visited_icl_funs.[glob_object] = ccs - #! ccs = { ccs & box_ccs.ccs_set_of_visited_icl_funs.[glob_object] = True } - = check_completeness fun_def cci ccs + # ccs = { ccs & box_ccs.ccs_set_of_visited_icl_funs.[glob_object] = True } + # (fun_def, ccs) = ccs!box_ccs.ccs_icl_functions.[glob_object] + = check_completeness fun_def cci ccs instance check_completeness SymbolType where check_completeness {st_args, st_result, st_context} cci ccs @@ -873,7 +903,6 @@ flipM f a b :== f b a // STE_Kinds just for comparision ste_field =: STE_Field { id_name="", id_info=nilPtr } -ste_fun_or_macro =: STE_FunctionOrMacro [] stupid_ident =: { id_name = "stupid", id_info = nilPtr } diff --git a/frontend/frontend.dcl b/frontend/frontend.dcl index 84fdf3b..2810e58 100644 --- a/frontend/frontend.dcl +++ b/frontend/frontend.dcl @@ -17,9 +17,6 @@ import checksupport, transform, overloading = { fe_icl :: !IclModule , fe_dcls :: !{#DclModule} , fe_components :: !{!Group} - , fe_dclIclConversions :: !Optional {# Index} - , fe_iclDclConversions :: !Optional {# Index} - , fe_globalFunctions :: !IndexRange , fe_arrayInstances :: !ArrayAndListInstances } @@ -31,5 +28,5 @@ import checksupport, transform, overloading | FrontEndPhaseConvertModules | FrontEndPhaseAll -frontEndInterface :: !FrontEndOptions !Ident !SearchPaths !{#DclModule} !{#FunDef} !(Optional Bool) !*PredefinedSymbols !*HashTable (ModTimeFunction *Files) !*Files !*File !*File !*File (!Optional !*File) !*Heaps - -> ( !Optional *FrontEndSyntaxTree,!*{# FunDef },!{#DclModule},!Int,!Int,!*PredefinedSymbols, !*HashTable, !*Files, !*File, !*File, !*File, !Optional !*File, !*Heaps) +frontEndInterface :: !FrontEndOptions !Ident !SearchPaths !{#DclModule} !*{#*{#FunDef}} !(Optional Bool) !*PredefinedSymbols !*HashTable (ModTimeFunction *Files) !*Files !*File !*File !*File (!Optional !*File) !*Heaps + -> ( !Optional *FrontEndSyntaxTree,!*{#*{#FunDef}},!{#DclModule},!Int,!Int,!*PredefinedSymbols, !*HashTable, !*Files, !*File, !*File, !*File, !Optional !*File, !*Heaps) diff --git a/frontend/frontend.icl b/frontend/frontend.icl index b76c653..7a5e36e 100644 --- a/frontend/frontend.icl +++ b/frontend/frontend.icl @@ -18,9 +18,6 @@ SwitchGenerics on off :== off = { fe_icl :: !IclModule , fe_dcls :: !{#DclModule} , fe_components :: !{!Group} - , fe_dclIclConversions :: !Optional {# Index} - , fe_iclDclConversions :: !Optional {# Index} - , fe_globalFunctions :: !IndexRange , fe_arrayInstances :: !ArrayAndListInstances } @@ -29,33 +26,6 @@ SwitchGenerics on off :== off (-*->) value trace :== value // ---> trace -build_optional_icl_dcl_conversions :: !Int !(Optional {# Index}) -> Optional {# Index} -build_optional_icl_dcl_conversions size No - = Yes (buildIclDclConversions size {}) -build_optional_icl_dcl_conversions size (Yes dcl_icl_conversions) - = Yes (buildIclDclConversions size dcl_icl_conversions) - -buildIclDclConversions :: !Int !{# Index} -> {# Index} -buildIclDclConversions table_size dcl_icl_conversions - # dcl_table_size = size dcl_icl_conversions - icl_dcl_conversions = update_conversion_array 0 dcl_table_size dcl_icl_conversions (createArray table_size NoIndex) - = fill_empty_positions 0 table_size dcl_table_size icl_dcl_conversions - -where - update_conversion_array dcl_index dcl_table_size dcl_icl_conversions icl_conversions - | dcl_index < dcl_table_size - # icl_index = dcl_icl_conversions.[dcl_index] - = update_conversion_array (inc dcl_index) dcl_table_size dcl_icl_conversions - { icl_conversions & [icl_index] = dcl_index } - = icl_conversions - - fill_empty_positions next_index table_size next_new_index icl_conversions - | next_index < table_size - | icl_conversions.[next_index] == NoIndex - = fill_empty_positions (inc next_index) table_size (inc next_new_index) { icl_conversions & [next_index] = next_new_index } - = fill_empty_positions (inc next_index) table_size next_new_index icl_conversions - = icl_conversions - :: FrontEndPhase = FrontEndPhaseCheck | FrontEndPhaseTypeCheck @@ -68,23 +38,19 @@ instance == FrontEndPhase where (==) a b = equal_constructor a b -frontSyntaxTree cached_functions_and_macros cached_dcl_mods n_functions_and_macros_in_dcl_modules main_dcl_module_n predef_symbols hash_table files error io out tcl_file icl_mod dcl_mods fun_defs components array_instances optional_dcl_icl_conversions - global_fun_range heaps +frontSyntaxTree cached_dcl_macros cached_dcl_mods n_functions_and_macros_in_dcl_modules main_dcl_module_n predef_symbols hash_table files error io out tcl_file icl_mod dcl_mods fun_defs components array_instances heaps :== (Yes { fe_icl = {icl_mod & icl_functions=fun_defs } , fe_dcls = dcl_mods , fe_components = components - , fe_dclIclConversions = optional_dcl_icl_conversions - , fe_iclDclConversions = build_optional_icl_dcl_conversions (size fun_defs) optional_dcl_icl_conversions - , fe_globalFunctions = global_fun_range , fe_arrayInstances = array_instances - },cached_functions_and_macros,cached_dcl_mods,n_functions_and_macros_in_dcl_modules,main_dcl_module_n,predef_symbols,hash_table,files,error,io,out,tcl_file,heaps + },cached_dcl_macros,cached_dcl_mods,n_functions_and_macros_in_dcl_modules,main_dcl_module_n,predef_symbols,hash_table,files,error,io,out,tcl_file,heaps ) // import StdDebug -frontEndInterface :: !FrontEndOptions !Ident !SearchPaths !{#DclModule} !{#FunDef} !(Optional Bool) !*PredefinedSymbols !*HashTable (ModTimeFunction *Files) !*Files !*File !*File !*File (!Optional !*File) !*Heaps - -> ( !Optional *FrontEndSyntaxTree,!*{# FunDef },!{#DclModule},!Int,!Int,!*PredefinedSymbols, !*HashTable, !*Files, !*File, !*File, !*File, !Optional !*File, !*Heaps) +frontEndInterface :: !FrontEndOptions !Ident !SearchPaths !{#DclModule} !*{#*{#FunDef}} !(Optional Bool) !*PredefinedSymbols !*HashTable (ModTimeFunction *Files) !*Files !*File !*File !*File (!Optional !*File) !*Heaps + -> ( !Optional *FrontEndSyntaxTree,!*{#*{#FunDef}},!{#DclModule},!Int,!Int,!*PredefinedSymbols, !*HashTable, !*Files, !*File, !*File, !*File, !Optional !*File, !*Heaps) frontEndInterface options mod_ident search_paths cached_dcl_modules functions_and_macros list_inferred_types predef_symbols hash_table modtimefunction files error io out tcl_file heaps // # files = trace_n ("Compiling "+++mod_ident.id_name) files # (ok, mod, hash_table, error, predef_symbols, files) @@ -93,9 +59,8 @@ frontEndInterface options mod_ident search_paths cached_dcl_modules functions_an = (No,{},{},0,0,predef_symbols, hash_table, files, error, io, out, tcl_file, heaps) # cached_module_idents = [dcl_mod.dcl_name \\ dcl_mod<-:cached_dcl_modules] - # (nr_of_chached_functions_and_macros, functions_and_macros) = usize functions_and_macros # (ok, mod, global_fun_range, mod_functions, optional_dcl_mod, modules, dcl_module_n_in_cache,n_functions_and_macros_in_dcl_modules,hash_table, error, predef_symbols, files) - = scanModule (mod -*-> "Scanning") cached_module_idents nr_of_chached_functions_and_macros options.feo_generics hash_table error search_paths predef_symbols modtimefunction files + = scanModule (mod -*-> "Scanning") cached_module_idents options.feo_generics hash_table error search_paths predef_symbols modtimefunction files /* JVG: */ // # hash_table = {hash_table & hte_entries={}} # hash_table = remove_icl_symbols_from_hash_table hash_table @@ -104,7 +69,7 @@ frontEndInterface options mod_ident search_paths cached_dcl_modules functions_an = (No,{},{},0,0,predef_symbols, hash_table, files, error, io, out, tcl_file, heaps) # symbol_table = hash_table.hte_symbol_heap #! n_cached_dcl_modules=size cached_dcl_modules - # (ok, icl_mod, dcl_mods, components, optional_dcl_icl_conversions,cached_functions_and_macros,main_dcl_module_n,heaps, predef_symbols, symbol_table, error /* TD */, directly_imported_dcl_modules) + # (ok, icl_mod, dcl_mods, components, cached_dcl_macros,main_dcl_module_n,heaps, predef_symbols, symbol_table, error, directly_imported_dcl_modules) = checkModule mod global_fun_range mod_functions n_functions_and_macros_in_dcl_modules dcl_module_n_in_cache optional_dcl_mod modules cached_dcl_modules functions_and_macros predef_symbols (symbol_table -*-> "Checking") error heaps hash_table = { hash_table & hte_symbol_heap = symbol_table} @@ -116,14 +81,20 @@ frontEndInterface options mod_ident search_paths cached_dcl_modules functions_an select_and_remove_icl_functions_from_record :: !*IclModule -> (!.{#FunDef},!.IclModule) select_and_remove_icl_functions_from_record icl_mod=:{icl_functions} = (icl_functions,{icl_mod & icl_functions={}}) - # {icl_instances,icl_specials,icl_common,icl_import,icl_name,icl_imported_objects,icl_used_module_numbers,icl_copied_from_dcl} = icl_mod + # {icl_global_functions,icl_instances,icl_specials,icl_common,icl_import,icl_name,icl_imported_objects,icl_used_module_numbers,icl_copied_from_dcl} = icl_mod /* (_,f,files) = fopen "components" FWriteText files - (components, icl_functions, f) = showComponents components 0 True icl_functions f +// (components, icl_functions, f) = showComponents components 0 True icl_functions f + /* + (n_functions,icl_functions) = usize icl_functions + (icl_functions,f) = showFunctions {ir_from=0,ir_to=n_functions} icl_functions f + (cached_dcl_macros,f) = showMacros cached_dcl_macros f + */ (ok,files) = fclose f files | ok<>ok = abort ""; */ + // # dcl_mods = {{dcl_mod & dcl_declared={dcls_import={},dcls_local=[],dcls_local_for_import={},dcls_explicit={}}}\\ dcl_mod<-:dcl_mods} # var_heap = heaps.hp_var_heap @@ -132,10 +103,9 @@ frontEndInterface options mod_ident search_paths cached_dcl_modules functions_an | options.feo_up_to_phase == FrontEndPhaseCheck # array_instances = {ali_array_first_instance_indices=[],ali_list_first_instance_indices=[],ali_tail_strict_list_first_instance_indices=[],ali_instances_range={ir_from=0,ir_to=0}} - = frontSyntaxTree cached_functions_and_macros dcl_mods n_functions_and_macros_in_dcl_modules main_dcl_module_n - predef_symbols hash_table files error io out tcl_file icl_mod dcl_mods fun_defs components array_instances optional_dcl_icl_conversions global_fun_range heaps + = frontSyntaxTree cached_dcl_macros dcl_mods n_functions_and_macros_in_dcl_modules main_dcl_module_n + predef_symbols hash_table files error io out tcl_file icl_mod dcl_mods fun_defs components array_instances heaps -// AA.. # error_admin = {ea_file = error, ea_loc = [], ea_ok = True } /* # (ti_common_defs, dcl_mods) = get_common_defs dcl_mods @@ -150,13 +120,12 @@ frontEndInterface options mod_ident search_paths cached_dcl_modules functions_an # (td_infos, th_vars, error_admin) = analyseTypeDefs ti_common_defs type_groups td_infos type_heaps.th_vars error_admin /* (fun_defs, dcl_mods, th_vars, td_infos, error_admin) - = checkKindCorrectness main_dcl_module_n nr_of_chached_functions_and_macros icl_instances ti_common_defs n_cached_dcl_modules fun_defs dcl_mods type_heaps.th_vars td_infos error_admin + = checkKindCorrectness main_dcl_module_n nr_of_cached_functions_and_macros icl_instances ti_common_defs n_cached_dcl_modules fun_defs dcl_mods type_heaps.th_vars td_infos error_admin */ (class_infos, td_infos, th_vars, error_admin) = determineKindsOfClasses icl_used_module_numbers ti_common_defs td_infos th_vars error_admin - #! nr_of_icl_functions = icl_mod.icl_instances.ir_from # (fun_defs, dcl_mods, td_infos, th_vars, error_admin) - = checkKindsOfCommonDefsAndFunctions n_cached_dcl_modules main_dcl_module_n icl_used_module_numbers global_fun_range + = checkKindsOfCommonDefsAndFunctions n_cached_dcl_modules main_dcl_module_n icl_used_module_numbers icl_global_functions ti_common_defs fun_defs dcl_mods td_infos class_infos th_vars error_admin type_heaps = { type_heaps & th_vars = th_vars } @@ -167,17 +136,17 @@ frontEndInterface options mod_ident search_paths cached_dcl_modules functions_an dcl_common_defs dcl_mods = {dcl_common \\ {dcl_common} <-: dcl_mods } - #! (components, ti_common_defs, fun_defs, generic_range, td_infos, heaps, hash_table, predef_symbols, dcl_mods, optional_dcl_icl_conversions, error_admin) = + #! (components, ti_common_defs, fun_defs, generic_range, td_infos, heaps, hash_table, predef_symbols, dcl_mods, error_admin) = SwitchGenerics (case options.feo_generics of True -> - convertGenerics + convertGenerics components main_dcl_module_n ti_common_defs fun_defs td_infos - heaps hash_table predef_symbols dcl_mods optional_dcl_icl_conversions error_admin + heaps hash_table predef_symbols dcl_mods undef error_admin False -> - (components, ti_common_defs, fun_defs, {ir_to=0,ir_from=0}, td_infos, heaps, hash_table, predef_symbols, dcl_mods, optional_dcl_icl_conversions, error_admin) + (components, ti_common_defs, fun_defs, {ir_to=0,ir_from=0}, td_infos, heaps, hash_table, predef_symbols, dcl_mods, error_admin) ) - (components, ti_common_defs, fun_defs, {ir_to=0,ir_from=0}, td_infos, heaps, hash_table, predef_symbols, dcl_mods, optional_dcl_icl_conversions, error_admin) + (components, ti_common_defs, fun_defs, {ir_to=0,ir_from=0}, td_infos, heaps, hash_table, predef_symbols, dcl_mods, error_admin) # (icl_common, ti_common_defs) = replace copied_ti_common_defs main_dcl_module_n saved_main_dcl_common with copied_ti_common_defs :: !.{#CommonDefs} // needed for Clean 2.0 to disambiguate overloading of replace @@ -191,7 +160,6 @@ frontEndInterface options mod_ident search_paths cached_dcl_modules functions_an #! ok = error_admin.ea_ok | not ok = (No,{},{},0,main_dcl_module_n,predef_symbols, hash_table, files, error, io, out, tcl_file, heaps) -// ..AA # (ok, fun_defs, array_instances, type_code_instances, common_defs, imported_funs, type_def_infos, heaps, predef_symbols, error,out) = typeProgram (components -*-> "Typing") main_dcl_module_n fun_defs/*icl_functions*/ icl_specials list_inferred_types icl_common [a\\a<-:icl_import] dcl_mods icl_used_module_numbers td_infos heaps predef_symbols error out dcl_mods @@ -201,26 +169,26 @@ frontEndInterface options mod_ident search_paths cached_dcl_modules functions_an # (fun_def_size, fun_defs) = usize fun_defs - # (components, fun_defs) = partitionateFunctions (fun_defs -*-> "partitionateFunctions") [ global_fun_range, icl_instances, icl_specials, generic_range] + # (components, fun_defs) = partitionateFunctions (fun_defs -*-> "partitionateFunctions") (icl_global_functions++icl_instances++[icl_specials, generic_range]) // (components, fun_defs, error) = showTypes components 0 fun_defs error // (components, fun_defs, out) = showComponents components 0 True fun_defs out // (fun_defs, error) = showFunctions array_instances fun_defs error | options.feo_up_to_phase == FrontEndPhaseTypeCheck - = frontSyntaxTree cached_functions_and_macros cached_dcl_mods n_functions_and_macros_in_dcl_modules main_dcl_module_n - predef_symbols hash_table files error io out tcl_file icl_mod dcl_mods fun_defs components array_instances optional_dcl_icl_conversions global_fun_range heaps + = frontSyntaxTree cached_dcl_macros cached_dcl_mods n_functions_and_macros_in_dcl_modules main_dcl_module_n + predef_symbols hash_table files error io out tcl_file icl_mod dcl_mods fun_defs components array_instances heaps # (components, fun_defs, predef_symbols, dcl_types, used_conses_in_dynamics, var_heap, type_heaps, expression_heap, tcl_file) = convertDynamicPatternsIntoUnifyAppls type_code_instances common_defs main_dcl_module_n (components -*-> "convertDynamics") fun_defs predef_symbols - heaps.hp_var_heap heaps.hp_type_heaps heaps.hp_expression_heap tcl_file dcl_mods icl_mod /* TD */ directly_imported_dcl_modules + heaps.hp_var_heap heaps.hp_type_heaps heaps.hp_expression_heap tcl_file dcl_mods icl_mod directly_imported_dcl_modules // # (components, fun_defs, error) = showComponents3 components 0 False fun_defs error // (components, fun_defs, error) = showComponents components 0 True fun_defs error | options.feo_up_to_phase == FrontEndPhaseConvertDynamics # heaps = {hp_var_heap=var_heap, hp_type_heaps=type_heaps, hp_expression_heap=expression_heap} - = frontSyntaxTree cached_functions_and_macros cached_dcl_mods n_functions_and_macros_in_dcl_modules main_dcl_module_n - predef_symbols hash_table files error io out tcl_file icl_mod dcl_mods fun_defs components array_instances optional_dcl_icl_conversions global_fun_range heaps + = frontSyntaxTree cached_dcl_macros cached_dcl_mods n_functions_and_macros_in_dcl_modules main_dcl_module_n + predef_symbols hash_table files error io out tcl_file icl_mod dcl_mods fun_defs components array_instances heaps // (components, fun_defs, error) = showComponents components 0 True fun_defs error @@ -241,8 +209,8 @@ frontEndInterface options mod_ident search_paths cached_dcl_modules functions_an | options.feo_up_to_phase == FrontEndPhaseTransformGroups # heaps = {hp_var_heap=var_heap, hp_type_heaps=type_heaps, hp_expression_heap=expression_heap} - = frontSyntaxTree cached_functions_and_macros cached_dcl_mods n_functions_and_macros_in_dcl_modules main_dcl_module_n - predef_symbols hash_table files error io out tcl_file icl_mod dcl_mods fun_defs components array_instances optional_dcl_icl_conversions global_fun_range heaps + = frontSyntaxTree cached_dcl_macros cached_dcl_mods n_functions_and_macros_in_dcl_modules main_dcl_module_n + predef_symbols hash_table files error io out tcl_file icl_mod dcl_mods fun_defs components array_instances heaps # (dcl_types, used_conses, var_heap, type_heaps) = convertIclModule main_dcl_module_n common_defs (dcl_types -*-> "Convert icl") used_conses var_heap type_heaps # (dcl_types, used_conses, var_heap, type_heaps) = convertDclModule main_dcl_module_n dcl_mods common_defs (dcl_types -*-> "Convert dcl") used_conses var_heap type_heaps @@ -251,8 +219,8 @@ frontEndInterface options mod_ident search_paths cached_dcl_modules functions_an | options.feo_up_to_phase == FrontEndPhaseConvertModules # heaps = {hp_var_heap=var_heap, hp_type_heaps=type_heaps, hp_expression_heap=expression_heap} - = frontSyntaxTree cached_functions_and_macros cached_dcl_mods n_functions_and_macros_in_dcl_modules main_dcl_module_n - predef_symbols hash_table files error io out tcl_file icl_mod dcl_mods fun_defs components array_instances optional_dcl_icl_conversions global_fun_range heaps + = frontSyntaxTree cached_dcl_macros cached_dcl_mods n_functions_and_macros_in_dcl_modules main_dcl_module_n + predef_symbols hash_table files error io out tcl_file icl_mod dcl_mods fun_defs components array_instances heaps // (components, fun_defs, out) = showComponents components 0 False fun_defs out # (used_funs, components, fun_defs, dcl_types, used_conses, var_heap, type_heaps, expression_heap) @@ -276,44 +244,16 @@ frontEndInterface options mod_ident search_paths cached_dcl_modules functions_an # heaps = {hp_var_heap = var_heap, hp_expression_heap=expression_heap, hp_type_heaps=type_heaps} # fe ={ fe_icl = // {icl_mod & icl_functions=fun_defs } - {icl_functions=fun_defs,icl_instances=icl_instances,icl_specials=icl_specials,icl_common=icl_common,icl_import=icl_import, + {icl_functions=fun_defs,icl_global_functions=icl_global_functions,icl_instances=icl_instances,icl_specials=icl_specials,icl_common=icl_common,icl_import=icl_import, icl_name=icl_name,icl_imported_objects=icl_imported_objects,icl_used_module_numbers=icl_used_module_numbers, icl_copied_from_dcl=icl_copied_from_dcl,icl_modification_time=icl_mod.icl_modification_time} , fe_dcls = dcl_mods , fe_components = components - , fe_dclIclConversions = optional_dcl_icl_conversions - , fe_iclDclConversions = build_optional_icl_dcl_conversions (size fun_defs) optional_dcl_icl_conversions - , fe_arrayInstances = array_instances,fe_globalFunctions=global_fun_range + , fe_arrayInstances = array_instances } - = (Yes fe,cached_functions_and_macros,cached_dcl_mods,n_functions_and_macros_in_dcl_modules,main_dcl_module_n,predef_symbols,hash_table,files,error,io,out,tcl_file,heaps) + = (Yes fe,cached_dcl_macros,cached_dcl_mods,n_functions_and_macros_in_dcl_modules,main_dcl_module_n,predef_symbols,hash_table,files,error,io,out,tcl_file,heaps) where - build_optional_icl_dcl_conversions :: !Int !(Optional {# Index}) -> Optional {# Index} - build_optional_icl_dcl_conversions size No - = Yes (build_icl_dcl_conversions size {}) - build_optional_icl_dcl_conversions size (Yes dcl_icl_conversions) - = Yes (build_icl_dcl_conversions size dcl_icl_conversions) - - build_icl_dcl_conversions :: !Int !{# Index} -> {# Index} - build_icl_dcl_conversions table_size dcl_icl_conversions - # dcl_table_size = size dcl_icl_conversions - icl_dcl_conversions = update_conversion_array 0 dcl_table_size dcl_icl_conversions (createArray table_size NoIndex) - = fill_empty_positions 0 table_size dcl_table_size icl_dcl_conversions - - update_conversion_array dcl_index dcl_table_size dcl_icl_conversions icl_conversions - | dcl_index < dcl_table_size - # icl_index = dcl_icl_conversions.[dcl_index] - = update_conversion_array (inc dcl_index) dcl_table_size dcl_icl_conversions - { icl_conversions & [icl_index] = dcl_index } - = icl_conversions - - fill_empty_positions next_index table_size next_new_index icl_conversions - | next_index < table_size - | icl_conversions.[next_index] == NoIndex - = fill_empty_positions (inc next_index) table_size (inc next_new_index) { icl_conversions & [next_index] = next_new_index } - = fill_empty_positions (inc next_index) table_size next_new_index icl_conversions - = icl_conversions - copy_dcl_modules dcl_mods #! nr_of_dcl_mods = size dcl_mods = arrayCopyBegin dcl_mods nr_of_dcl_mods @@ -330,6 +270,21 @@ where # (fd, fun_defs) = fun_defs![fun_index] = (fun_defs, file <<< fun_index <<< fd <<< '\n') +showMacros :: !*{#*{#FunDef}} !*File -> (!*{#*{#FunDef}},!*File) +showMacros macro_defs file + #! n_dcl_modules=size macro_defs + = iFoldSt showMacrosInModule 0 n_dcl_modules (macro_defs,file) + +showMacrosInModule :: !Int (!*{#*{#FunDef}},!*File) -> (!*{#*{#FunDef}},!*File) +showMacrosInModule dcl_index (macro_defs,file) + # file=file <<< dcl_index <<< '\n' + #! n_macros=size macro_defs.[dcl_index] + = iFoldSt show_macro 0 n_macros (macro_defs,file) + where + show_macro macro_index (macro_defs, file) + # (macro,macro_defs) = macro_defs![dcl_index,macro_index] + = (macro_defs, file <<< macro_index <<< macro <<< '\n') + showComponents :: !*{! Group} !Int !Bool !*{# FunDef} !*File -> (!*{! Group}, !*{# FunDef},!*File) showComponents comps comp_index show_types fun_defs file | comp_index >= size comps @@ -342,11 +297,12 @@ where = (fun_defs, file <<< '\n') show_component [fun:funs] show_types fun_defs file # (fun_def, fun_defs) = fun_defs![fun] + # file=file<<<fun<<<'\n' | show_types = 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) - + showComponents2 :: !*{! Group} !Int !*{# FunDef} !{! ConsClasses} !*File -> (!*{! Group},!*{# FunDef},!*File) showComponents2 comps comp_index fun_defs acc_args file | comp_index >= (size comps) diff --git a/frontend/generics.icl b/frontend/generics.icl index 50b5670..4c65095 100644 --- a/frontend/generics.icl +++ b/frontend/generics.icl @@ -264,22 +264,25 @@ where heaps=:{hp_type_heaps=hp_type_heaps=:{th_vars}, hp_var_heap} symbol_table #! (common_defs, modules) = modules![module_index] - #! class_defs = { x \\ x <-: common_defs.com_class_defs } // make unique copy - #! (class_defs, dcl_modules, new_type_defs, new_selector_defs, new_cons_defs, th_vars, hp_var_heap, symbol_table) = - createClassDictionaries + #! class_defs = { x \\ x <-: common_defs.com_class_defs } // make unique copy + # type_defs = { x \\ x <-: common_defs.com_type_defs } // make unique copy + # cons_defs = { x \\ x <-: common_defs.com_cons_defs } // make unique copy + # selector_defs = { x \\ x <-: common_defs.com_selector_defs } // make unique copy + # (size_type_defs,type_defs) = usize type_defs + #! (new_type_defs, new_selector_defs, new_cons_defs,_,type_defs,selector_defs,cons_defs,class_defs, dcl_modules, th_vars, hp_var_heap, symbol_table) = + createClassDictionaries + (abort "create_class_dictionaries1 True or False ?") module_index - class_defs - dcl_modules - (size common_defs.com_type_defs) + size_type_defs (size common_defs.com_selector_defs) (size common_defs.com_cons_defs) - th_vars hp_var_heap symbol_table + type_defs selector_defs cons_defs class_defs dcl_modules th_vars hp_var_heap symbol_table #! common_defs = { common_defs & com_class_defs = class_defs, - com_type_defs = arrayPlusList common_defs.com_type_defs new_type_defs, - com_selector_defs = arrayPlusList common_defs.com_selector_defs new_selector_defs, - com_cons_defs = arrayPlusList common_defs.com_cons_defs new_cons_defs} + com_type_defs = arrayPlusList type_defs new_type_defs, + com_selector_defs = arrayPlusList selector_defs new_selector_defs, + com_cons_defs = arrayPlusList cons_defs new_cons_defs} #! heaps = {heaps & hp_var_heap = hp_var_heap, hp_type_heaps = {hp_type_heaps & th_vars = th_vars}} #! modules = { modules & [module_index] = common_defs } @@ -953,9 +956,19 @@ where ds_index = to_fun_index, ds_arity = 1 } + # gtd_info = GTDI_Generic { + gt_type = generic_rep_type, + gt_type_args = [atv_variable \\ {atv_variable} <- type_def.td_args], + gt_iso = iso_def_sym, + gt_isomap_group = NoIndex, + gt_isomap = EmptyDefinedSymbol, + gt_isomap_from = EmptyDefinedSymbol, + gt_isomap_to = EmptyDefinedSymbol + } # (from_fun_def, gs) = buildIsoFrom from_def_sym from_group_index module_index type_def gs # (to_fun_def, gs) = buildIsoTo to_def_sym to_group_index module_index type_def cons_infos gs + # (iso_fun_def, gs) = //buildUndefFunction iso_fun_index iso_group_index iso_name 1 gs_predefs gs_heaps buildIsoRecord iso_def_sym iso_group_index from_def_sym to_def_sym gs @@ -1258,7 +1271,7 @@ where #! gtd_infos = {gtd_infos & [gi_module, gi_index] = gtd_info} = update_group group_index type_def_global_indexes gtd_infos -/// ... Sjaak + buildIsomapsForGenerics :: !*GenericState -> (![FunDef], ![Group], !*GenericState) buildIsomapsForGenerics gs @@ -1347,13 +1360,14 @@ where #! (fun_def, fun_def_sym, gs) = build_instance_fun instance_def gs #! instance_def = { instance_def & ins_members = {fun_def_sym} } #! instance_defs = {instance_defs & [instance_index] = instance_def} - # (dcl_fun_index, gs) = get_dcl_member_index instance_index gs with get_dcl_member_index icl_instance_index gs=:{gs_dcl_modules, gs_main_dcl_module_n} # ({dcl_conversions, dcl_common}, gs_dcl_modules) = gs_dcl_modules![gs_main_dcl_module_n] # gs = {gs & gs_dcl_modules = gs_dcl_modules} - # dcl_index = case dcl_conversions of +// # dcl_index = case dcl_conversions of + # dcl_index = NoIndex +/* No -> NoIndex Yes conversion_table # instance_table = conversion_table.[cInstanceDefs] @@ -1364,6 +1378,7 @@ where # dcl_instance = dcl_common.com_instance_defs.[dcl_instance_index] # dcl_index = dcl_instance.ins_members.[0].ds_index -> dcl_index +*/ = (dcl_index, gs) where find_dcl_instance_index icl_instance_index index instance_table @@ -1377,10 +1392,10 @@ where # gs = case dcl_fun_index of NoIndex -> gs _ - # gs = update_dcl_icl_conversions dcl_fun_index fun_def_sym.ds_index gs - # gs = update_dcl_fun_conversions module_index dcl_fun_index fun_def_sym.ds_index gs +// # gs = update_dcl_icl_conversions dcl_fun_index fun_def_sym.ds_index gs +// # gs = update_dcl_fun_conversions module_index dcl_fun_index fun_def_sym.ds_index gs -> gs - with +/* with update_dcl_icl_conversions dcl_index icl_index gs=:{gs_opt_dcl_icl_conversions=No} = gs update_dcl_icl_conversions dcl_index icl_index gs=:{gs_opt_dcl_icl_conversions=Yes cs} @@ -1406,7 +1421,7 @@ where -> Yes table # dcl_module = { dcl_module & dcl_conversions = dcl_conversions} = {gs & gs_dcl_modules = {gs_dcl_modules & [module_index] = dcl_module }} - +*/ = ([fun_def], [{group_members = [fun_def_sym.ds_index]}], instance_defs, gs) | supportPartialInstances && instance_def.ins_partial @@ -1442,7 +1457,7 @@ where , fun_info = { ins_fun_def.fun_info & fi_calls = - [ {fc_level = NotALevel, fc_index = gen_fun_ds.ds_index} + [ FunCall gen_fun_ds.ds_index NotALevel : ins_fun_def.fun_info.fi_calls ] } } @@ -3293,10 +3308,10 @@ makeFunction {ds_index, ds_arity, ds_ident} group_index arg_vars body_expr opt_s }, fun_type = opt_sym_type, fun_pos = fun_pos, - fun_kind = FK_ImpFunction cNameNotLocationDependent, + fun_kind = FK_Function cNameNotLocationDependent, fun_lifted = 0, fun_info = { - fi_calls = [{fc_level = NotALevel, fc_index = ind} \\ ind <- fun_call_indexes], + fi_calls = [FunCall ind NotALevel \\ ind <- fun_call_indexes], fi_group_index = group_index, fi_def_level = NotALevel, fi_free_vars = [], @@ -3838,4 +3853,3 @@ unzip3 [(x1,x2,x3):xs] reportError name pos msg error = checkErrorWithIdentPos (newPosition name pos) msg error -
\ No newline at end of file diff --git a/frontend/overloading.icl b/frontend/overloading.icl index e72560f..d3ac1fd 100644 --- a/frontend/overloading.icl +++ b/frontend/overloading.icl @@ -1260,7 +1260,7 @@ where , x_module_id :: Optional LetBind // ... MV } - + class updateExpression e :: !Index !e !*UpdateInfo -> (!e, !*UpdateInfo) instance updateExpression Expression @@ -1357,12 +1357,12 @@ where = ui where add_call fun_num [] - = [{ fc_level = 0, fc_index = fun_num }] - add_call fun_num funs=:[call=:{fc_index} : ui] + = [FunCall fun_num 0] + add_call fun_num funs=:[call=:(FunCall fc_index _) : ui] | fun_num == fc_index = funs | fun_num < fc_index - = [{ fc_level = 0, fc_index = fun_num } : funs] + = [FunCall fun_num 0 : funs] = [call : add_call fun_num ui] examine_calls [expr : exprs] ui @@ -1738,10 +1738,6 @@ instance <<< TypeContext where (<<<) file tc = file <<< tc.tc_class.glob_object.ds_ident <<< ' ' <<< tc.tc_types <<< " <" <<< tc.tc_var <<< '>' -instance <<< FunCall -where - (<<<) file {fc_index} = file <<< fc_index - instance <<< Special where (<<<) file {spec_types} = file <<< spec_types diff --git a/frontend/postparse.dcl b/frontend/postparse.dcl index 95d9b21..c437224 100644 --- a/frontend/postparse.dcl +++ b/frontend/postparse.dcl @@ -4,5 +4,5 @@ import StdEnv import syntax, parse, predef -scanModule :: !ParsedModule ![Ident] !Int !Bool !*HashTable !*File !SearchPaths !*PredefinedSymbols (ModTimeFunction *Files) !*Files +scanModule :: !ParsedModule ![Ident] !Bool !*HashTable !*File !SearchPaths !*PredefinedSymbols (ModTimeFunction *Files) !*Files -> (!Bool, !ScannedModule, !IndexRange, ![FunDef], !Optional ScannedModule, ![ScannedModule],!Int,!Int,!*HashTable, !*File, !*PredefinedSymbols, !*Files) diff --git a/frontend/postparse.icl b/frontend/postparse.icl index b6f7f64..1e3ce71 100644 --- a/frontend/postparse.icl +++ b/frontend/postparse.icl @@ -1,7 +1,7 @@ implementation module postparse import StdEnv -import syntax, parse, predef, utilities, StdCompare +import syntax, parse, utilities, StdCompare // import RWSDebug :: *CollectAdmin = @@ -120,8 +120,8 @@ addFunctionsRange fun_defs ca , ca_rev_fun_defs = [fun_def : ca.ca_rev_fun_defs] } -MakeNewImpOrDefFunction icl_module name arity body kind prio opt_type pos - :== { fun_symb = name, fun_arity = arity, fun_priority = prio, fun_type = opt_type, fun_kind = fun_kind_to_def_or_imp_fun_kind icl_module kind, +MakeNewImpOrDefFunction name arity body kind prio opt_type pos + :== { fun_symb = name, fun_arity = arity, fun_priority = prio, fun_type = opt_type, fun_kind = kind, fun_body = ParsedBody body, fun_pos = pos, fun_lifted = 0, fun_info = EmptyFunInfo } class collectFunctions a :: a Bool !*CollectAdmin -> (a, !*CollectAdmin) @@ -136,8 +136,8 @@ where = (PE_Bound bound_expr, ca) collectFunctions (PE_Lambda lam_ident args res pos) icl_module ca # ((args,res), ca) = collectFunctions (args,res) icl_module ca - # (range, ca) = addFunctionsRange [transformLambda lam_ident args res pos icl_module] ca - = (PE_Let cIsStrict (CollectedLocalDefs { loc_functions = range, loc_nodes = [] }) + # (range, ca) = addFunctionsRange [transformLambda lam_ident args res pos] ca + = (PE_Let cIsStrict (CollectedLocalDefs { loc_functions = range, loc_nodes = [], loc_in_icl_module=icl_module }) (PE_Ident lam_ident), ca) collectFunctions (PE_Record rec_expr type_name fields) icl_module ca # ((rec_expr,fields), ca) = collectFunctions (rec_expr,fields) icl_module ca @@ -288,7 +288,7 @@ where (node_defs, ca) = collect_functions_in_node_defs node_defs ca (fun_defs, ca) = collectFunctions fun_defs icl_module ca (range, ca) = addFunctionsRange fun_defs ca - = (CollectedLocalDefs { loc_functions = range, loc_nodes = node_defs }, ca) + = (CollectedLocalDefs { loc_functions = range, loc_nodes = node_defs, loc_in_icl_module=icl_module }, ca) where reorganiseLocalDefinitions :: [ParsedDefinition] *CollectAdmin -> ([FunDef],[NodeDef ParsedExpr],*CollectAdmin) reorganiseLocalDefinitions [PD_NodeDef pos pattern {rhs_alts,rhs_locals} : defs] ca @@ -299,7 +299,7 @@ where fun_arity = length args (bodies, fun_kind, defs, ca) = collectFunctionBodies name fun_arity prio fun_kind defs ca (fun_defs, node_defs, ca) = reorganiseLocalDefinitions defs ca - fun = MakeNewImpOrDefFunction icl_module name fun_arity [{ pb_args = args, pb_rhs = rhs, pb_position = pos } : bodies ] fun_kind prio No pos + fun = MakeNewImpOrDefFunction name fun_arity [{ pb_args = args, pb_rhs = rhs, pb_position = pos } : bodies ] fun_kind prio No pos = ([ fun : fun_defs ], node_defs, ca) reorganiseLocalDefinitions [PD_TypeSpec pos1 name1 prio type specials : defs] ca = case defs of @@ -308,7 +308,7 @@ where # fun_arity = determineArity args type # (bodies, fun_kind, defs, ca) = collectFunctionBodies name1 fun_arity prio fun_kind defs ca (fun_defs, node_defs, ca) = reorganiseLocalDefinitions defs ca - fun = MakeNewImpOrDefFunction icl_module name fun_arity bodies fun_kind prio type pos1 + fun = MakeNewImpOrDefFunction name fun_arity bodies fun_kind prio type pos1 -> ([fun : fun_defs], node_defs, ca) -> reorganiseLocalDefinitions defs (postParseError pos "function body expected" ca) [PD_NodeDef pos pattern=:(PE_Ident id) rhs : defs] @@ -317,7 +317,7 @@ where | arity type<>0 -> reorganiseLocalDefinitions defs (postParseError pos "this alternative has not enough arguments" ca) # (fun_defs, node_defs, ca) = reorganiseLocalDefinitions defs ca - fun = MakeNewImpOrDefFunction icl_module id 0 + fun = MakeNewImpOrDefFunction id 0 [{ pb_args = [], pb_rhs = rhs, pb_position = pos }] (FK_Function cNameNotLocationDependent) prio type pos1 -> ([fun : fun_defs], node_defs, ca) @@ -367,14 +367,14 @@ instance collectFunctions ParsedBody where # (pb_rhs, ca) = collectFunctions pb_rhs icl_module ca = ({ pb & pb_rhs = pb_rhs }, ca) -NoCollectedLocalDefs :== CollectedLocalDefs { loc_functions = { ir_from = 0, ir_to = 0 }, loc_nodes = [] } +NoCollectedLocalDefs :== CollectedLocalDefs { loc_functions = { ir_from = 0, ir_to = 0 }, loc_nodes = [], loc_in_icl_module=True } -transformLambda :: Ident [ParsedExpr] ParsedExpr Position Bool -> FunDef -transformLambda lam_ident args result pos icl_module +transformLambda :: Ident [ParsedExpr] ParsedExpr Position -> FunDef +transformLambda lam_ident args result pos # lam_rhs = { rhs_alts = UnGuardedExpr { ewl_nodes = [], ewl_expr = result, ewl_locals = NoCollectedLocalDefs, ewl_position = NoPos }, rhs_locals = NoCollectedLocalDefs } lam_body = [{pb_args = args, pb_rhs = lam_rhs, pb_position = pos }] - = MakeNewImpOrDefFunction icl_module lam_ident (length args) lam_body (FK_Function cNameLocationDependent) NoPrio No pos + = MakeNewImpOrDefFunction lam_ident (length args) lam_body (FK_Function cNameLocationDependent) NoPrio No pos makeConsExpressionForGenerator :: GeneratorKind ParsedExpr ParsedExpr *CollectAdmin -> (ParsedExpr,*CollectAdmin) makeConsExpressionForGenerator gen_kind a1 a2 ca=:{ca_predefs} @@ -1002,9 +1002,9 @@ transformArrayDenot exprs pi [{bind_dst=toParsedExpr i pi, bind_src=expr} \\ expr <- exprs & i <- [0..]] pi -scanModules :: [ParsedImport] [ScannedModule] [Ident] SearchPaths Bool (ModTimeFunction *Files) *Files *CollectAdmin -> (Bool, [ScannedModule], *Files, *CollectAdmin) -scanModules [] parsed_modules cached_modules searchPaths support_generics _ files ca - = (True, parsed_modules, files, ca) +scanModules :: [ParsedImport] [ScannedModule] [Ident] SearchPaths Bool (ModTimeFunction *Files) *Files *CollectAdmin -> (Bool, [ScannedModule],*Files, *CollectAdmin) +scanModules [] parsed_modules cached_modules searchPaths support_generics modtimefunction files ca + = (True, parsed_modules,files, ca) scanModules [{import_module,import_symbols,import_file_position} : mods] parsed_modules cached_modules searchPaths support_generics modtimefunction files ca | in_cache import_module cached_modules = scanModules mods parsed_modules cached_modules searchPaths support_generics modtimefunction files ca @@ -1017,11 +1017,11 @@ scanModules [{import_module,import_symbols,import_file_position} : mods] parsed_ -> (False,parsed_modules,files,ca) _ -> scanModules mods parsed_modules cached_modules searchPaths support_generics modtimefunction files ca - # (succ, parsed_modules, files, ca) + # (succ, parsed_modules,files, ca) = parseAndScanDclModule import_module import_file_position parsed_modules cached_modules searchPaths support_generics modtimefunction files ca - (mods_succ, parsed_modules, files, ca) + (mods_succ, parsed_modules,files, ca) = scanModules mods parsed_modules cached_modules searchPaths support_generics modtimefunction files ca - = (succ && mods_succ, parsed_modules, files, ca) + = (succ && mods_succ, parsed_modules,files, ca) where in_cache mod_id [] = False @@ -1040,45 +1040,40 @@ where MakeEmptyModule name mod_type :== { mod_name = name, mod_modification_time = "", mod_type = mod_type, mod_imports = [], mod_imported_objects = [], mod_defs = - { def_types = [], def_constructors = [], def_selectors = [], def_classes = [], def_macros = { ir_from = 0, ir_to = 0 }, - def_members = [], def_funtypes = [], def_instances = [], /* AA */ def_generics = [] } } + { def_types = [], def_constructors = [], def_selectors = [], def_classes = [], def_macro_indices={ir_from=0,ir_to=0}, + def_macros=[],def_members = [], def_funtypes = [], def_instances = [], def_generics = [] } } parseAndScanDclModule :: !Ident !Position ![ScannedModule] ![Ident] !SearchPaths !Bool (ModTimeFunction *Files) !*Files !*CollectAdmin - -> *(!Bool, ![ScannedModule], !*Files, !*CollectAdmin) + -> *(!Bool, ![ScannedModule],!*Files, !*CollectAdmin) parseAndScanDclModule dcl_module import_file_position parsed_modules cached_modules searchPaths support_generics modtimefunction files ca - # {ca_error, ca_fun_count, ca_rev_fun_defs, ca_predefs, ca_u_predefs, ca_hash_table} - = ca - hash_table = ca_hash_table - pea_file = ca_error.pea_file - predefs = ca_u_predefs - # (parse_ok, mod, hash_table, err_file, predefs, files) = wantModule cWantDclFile dcl_module import_file_position support_generics hash_table pea_file searchPaths predefs modtimefunction files - # ca = {ca_hash_table=hash_table, ca_error={pea_file=err_file,pea_ok=True}, ca_u_predefs=predefs, ca_fun_count=ca_fun_count, ca_rev_fun_defs=ca_rev_fun_defs, ca_predefs=ca_predefs} + # {ca_error, ca_u_predefs, ca_hash_table} = ca + # (parse_ok, mod, ca_hash_table, err_file, ca_u_predefs, files) = wantModule cWantDclFile dcl_module import_file_position support_generics ca_hash_table ca_error.pea_file searchPaths ca_u_predefs modtimefunction files + # ca = {ca & ca_hash_table=ca_hash_table, ca_error={pea_file=err_file,pea_ok=True}, ca_u_predefs=ca_u_predefs } | parse_ok = scan_dcl_module mod parsed_modules searchPaths modtimefunction files ca - = (False, [MakeEmptyModule mod.mod_name MK_None: parsed_modules], files, ca) + = (False, [MakeEmptyModule mod.mod_name MK_None: parsed_modules],files, ca) where - scan_dcl_module :: ParsedModule [ScannedModule] !SearchPaths (ModTimeFunction *Files) *Files *CollectAdmin -> (Bool, [ScannedModule], *Files, *CollectAdmin) + scan_dcl_module :: ParsedModule [ScannedModule] !SearchPaths (ModTimeFunction *Files) *Files *CollectAdmin -> (Bool, [ScannedModule],*Files, *CollectAdmin) scan_dcl_module mod=:{mod_defs = pdefs} parsed_modules searchPaths modtimefunction files ca # (_, defs, imports, imported_objects, ca) - = reorganiseDefinitions False pdefs 0 0 0 0 ca - (macro_defs, ca) - = collectFunctions defs.def_macros False ca - (range, ca) - = addFunctionsRange macro_defs ca - (pea_ok,ca) - = ca!ca_error.pea_ok - mod - = { mod & mod_imports = imports, mod_imported_objects = imported_objects, mod_defs = { defs & def_macros = range }} - (import_ok, parsed_modules, files, ca) - = scanModules imports [mod : parsed_modules] cached_modules searchPaths support_generics modtimefunction files ca - = (pea_ok && import_ok, parsed_modules, files, ca) - -scanModule :: !ParsedModule ![Ident] !Int !Bool !*HashTable !*File !SearchPaths !*PredefinedSymbols (ModTimeFunction *Files) !*Files + = reorganiseDefinitions False pdefs 0 0 0 0 ca + (def_macros, ca) = collectFunctions defs.def_macros False {ca & ca_fun_count=0,ca_rev_fun_defs=[]} + (range, ca) = addFunctionsRange def_macros ca + (rev_fun_defs,ca) = ca!ca_rev_fun_defs + ca = {ca & ca_rev_fun_defs=[]} + (pea_ok,ca) = ca!ca_error.pea_ok + mod = { mod & mod_imports = imports, mod_imported_objects = imported_objects, mod_defs = { defs & def_macros=reverse rev_fun_defs,def_macro_indices = range }} + ca = {ca & ca_rev_fun_defs=[]} + (import_ok, parsed_modules,files, ca) + = scanModules imports [mod : parsed_modules] cached_modules searchPaths support_generics modtimefunction files ca + = (pea_ok && import_ok, parsed_modules,files, ca) + +scanModule :: !ParsedModule ![Ident] !Bool !*HashTable !*File !SearchPaths !*PredefinedSymbols (ModTimeFunction *Files) !*Files -> (!Bool, !ScannedModule, !IndexRange, ![FunDef], !Optional ScannedModule, ![ScannedModule],!Int,!Int,!*HashTable, !*File, !*PredefinedSymbols, !*Files) -scanModule mod=:{mod_name,mod_type,mod_defs = pdefs} cached_modules first_new_function_or_macro_index support_generics hash_table err_file searchPaths predefs modtimefunction files +scanModule mod=:{mod_name,mod_type,mod_defs = pdefs} cached_modules support_generics hash_table err_file searchPaths predefs modtimefunction files # (predefIdents, predefs) = SelectPredefinedIdents predefs # ca = { ca_error = {pea_file = err_file, pea_ok = True} - , ca_fun_count = first_new_function_or_macro_index + , ca_fun_count = 0 , ca_rev_fun_defs = [] , ca_predefs = predefIdents , ca_u_predefs = predefs @@ -1106,21 +1101,24 @@ scanModule mod=:{mod_name,mod_type,mod_defs = pdefs} cached_modules first_new_fu ca = {ca & ca_hash_table=set_hte_mark 1 ca.ca_hash_table} - (fun_defs, ca) = collectFunctions fun_defs True ca - (fun_range, ca) = addFunctionsRange fun_defs ca + n_global_functions = length fun_defs + + (fun_defs, ca) = collectFunctions fun_defs True {ca & ca_fun_count=n_global_functions,ca_rev_fun_defs=[]} +// (fun_range, ca) = addFunctionsRange fun_defs ca (macro_defs, ca) = collectFunctions defs.def_macros True ca (macro_range, ca) = addFunctionsRange macro_defs ca (def_instances, ca) = collectFunctions defs.def_instances True ca - ca = {ca & ca_hash_table=set_hte_mark 0 ca.ca_hash_table} - - (pea_ok, ca) = ca!ca_error.pea_ok - - { ca_error = {pea_file = err_file}, ca_predefs = predefs, ca_rev_fun_defs, ca_u_predefs, ca_hash_table = hash_table } = ca + { ca_error = {pea_file = err_file,pea_ok}, ca_predefs = predefs, ca_rev_fun_defs, ca_u_predefs, ca_hash_table } = ca mod = { mod & mod_imports = imports, mod_imported_objects = imported_objects, mod_defs = { defs & def_instances = def_instances, - def_macros = macro_range }} -// (pre_def_mod, ca_u_predefs) = buildPredefinedModule ca_u_predefs - = (reorganise_icl_ok && pea_ok && import_dcl_ok && import_dcls_ok, mod, fun_range, reverse ca_rev_fun_defs, optional_dcl_mod, /*pre_def_mod,*/ modules, dcl_module_n,n_functions_and_macros_in_dcl_modules,hash_table, err_file, ca_u_predefs, files) + def_macro_indices = macro_range }} + + hash_table = set_hte_mark 0 ca_hash_table + + fun_defs = fun_defs++reverse ca_rev_fun_defs + fun_range = {ir_from=0,ir_to=n_global_functions} + + = (reorganise_icl_ok && pea_ok && import_dcl_ok && import_dcls_ok, mod, fun_range, fun_defs, optional_dcl_mod, modules, dcl_module_n,n_functions_and_macros_in_dcl_modules,hash_table, err_file, ca_u_predefs, files) where scan_main_dcl_module :: Ident ModuleKind (ModTimeFunction *Files) *Files *CollectAdmin -> (!Bool,!Optional (Module (CollectedDefinitions (ParsedInstance FunDef) [FunDef])),!Int,![ScannedModule],![Ident],!*Files,!*CollectAdmin) scan_main_dcl_module mod_name MK_Main _ files ca @@ -1138,43 +1136,31 @@ where = in_cache (module_n+1) pmods | module_n_in_cache<>NoIndex = (True,No,module_n_in_cache,[],cached_modules,files,ca) - # {ca_error, ca_fun_count, ca_rev_fun_defs, ca_predefs, ca_u_predefs, ca_hash_table} = ca - hash_table = ca_hash_table - pea_file = ca_error.pea_file - predefs = ca_u_predefs - # (parse_ok, mod, hash_table, err_file, predefs, files) = wantModule cWantDclFile mod_name NoPos support_generics hash_table pea_file searchPaths predefs modtimefunction files - # ca = {ca_hash_table=hash_table, ca_error={pea_file=err_file,pea_ok=True}, ca_u_predefs=predefs, ca_fun_count=ca_fun_count, ca_rev_fun_defs=ca_rev_fun_defs, ca_predefs=ca_predefs} + # {ca_error, ca_u_predefs, ca_hash_table} = ca + # (parse_ok, mod, hash_table, err_file, predefs, files) = wantModule cWantDclFile mod_name NoPos support_generics ca_hash_table ca_error.pea_file searchPaths ca_u_predefs modtimefunction files + # ca = {ca & ca_hash_table=hash_table, ca_error={pea_file=err_file,pea_ok=True}, ca_u_predefs=predefs} | not parse_ok = (False, No,NoIndex, [],cached_modules, files, ca) # pdefs = mod.mod_defs - # (_, defs, imports, imported_objects, ca) = reorganiseDefinitions False pdefs 0 0 0 0 ca + # (_, defs, imports, imported_objects, ca) = reorganiseDefinitions False pdefs 0 0 0 0 ca # mod = { mod & mod_imports = imports, mod_imported_objects = imported_objects, mod_defs = defs} # cached_modules = [mod.mod_name:cached_modules] - # (import_ok, parsed_modules, files, ca) = scanModules imports [] cached_modules searchPaths support_generics modtimefunction files ca + # (import_ok, parsed_modules,files, ca) = scanModules imports [] cached_modules searchPaths support_generics modtimefunction files ca = (import_ok, Yes mod, NoIndex,parsed_modules, cached_modules,files, ca) collect_main_dcl_module (Yes mod=:{mod_defs=defs}) dcl_module_n ca - # (macro_defs, ca) = collectFunctions defs.def_macros False ca - (range, ca) = addFunctionsRange macro_defs ca - (pea_ok,ca) = ca!ca_error.pea_ok - mod = { mod & mod_defs = { defs & def_macros = range }} + # (macro_defs, ca) = collectFunctions defs.def_macros False {ca & ca_fun_count=0,ca_rev_fun_defs=[]} + (range, ca) = addFunctionsRange macro_defs ca + (rev_fun_defs,ca) = ca!ca_rev_fun_defs + ca = {ca & ca_rev_fun_defs=[]} + (pea_ok,ca) = ca!ca_error.pea_ok + mod = { mod & mod_defs = { defs & def_macros=reverse rev_fun_defs,def_macro_indices = range }} = (pea_ok,Yes mod,ca) collect_main_dcl_module No dcl_module_n ca | dcl_module_n==NoIndex = (True,Yes (MakeEmptyModule mod_name MK_None),ca) = (True,No,ca) -fun_kind_to_def_or_imp_fun_kind icl_module (FK_Function b) - | icl_module - = FK_ImpFunction b - = FK_DefFunction b -fun_kind_to_def_or_imp_fun_kind icl_module FK_Macro - | icl_module - = FK_ImpMacro - = FK_DefMacro -fun_kind_to_def_or_imp_fun_kind icl_module FK_Caf = FK_ImpCaf -fun_kind_to_def_or_imp_fun_kind icl_module FK_Unknown = FK_DefOrImpUnknown - MakeNewParsedDef ident args rhs pos :== PD_Function pos ident False args rhs (FK_Function cNameLocationDependent) @@ -1210,7 +1196,7 @@ reorganiseDefinitions icl_module [PD_Function pos name is_infix args rhs fun_kin fun_arity = length args (bodies, fun_kind, defs, ca) = collectFunctionBodies name fun_arity prio fun_kind defs ca (fun_defs, c_defs, imports, imported_objects, ca) = reorganiseDefinitions icl_module defs cons_count sel_count mem_count type_count ca - fun = MakeNewImpOrDefFunction icl_module name fun_arity [{ pb_args = args, pb_rhs = rhs, pb_position = pos } : bodies] fun_kind prio No pos + fun = MakeNewImpOrDefFunction name fun_arity [{ pb_args = args, pb_rhs = rhs, pb_position = pos } : bodies] fun_kind prio No pos | fun_kind == FK_Macro = (fun_defs, { c_defs & def_macros = [ fun : c_defs.def_macros ]}, imports, imported_objects, ca) = ([ fun : fun_defs ], c_defs, imports, imported_objects, ca) @@ -1225,7 +1211,7 @@ reorganiseDefinitions icl_module [PD_TypeSpec fun_pos fun_name prio No specials # fun_arity = length args (bodies, fun_kind, defs, ca) = collectFunctionBodies name fun_arity prio fun_kind defs ca (fun_defs, c_defs, imports, imported_objects, ca) = reorganiseDefinitions icl_module defs cons_count sel_count mem_count type_count ca - fun = MakeNewImpOrDefFunction icl_module name fun_arity [{ pb_args = args, pb_rhs = rhs, pb_position = pos } : bodies ] fun_kind prio No fun_pos + fun = MakeNewImpOrDefFunction name fun_arity [{ pb_args = args, pb_rhs = rhs, pb_position = pos } : bodies ] fun_kind prio No fun_pos | fun_kind == FK_Macro -> (fun_defs, { c_defs & def_macros = [ fun : c_defs.def_macros]}, imports, imported_objects, ca) -> ([ fun : fun_defs ], c_defs, imports, imported_objects, ca) @@ -1241,7 +1227,7 @@ reorganiseDefinitions icl_module [PD_TypeSpec pos name prio (Yes fun_type=:{st_a | icl_module = (fun_defs, c_defs, imports, imported_objects, postParseError pos "function body expected" ca) = (fun_defs, c_defs, imports, imported_objects, ca) - # fun = MakeNewImpOrDefFunction icl_module name fun_type.st_arity bodies fun_kind prio (Yes fun_type) pos + # fun = MakeNewImpOrDefFunction name fun_type.st_arity bodies fun_kind prio (Yes fun_type) pos | icl_module = ([fun : fun_defs], c_defs, imports, imported_objects, ca) = ([fun : fun_defs], c_defs, imports, imported_objects, postParseError pos "function body not allowed in definition module" ca) @@ -1308,7 +1294,7 @@ where me_offset = NoIndex, me_class_vars = [], me_class = { glob_module = NoIndex, glob_object = NoIndex}, me_type_ptr = nilPtr } ( mem_defs, mem_macros, ca) = check_symbols_of_class_members defs type_context ca = ([mem_def : mem_defs], mem_macros, ca) - # macro = MakeNewImpOrDefFunction icl_module name st_arity bodies FK_Macro prio opt_type pos + # macro = MakeNewImpOrDefFunction name st_arity bodies FK_Macro prio opt_type pos (mem_defs, mem_macros,ca) = check_symbols_of_class_members defs type_context ca = (mem_defs, [macro : mem_macros], ca) check_symbols_of_class_members [PD_TypeSpec fun_pos fun_name prio No specials : defs] type_context ca @@ -1318,7 +1304,7 @@ where # fun_arity = length args (bodies, fun_kind, defs, ca) = collectFunctionBodies name fun_arity prio fun_kind defs ca (mem_defs, mem_macros, ca) = check_symbols_of_class_members defs type_context ca - macro = MakeNewImpOrDefFunction icl_module name fun_arity bodies FK_Macro prio No fun_pos + macro = MakeNewImpOrDefFunction name fun_arity bodies FK_Macro prio No fun_pos -> (mem_defs, [macro : mem_macros], ca) -> check_symbols_of_class_members defs type_context (postParseError fun_pos "macro body expected" ca) _ @@ -1328,7 +1314,7 @@ where fun_arity = length args (bodies, fun_kind, defs, ca) = collectFunctionBodies name fun_arity prio fun_kind defs ca (mem_defs, mem_macros, ca) = check_symbols_of_class_members defs type_context ca - macro = MakeNewImpOrDefFunction icl_module name fun_arity [{ pb_args = args, pb_rhs = rhs, pb_position = fun_pos } : bodies] FK_Macro prio No fun_pos + macro = MakeNewImpOrDefFunction name fun_arity [{ pb_args = args, pb_rhs = rhs, pb_position = fun_pos } : bodies] FK_Macro prio No fun_pos = (mem_defs, [macro : mem_macros], ca) check_symbols_of_class_members [def : _] type_context ca = abort "postparse.check_symbols_of_class_members: unknown def" // <<- def @@ -1362,7 +1348,7 @@ where prio = if is_infix (Prio NoAssoc 9) NoPrio (bodies, fun_kind, defs, ca) = collectFunctionBodies name fun_arity prio fun_kind defs ca (fun_defs, ca) = collect_member_instances defs ca - fun = MakeNewImpOrDefFunction icl_module name fun_arity [{ pb_args = args, pb_rhs = rhs, pb_position = pos } : bodies ] fun_kind prio No pos + fun = MakeNewImpOrDefFunction name fun_arity [{ pb_args = args, pb_rhs = rhs, pb_position = pos } : bodies ] fun_kind prio No pos = ([ fun : fun_defs ], ca) collect_member_instances [PD_TypeSpec fun_pos fun_name prio type specials : defs] ca = case defs of @@ -1371,7 +1357,7 @@ where # fun_arity = determineArity args type (bodies, fun_kind, defs, ca) = collectFunctionBodies name fun_arity prio fun_kind defs ca (fun_defs, ca) = collect_member_instances defs ca - fun = MakeNewImpOrDefFunction icl_module name fun_arity bodies fun_kind prio type fun_pos + fun = MakeNewImpOrDefFunction name fun_arity bodies fun_kind prio type fun_pos -> ([ fun : fun_defs ], ca) _ -> collect_member_instances defs (postParseError fun_pos "function body expected" ca) @@ -1391,10 +1377,9 @@ reorganiseDefinitions icl_module [PD_ImportedObjects new_imported_objects : defs = (fun_defs, c_defs, imports, new_imported_objects ++ imported_objects, ca) reorganiseDefinitions icl_module [def:defs] _ _ _ _ ca = abort ("reorganiseDefinitions does not match" ---> def) - reorganiseDefinitions icl_module [] _ _ _ _ ca - = ([], { def_types = [], def_constructors = [], def_selectors = [], def_macros = [], def_classes = [], def_members = [], - def_instances = [], def_funtypes = [], /* AA */ def_generics = [] }, [], [], ca) + = ([], { def_types = [], def_constructors = [], def_selectors = [], def_macros = [],def_macro_indices={ir_from=0,ir_to=0},def_classes = [], def_members = [], + def_instances = [], def_funtypes = [], def_generics = [] }, [], [], ca) belongsToTypeSpec name prio new_name is_infix :== name == new_name && sameFixity prio is_infix diff --git a/frontend/predef.icl b/frontend/predef.icl index bc13c2b..a8fca82 100644 --- a/frontend/predef.icl +++ b/frontend/predef.icl @@ -446,8 +446,9 @@ buildPredefinedModule pre_def_symbols def_constructors = [cons_def,strict_cons_def,unboxed_cons_def,tail_strict_cons_def,strict_tail_strict_cons_def,unboxed_tail_strict_cons_def,overloaded_cons_def, nil_def,strict_nil_def,unboxed_nil_def,tail_strict_nil_def,strict_tail_strict_nil_def,unboxed_tail_strict_nil_def,overloaded_nil_def : cons_defs], def_selectors = [], def_classes = [class_def], - def_macros = { ir_from = 0, ir_to = 0 }, def_members = [member_def], def_funtypes = [alias_dummy_type], def_instances = [], /* AA */ def_generics = [] }}, pre_def_symbols) + def_macro_indices= { ir_from = 0, ir_to = 0 },def_macros=[],def_members = [member_def], def_funtypes = [alias_dummy_type], def_instances = [], def_generics = [] }}, pre_def_symbols) where + add_tuple_defs pre_mod_id tup_arity type_defs cons_defs pre_def_symbols | tup_arity >= 2 # (type_vars, pre_def_symbols) = make_type_vars tup_arity [] pre_def_symbols diff --git a/frontend/syntax.dcl b/frontend/syntax.dcl index 5de820b..32fc53e 100644 --- a/frontend/syntax.dcl +++ b/frontend/syntax.dcl @@ -26,9 +26,14 @@ instance toString Ident , ste_previous :: SymbolTableEntry } +:: FunctionOrMacroIndex = FunctionOrIclMacroIndex !Int | DclMacroIndex /*module_n*/ !Int /*macro_n_in_module*/ !Int; + +instance == FunctionOrMacroIndex + :: STE_BoundTypeVariable = { stv_count :: !Int, stv_attribute :: !TypeAttribute, stv_info_ptr :: !TypeVarInfoPtr } -:: STE_Kind = STE_FunctionOrMacro ![Index] +:: STE_Kind = STE_FunctionOrMacro ![FunctionOrMacroIndex] + | STE_DclMacroOrLocalMacroFunction ![FunctionOrMacroIndex] | STE_Type | STE_Constructor | STE_Selector ![Global Index] @@ -50,7 +55,7 @@ instance toString Ident | STE_DictType !CheckedTypeDef | STE_DictCons !ConsDef | STE_DictField !SelectorDef - | STE_Called ![Index] /* used during macro expansion to indicate that this function is called */ + | STE_Called ![FunctionOrMacroIndex] /* used during macro expansion to indicate that this function is called */ | STE_ExplImpSymbol !Int | STE_ExplImpComponentNrs ![ComponentNrAndIndex] ![Declaration] /* stores the numbers of all module components that import the symbol from @@ -100,11 +105,12 @@ instance toString Ident | TypeSpec !AType | EmptyRhs !BITVECT -:: CollectedDefinitions instance_kind macro_defs = +:: CollectedDefinitions instance_kind def_macros = { def_types :: ![TypeDef TypeRhs] , def_constructors :: ![ConsDef] , def_selectors :: ![SelectorDef] - , def_macros :: !macro_defs + , def_macros :: ![FunDef] + , def_macro_indices :: !IndexRange , def_classes :: ![ClassDef] , def_members :: ![MemberDef] , def_generics :: ![GenericDef] // AA @@ -134,6 +140,7 @@ NotALevel :== -1 :: CollectedLocalDefs = { loc_functions :: !IndexRange , loc_nodes :: ![NodeDef ParsedExpr] + , loc_in_icl_module :: !Bool // False for local functions in macros in dcl modules, otherwise True } :: NodeDef dst = @@ -167,8 +174,6 @@ cIsNotAFunction :== False :: FunKind = FK_Function !Bool | FK_Macro | FK_Caf | FK_Unknown -:: DefOrImpFunKind = FK_DefFunction !Bool| FK_ImpFunction !Bool | FK_DefMacro | FK_ImpMacro | FK_ImpCaf | FK_DefOrImpUnknown - cNameNotLocationDependent :== False cNameLocationDependent :== True @@ -429,10 +434,12 @@ cIsAnalysed :== 4 , fv_count :: !Int } -:: FunCall = +:: FunCall = FunCall !Index !Level | MacroCall !Index !Index Level; +/* { fc_level :: !Level , fc_index :: !Index } +*/ /* Sjaak 19-3-2001 ... */ @@ -475,8 +482,8 @@ FI_HasTypeSpec :== 2 // whether the function has u user defined type :: FunctionBody = ParsedBody ![ParsedBody] | CheckedBody !CheckedBody /* The next three constructors are used during macro expansion (module transform) */ - | PartioningMacro - | PartioningFunction !CheckedBody !Int + | PartitioningMacro + | PartitioningFunction !CheckedBody !Int | RhsMacroBody !CheckedBody /* macro expansion transforms a CheckedBody into a TransformedBody */ | TransformedBody !TransformedBody @@ -496,7 +503,7 @@ FI_HasTypeSpec :== 2 // whether the function has u user defined type , fun_body :: !FunctionBody , fun_type :: !Optional SymbolType , fun_pos :: !Position - , fun_kind :: !DefOrImpFunKind + , fun_kind :: !FunKind , fun_lifted :: !Int , fun_info :: !FunInfo } @@ -528,7 +535,7 @@ pIsSafe :== True | AP_WildCard !OptionalVariable | AP_Empty !Ident -:: AP_Kind = APK_Constructor !Index | APK_Macro +:: AP_Kind = APK_Constructor !Index | APK_Macro !Bool // is_dcl_macro :: VarInfo = VI_Empty | VI_Type !AType !(Optional CoercionPosition) | VI_FAType ![ATypeVar] !AType !(Optional CoercionPosition) | VI_Occurrence !Occurrence | VI_UsedVar !Ident | @@ -621,13 +628,14 @@ cNonRecursiveAppl :== False :: SymbKind = SK_Unknown | SK_Function !(Global Index) + | SK_IclMacro !Index | SK_LocalMacroFunction !Index + | SK_DclMacro !(Global Index) + | SK_LocalDclMacroFunction !(Global Index) | SK_OverloadedFunction !(Global Index) - | SK_Generic !(Global Index) !TypeKind // AA - | SK_Constructor !(Global Index) - | SK_Macro !(Global Index) -// | SK_RecordSelector !(Global Index) | SK_GeneratedFunction !FunctionInfoPtr !Index + | SK_Constructor !(Global Index) + | SK_Generic !(Global Index) !TypeKind | SK_TypeCode /* Some auxiliary type definitions used during fusion. Actually, these definitions @@ -1291,10 +1299,7 @@ instance == TypeAttribute instance == Annotation instance == GlobalIndex -/* -ErrorToString :: Error -> String - -*/ +instance <<< FunCall EmptySymbolTableEntry :== EmptySymbolTableEntryCAF.boxed_symbol_table_entry diff --git a/frontend/syntax.icl b/frontend/syntax.icl index 1e9ad0b..55d7f7b 100644 --- a/frontend/syntax.icl +++ b/frontend/syntax.icl @@ -30,9 +30,18 @@ where toString {import_module} = toString import_module , ste_previous :: SymbolTableEntry } +:: FunctionOrMacroIndex = FunctionOrIclMacroIndex !Int | DclMacroIndex /*module_n*/ !Int /*macro_n_in_module*/ !Int; + +instance == FunctionOrMacroIndex + where + (==) (FunctionOrIclMacroIndex f1) (FunctionOrIclMacroIndex f2) = f1==f2 + (==) (DclMacroIndex m1 f1) (DclMacroIndex m2 f2) = m1==m2 && f1==f2 + (==) _ _ = False + :: STE_BoundTypeVariable = { stv_count :: !Int, stv_attribute :: !TypeAttribute, stv_info_ptr :: !TypeVarInfoPtr } -:: STE_Kind = STE_FunctionOrMacro ![Index] +:: STE_Kind = STE_FunctionOrMacro ![FunctionOrMacroIndex] + | STE_DclMacroOrLocalMacroFunction ![FunctionOrMacroIndex] | STE_Type | STE_Constructor | STE_Selector ![Global Index] @@ -53,7 +62,7 @@ where toString {import_module} = toString import_module | STE_DictType !CheckedTypeDef | STE_DictCons !ConsDef | STE_DictField !SelectorDef - | STE_Called ![Index] /* used during macro expansion to indicate that this function is called */ + | STE_Called ![FunctionOrMacroIndex] /* used during macro expansion to indicate that this function is called */ | STE_ExplImpSymbol !Int | STE_ExplImpComponentNrs ![ComponentNrAndIndex] ![Declaration] | STE_BelongingSymbol !Int @@ -97,11 +106,12 @@ where toString {import_module} = toString import_module | TypeSpec !AType | EmptyRhs !BITVECT -:: CollectedDefinitions instance_kind macro_defs = +:: CollectedDefinitions instance_kind def_macros = { def_types :: ![TypeDef TypeRhs] , def_constructors :: ![ConsDef] , def_selectors :: ![SelectorDef] - , def_macros :: !macro_defs + , def_macros :: ![FunDef] + , def_macro_indices :: !IndexRange , def_classes :: ![ClassDef] , def_members :: ![MemberDef] , def_generics :: ![GenericDef] // AA @@ -123,13 +133,13 @@ where toString {import_module} = toString import_module :: Index :== Int NoIndex :== -1 - :: Level :== Int NotALevel :== -1 :: CollectedLocalDefs = { loc_functions :: !IndexRange , loc_nodes :: ![NodeDef ParsedExpr] + , loc_in_icl_module :: !Bool // False for local functions in macros in dcl modules, otherwise True } :: NodeDef dst = @@ -162,8 +172,6 @@ cIsNotAFunction :== False :: FunKind = FK_Function !Bool | FK_Macro | FK_Caf | FK_Unknown -:: DefOrImpFunKind = FK_DefFunction !Bool| FK_ImpFunction !Bool | FK_DefMacro | FK_ImpMacro | FK_ImpCaf | FK_DefOrImpUnknown - cNameNotLocationDependent :== False cNameLocationDependent :== True @@ -421,10 +429,7 @@ where , fv_count :: !Int } -:: FunCall = - { fc_level :: !Level - , fc_index :: !Index - } +:: FunCall = FunCall !Index !Level | MacroCall !Index !Index Level; /* Sjaak 19-3-2001 ... */ @@ -467,8 +472,8 @@ FI_HasTypeSpec :== 2 // whether the function has u user defined type :: FunctionBody = ParsedBody ![ParsedBody] | CheckedBody !CheckedBody /* The next three constructors are used during macro expansion (module transform) */ - | PartioningMacro - | PartioningFunction !CheckedBody !Int + | PartitioningMacro + | PartitioningFunction !CheckedBody !Int | RhsMacroBody !CheckedBody /* macro expansion the transforms a CheckedBody into a TransformedBody */ | TransformedBody !TransformedBody @@ -488,9 +493,8 @@ FI_HasTypeSpec :== 2 // whether the function has u user defined type , fun_body :: !FunctionBody , fun_type :: !Optional SymbolType , fun_pos :: !Position - , fun_kind :: !DefOrImpFunKind + , fun_kind :: !FunKind , fun_lifted :: !Int -// , fun_type_ptr :: !TypeVarInfoPtr , fun_info :: !FunInfo } @@ -521,7 +525,7 @@ pIsSafe :== True | AP_WildCard !OptionalVariable | AP_Empty !Ident -:: AP_Kind = APK_Constructor !Index | APK_Macro +:: AP_Kind = APK_Constructor !Index | APK_Macro !Bool // is_dcl_macro :: VarInfo = VI_Empty | VI_Type !AType !(Optional CoercionPosition) | VI_FAType ![ATypeVar] !AType !(Optional CoercionPosition) | VI_Occurrence !Occurrence | VI_UsedVar !Ident | @@ -607,13 +611,14 @@ cNotVarNumber :== -1 :: SymbKind = SK_Unknown | SK_Function !(Global Index) + | SK_IclMacro !Index | SK_LocalMacroFunction !Index + | SK_DclMacro !(Global Index) + | SK_LocalDclMacroFunction !(Global Index) | SK_OverloadedFunction !(Global Index) - | SK_Generic !(Global Index) !TypeKind // AA - | SK_Constructor !(Global Index) - | SK_Macro !(Global Index) -// | SK_RecordSelector !(Global Index) | SK_GeneratedFunction !FunctionInfoPtr !Index + | SK_Constructor !(Global Index) + | SK_Generic !(Global Index) !TypeKind | SK_TypeCode // MW2 moved some type definitions @@ -1464,9 +1469,11 @@ where (<<<) file symb=:{symb_kind = SK_Function symb_index } = file <<< symb.symb_name <<< '@' <<< symb_index (<<<) file symb=:{symb_kind = SK_LocalMacroFunction symb_index } - = file <<< symb.symb_name <<< '@' <<< symb_index + = file <<< symb.symb_name <<< "[lm]@" <<< symb_index (<<<) file symb=:{symb_kind = SK_GeneratedFunction _ symb_index } - = file <<< symb.symb_name <<< '@' <<< symb_index + = file <<< symb.symb_name <<< "[g]@" <<< symb_index + (<<<) file symb=:{symb_kind = SK_LocalDclMacroFunction symb_index } + = file <<< symb.symb_name <<< "[ldm]@" <<< symb_index (<<<) file symb=:{symb_kind = SK_OverloadedFunction symb_index } = file <<< symb.symb_name <<< "[o]@" <<< symb_index (<<<) file symb @@ -1758,6 +1765,8 @@ where (<<<) file {fun_symb,fun_body=NoBody,fun_type=Yes type} = file // <<< type <<< '\n' <<< fun_symb <<< '.' <<< "Array function\n" + (<<<) file {fun_symb} = file <<< fun_symb <<< "???" <<< '\n' + instance <<< FunctionBody where (<<<) file (ParsedBody bodies) = file <<< bodies @@ -1769,8 +1778,10 @@ where instance <<< FunCall where - (<<<) file { fc_level,fc_index } + (<<<) file (FunCall fc_index fc_level) = file <<< fc_index <<< '.' <<< fc_level + (<<<) file (MacroCall module_index fc_index fc_level) + = file <<< "MacroCall "<<< module_index <<<" "<<<fc_index <<< '.' <<< fc_level instance <<< FreeVar where diff --git a/frontend/trans.icl b/frontend/trans.icl index 31fbe31..47616fc 100644 --- a/frontend/trans.icl +++ b/frontend/trans.icl @@ -47,6 +47,20 @@ where # (fd, fun_defs) = fun_defs![fun_index] # {fi_calls} = fd.fun_info (min_dep, fun_defs, pi) = visit_functions fi_calls max_fun_nr max_fun_nr fun_defs (push_on_dep_stack fun_index pi) + with + visit_functions :: ![FunCall] !Int !Int !*{# FunDef} !*PartitioningInfo -> *(!Int, !*{# FunDef}, !*PartitioningInfo) + visit_functions [FunCall fc_index _:funs] min_dep max_fun_nr fun_defs pi=:{pi_marks} + #! mark = pi_marks.[fc_index] + | mark == NotChecked + # (mark, fun_defs, pi) = partitionate_function fc_index max_fun_nr fun_defs pi + = visit_functions funs (min min_dep mark) max_fun_nr fun_defs pi + = visit_functions funs (min min_dep mark) max_fun_nr fun_defs pi + + visit_functions [MacroCall module_index fc_index _:funs] min_dep max_fun_nr fun_defs pi + = abort ("visit_functions "+++toString fd.fun_symb+++" "+++toString module_index+++" "+++toString fc_index) + + visit_functions [] min_dep max_fun_nr fun_defs pi + = (min_dep, fun_defs, pi) = try_to_close_group fun_index pi_next_num min_dep max_fun_nr fun_defs pi /* @@ -63,16 +77,6 @@ where push_on_dep_stack fun_index pi=:{pi_deps,pi_marks,pi_next_num} = { pi & pi_deps = [fun_index : pi_deps], pi_marks = { pi_marks & [fun_index] = pi_next_num}, pi_next_num = inc pi_next_num} - visit_functions :: ![FunCall] !Int !Int !*{# FunDef} !*PartitioningInfo -> *(!Int, !*{# FunDef}, !*PartitioningInfo) - visit_functions [{fc_index}:funs] min_dep max_fun_nr fun_defs pi=:{pi_marks} - #! mark = pi_marks.[fc_index] - | mark == NotChecked - # (mark, fun_defs, pi) = partitionate_function fc_index max_fun_nr fun_defs pi - = visit_functions funs (min min_dep mark) max_fun_nr fun_defs pi - = visit_functions funs (min min_dep mark) max_fun_nr fun_defs pi - visit_functions [] min_dep max_fun_nr fun_defs pi - = (min_dep, fun_defs, pi) - try_to_close_group :: !Int !Int !Int !Int !*{# FunDef} !*PartitioningInfo -> *(!Int, !*{# FunDef}, !*PartitioningInfo) try_to_close_group fun_index fun_nr min_dep max_fun_nr fun_defs pi=:{pi_marks, pi_deps, pi_groups, pi_next_group} @@ -316,17 +320,13 @@ instance consumerRequirements App where = reqs_of_args fun_class.cc_args app_args cPassive common_defs ai = consumerRequirements app_args common_defs ai - | glob_module==stdStrictLists_module_n && symb_arity>0 - # name=symb_name.id_name - | is_nil_cons_or_decons_of_UList_or_UTSList glob_object glob_module imported_funs -// && trace_tn ("consumerRequirements "+++name+++" "+++toString imported_funs.[glob_module].[glob_object].ft_type.st_arity) - # [app_arg:app_args]=app_args; - # (cc, _, ai) = consumerRequirements app_arg common_defs ai - # ai_class_subst = unifyClassifications cActive cc ai.ai_class_subst - # ai={ ai & ai_class_subst = ai_class_subst } - = consumerRequirements app_args common_defs ai - - = consumerRequirements app_args common_defs ai + | glob_module==stdStrictLists_module_n && symb_arity>0 && is_nil_cons_or_decons_of_UList_or_UTSList glob_object glob_module imported_funs +// && trace_tn ("consumerRequirements "+++symb_name.id_name+++" "+++toString imported_funs.[glob_module].[glob_object].ft_type.st_arity) + # [app_arg:app_args]=app_args; + # (cc, _, ai) = consumerRequirements app_arg common_defs ai + # ai_class_subst = unifyClassifications cActive cc ai.ai_class_subst + # ai={ ai & ai_class_subst = ai_class_subst } + = consumerRequirements app_args common_defs ai = consumerRequirements app_args common_defs ai consumerRequirements {app_symb={symb_kind = SK_LocalMacroFunction glob_object, symb_arity, symb_name}, app_args} common_defs=:(ConsumerAnalysisRO {main_dcl_module_n}) ai=:{ai_cons_class/*,ai_main_dcl_module_n*/} @@ -1168,7 +1168,7 @@ possibly_generate_case_function kees=:{case_info_ptr} aci=:{aci_free_vars} ro ti , fun_body = TransformedBody { tb_args = form_vars, tb_rhs = copied_expr} , fun_type = Yes fun_type , fun_pos = NoPos - , fun_kind = FK_ImpFunction cNameNotLocationDependent + , fun_kind = FK_Function cNameNotLocationDependent , fun_lifted = undeff , fun_info = { fi_calls = [] , fi_group_index = outer_fun_def.fun_info.fi_group_index @@ -1667,7 +1667,8 @@ generateFunction fd=:{fun_body = TransformedBody {tb_args,tb_rhs},fun_info = {fi = (ti_next_fun_nr, fun_arity, ti) where is_dictionary {at_type=TA {type_index} _} es_td_infos - = type_index.glob_object>=size es_td_infos.[type_index.glob_module] + #! td_infos_of_module=es_td_infos.[type_index.glob_module] + = type_index.glob_object>=size td_infos_of_module || td_infos_of_module.[type_index.glob_object].tdi_group_nr==(-1) is_dictionary _ es_td_infos = False @@ -3085,14 +3086,10 @@ where (<<<) file (SK_LocalMacroFunction gi) = file <<< gi (<<<) file (SK_OverloadedFunction gi) = file <<< "(SK_OverloadedFunction)" <<< gi (<<<) file (SK_Constructor gi) = file <<< gi - (<<<) file (SK_Macro gi) = file <<< gi + (<<<) file (SK_DclMacro gi) = file <<< gi + (<<<) file (SK_IclMacro gi) = file <<< gi (<<<) file (SK_GeneratedFunction _ gi) = file <<< "(SK_GeneratedFunction)" <<< gi (<<<) file _ = file - - -instance <<< FunCall -where - (<<<) file {fc_index} = file <<< fc_index instance <<< ConsClasses where diff --git a/frontend/transform.dcl b/frontend/transform.dcl index 77ff19d..0ef43f2 100644 --- a/frontend/transform.dcl +++ b/frontend/transform.dcl @@ -8,15 +8,16 @@ import syntax, checksupport :: PredefSymbolsForTransform = { predef_alias_dummy :: !PredefinedSymbol, predef_and :: !PredefinedSymbol, predef_or :: !PredefinedSymbol }; -partitionateAndLiftFunctions :: ![IndexRange] !Index !PredefSymbolsForTransform !*{# FunDef} !*{# DclModule} !*VarHeap !*ExpressionHeap !*SymbolTable !*ErrorAdmin - -> (!*{! Group}, !*{# FunDef}, !.{# DclModule}, !*VarHeap, !*ExpressionHeap, !*SymbolTable, !*ErrorAdmin ) +partitionateDclMacros :: !IndexRange !Index !PredefSymbolsForTransform !*{#FunDef} !*{#*{#FunDef}} !*{#DclModule} !*VarHeap !*ExpressionHeap !*SymbolTable !*ErrorAdmin + -> (!*{#FunDef},!*{#*{#FunDef}},!.{#DclModule},!*VarHeap,!*ExpressionHeap,!*SymbolTable,!*ErrorAdmin ) -partitionateMacros :: !IndexRange !Index !PredefSymbolsForTransform !*{# FunDef} !*{# DclModule} !*VarHeap !*ExpressionHeap !*SymbolTable !*ErrorAdmin - -> (!*{# FunDef}, !.{# DclModule}, !*VarHeap, !*ExpressionHeap, !*SymbolTable, !*ErrorAdmin ) +partitionateIclMacros :: !IndexRange !Index !PredefSymbolsForTransform !*{#FunDef} !*{#*{#FunDef}} !*{#DclModule} !*VarHeap !*ExpressionHeap !*SymbolTable !*ErrorAdmin + -> (!*{#FunDef},!*{#*{#FunDef}},!.{#DclModule},!*VarHeap,!*ExpressionHeap,!*SymbolTable,!*ErrorAdmin ) -:: CopiedLocalFunctions +partitionateAndLiftFunctions :: ![IndexRange] !Index !PredefSymbolsForTransform !*{#FunDef} !*{#*{#FunDef}} !*{#DclModule} !*VarHeap !*ExpressionHeap !*SymbolTable !*ErrorAdmin + -> (!*{!Group}, !*{#FunDef},!*{#*{#FunDef}},!.{#DclModule},!*VarHeap,!*ExpressionHeap,!*SymbolTable,!*ErrorAdmin ) -// AA.. +:: CopiedLocalFunctions :: CollectState = { cos_var_heap :: !.VarHeap @@ -28,8 +29,6 @@ partitionateMacros :: !IndexRange !Index !PredefSymbolsForTransform !*{# FunDef} determineVariablesAndRefCounts :: ![FreeVar] !Expression !*CollectState -> (!Expression , ![FreeVar], ![FreeVar], !*CollectState) -// ..AA - :: UnfoldState = { us_var_heap :: !.VarHeap , us_symbol_heap :: !.ExpressionHeap @@ -41,7 +40,7 @@ determineVariablesAndRefCounts :: ![FreeVar] !Expression !*CollectState -> (!Exp :: UnfoldInfo = { ui_handle_aci_free_vars :: !AciFreeVarHandleMode, ui_convert_module_n :: !Int, // -1 if no conversion - ui_conversion_table :: !Optional ConversionTable + ui_conversion_table :: !Optional {#Int} } :: AciFreeVarHandleMode = LeaveThem | RemoveThem | SubstituteThem diff --git a/frontend/transform.icl b/frontend/transform.icl index 389a27b..32c09f1 100644 --- a/frontend/transform.icl +++ b/frontend/transform.icl @@ -10,6 +10,7 @@ import syntax, check, StdCompare, utilities, mergecases; //, RWSDebug :: LiftStateX = { x_fun_defs :: !.{#FunDef}, + x_macro_defs :: !.{#.{#FunDef}}, x_main_dcl_module_n :: !Int } @@ -79,10 +80,7 @@ where lift (TupleSelect symbol argn_nr expr) ls # (expr, ls) = lift expr ls = (TupleSelect symbol argn_nr expr, ls) -/* lift (Lambda vars expr) ls - # (expr, ls) = lift expr ls - = (Lambda vars expr, ls) -*/ lift (MatchExpr opt_tuple cons_symb expr) ls + lift (MatchExpr opt_tuple cons_symb expr) ls # (expr, ls) = lift expr ls = (MatchExpr opt_tuple cons_symb expr, ls) lift expr ls @@ -99,45 +97,44 @@ where instance lift App where lift app=:{app_symb = app_symbol=:{symb_arity,symb_kind = SK_Function {glob_object,glob_module}}, app_args} ls - # (app_args, ls) = lift app_args ls | glob_module == ls.ls_x.LiftStateX.x_main_dcl_module_n - # (fun_def, ls) = ls!ls_x.x_fun_defs.[glob_object] - # {fun_info={fi_free_vars}} = fun_def - fun_lifted = length fi_free_vars - | fun_lifted > 0 - # (app_args, ls_var_heap, ls_expr_heap) = add_free_variables_in_app fi_free_vars app_args ls.ls_var_heap ls.ls_expr_heap - = ({ app & app_args = app_args, app_symb = { app_symbol & symb_arity = symb_arity + fun_lifted }}, - { ls & ls_var_heap = ls_var_heap, ls_expr_heap = ls_expr_heap }) - = ({ app & app_args = app_args }, ls) - = ({ app & app_args = app_args }, ls) - lift app=:{app_symb = app_symbol=:{symb_arity,symb_kind = SK_LocalMacroFunction glob_object}, app_args} ls - # (app_args, ls) = lift app_args ls - # (fun_def, ls) = ls!ls_x.x_fun_defs.[glob_object] - # {fun_info={fi_free_vars}} = fun_def - fun_lifted = length fi_free_vars - | fun_lifted > 0 - # (app_args, ls_var_heap, ls_expr_heap) = add_free_variables_in_app fi_free_vars app_args ls.ls_var_heap ls.ls_expr_heap - = ({ app & app_args = app_args, app_symb = { app_symbol & symb_arity = symb_arity + fun_lifted }}, - { ls & ls_var_heap = ls_var_heap, ls_expr_heap = ls_expr_heap }) + #! fun_def = ls.ls_x.x_fun_defs.[glob_object] + = lift_function_app app fun_def.fun_info.fi_free_vars ls + # (app_args, ls) = lift app_args ls = ({ app & app_args = app_args }, ls) + lift app=:{app_symb = {symb_kind = SK_LocalMacroFunction glob_object},app_args} ls + #! fun_def = ls.ls_x.x_fun_defs.[glob_object] + = lift_function_app app fun_def.fun_info.fi_free_vars ls + lift app=:{app_symb = {symb_kind = SK_LocalDclMacroFunction {glob_object,glob_module}}} ls + #! fun_def = ls.ls_x.x_macro_defs.[glob_module,glob_object] + = lift_function_app app fun_def.fun_info.fi_free_vars ls lift app=:{app_args} ls # (app_args, ls) = lift app_args ls = ({ app & app_args = app_args }, ls) -add_free_variables_in_app :: ![FreeVar] ![Expression] !u:VarHeap !*ExpressionHeap -> (![Expression],!u:VarHeap,!*ExpressionHeap) -add_free_variables_in_app [] app_args var_heap expr_heap - = (app_args, var_heap, expr_heap) -add_free_variables_in_app [{fv_name, fv_info_ptr} : free_vars] app_args var_heap expr_heap - # (var_info, var_heap) = readPtr fv_info_ptr var_heap - = case var_info of - VI_LiftedVariable var_info_ptr - # (var_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap - -> add_free_variables_in_app free_vars [Var { var_name = fv_name, var_info_ptr = var_info_ptr, var_expr_ptr = var_expr_ptr } : app_args] - var_heap expr_heap - _ - # (var_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap - -> add_free_variables_in_app free_vars [Var { var_name = fv_name, var_info_ptr = fv_info_ptr, var_expr_ptr = var_expr_ptr } : app_args] - var_heap expr_heap +lift_function_app app=:{app_symb=app_symbol=:{symb_arity},app_args} [] ls + # (app_args, ls) = lift app_args ls + = ({ app & app_args = app_args }, ls) +lift_function_app app=:{app_symb=app_symbol=:{symb_arity},app_args} fi_free_vars ls + # (app_args, ls) = lift app_args ls + # (app_args, ls_var_heap, ls_expr_heap) = add_free_variables_in_app fi_free_vars app_args ls.ls_var_heap ls.ls_expr_heap + # app = { app & app_args = app_args, app_symb = { app_symbol & symb_arity = symb_arity + length fi_free_vars }} + = (app, { ls & ls_var_heap = ls_var_heap, ls_expr_heap = ls_expr_heap }) +where + add_free_variables_in_app :: ![FreeVar] ![Expression] !*VarHeap !*ExpressionHeap -> (![Expression],!*VarHeap,!*ExpressionHeap) + add_free_variables_in_app [] app_args var_heap expr_heap + = (app_args, var_heap, expr_heap) + add_free_variables_in_app [{fv_name, fv_info_ptr} : free_vars] app_args var_heap expr_heap + #! var_info = sreadPtr fv_info_ptr var_heap + = case var_info of + VI_LiftedVariable var_info_ptr + # (var_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap + -> add_free_variables_in_app free_vars [Var { var_name = fv_name, var_info_ptr = var_info_ptr, var_expr_ptr = var_expr_ptr } : app_args] + var_heap expr_heap + _ + # (var_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap + -> add_free_variables_in_app free_vars [Var { var_name = fv_name, var_info_ptr = fv_info_ptr, var_expr_ptr = var_expr_ptr } : app_args] + var_heap expr_heap instance lift LetBind where @@ -191,6 +188,134 @@ where # (dp_rhs, ls) = lift dp_rhs ls = ({ pattern & dp_rhs = dp_rhs }, ls) +import RWSDebug + +liftFunctions :: [FunctionOrMacroIndex] Int Int *{#FunDef} *{#*{#FunDef}} *(Heap VarInfo) *(Heap ExprInfo) -> .LiftState; +liftFunctions group group_index main_dcl_module_n fun_defs macro_defs var_heap expr_heap + # (contains_free_vars, lifted_function_called, fun_defs,macro_defs) + = foldSt (add_free_vars_of_non_recursive_calls_to_function group_index) group (False, False, fun_defs,macro_defs) + | contains_free_vars + # (fun_defs,macro_defs) = iterateSt (add_free_vars_of_recursive_calls_to_functions group_index group) (fun_defs,macro_defs) + = lift_functions group {ls_x={x_fun_defs=fun_defs,x_macro_defs=macro_defs,x_main_dcl_module_n=main_dcl_module_n},ls_var_heap=var_heap,ls_expr_heap=expr_heap} + | lifted_function_called + = lift_functions group {ls_x={x_fun_defs=fun_defs,x_macro_defs=macro_defs,x_main_dcl_module_n=main_dcl_module_n},ls_var_heap=var_heap,ls_expr_heap=expr_heap} + = {ls_x={x_fun_defs=fun_defs,x_macro_defs=macro_defs,x_main_dcl_module_n=main_dcl_module_n},ls_var_heap=var_heap, ls_expr_heap=expr_heap} +where + add_free_vars_of_non_recursive_calls_to_function group_index (FunctionOrIclMacroIndex fun) (contains_free_vars, lifted_function_called, fun_defs,macro_defs) + # (fun_def=:{fun_info}, fun_defs) = fun_defs![fun] + { fi_free_vars,fi_def_level,fi_calls } = fun_info + (lifted_function_called, fi_free_vars, fun_defs,macro_defs) + = add_free_vars_of_non_recursive_calls fi_def_level group_index fi_calls lifted_function_called fi_free_vars fun_defs macro_defs + = (contains_free_vars || not (isEmpty fi_free_vars), lifted_function_called, + { fun_defs & [fun] = { fun_def & fun_info = { fun_info & fi_free_vars = fi_free_vars }}},macro_defs) + add_free_vars_of_non_recursive_calls_to_function group_index (DclMacroIndex macro_module_index macro_index) (contains_free_vars, lifted_function_called, fun_defs,macro_defs) + # (fun_def=:{fun_info}, macro_defs) = macro_defs![macro_module_index,macro_index] + { fi_free_vars,fi_def_level,fi_calls } = fun_info + (lifted_function_called, fi_free_vars, fun_defs,macro_defs) + = add_free_vars_of_non_recursive_calls fi_def_level group_index fi_calls lifted_function_called fi_free_vars fun_defs macro_defs + = (contains_free_vars || not (isEmpty fi_free_vars), lifted_function_called, + fun_defs,{ macro_defs & [macro_module_index,macro_index] = { fun_def & fun_info = { fun_info & fi_free_vars = fi_free_vars }}}) + + add_free_vars_of_non_recursive_calls fi_def_level group_index fi_calls lifted_function_called fi_free_vars fun_defs macro_defs + = foldSt (add_free_vars_of_non_recursive_call fi_def_level group_index) fi_calls (lifted_function_called, fi_free_vars, fun_defs,macro_defs) + where + add_free_vars_of_non_recursive_call fun_def_level group_index (FunCall fc_index _) (lifted_function_called, free_vars, fun_defs,macro_defs) + # ({fun_info = {fi_free_vars,fi_group_index}}, fun_defs) = fun_defs![fc_index] + | (if (fi_group_index>=NoIndex) (fi_group_index==group_index) (-2-fi_group_index==group_index)) || (isEmpty fi_free_vars) + = (lifted_function_called, free_vars, fun_defs,macro_defs) + # (free_vars_added, free_vars) = add_free_variables fun_def_level fi_free_vars (False, free_vars) + = (True, free_vars, fun_defs,macro_defs) + add_free_vars_of_non_recursive_call fun_def_level group_index (MacroCall macro_module_index fc_index _) (lifted_function_called, free_vars, fun_defs,macro_defs) + # ({fun_info = {fi_free_vars,fi_group_index}}, macro_defs) = macro_defs![macro_module_index,fc_index] + | (if (fi_group_index>=NoIndex) (fi_group_index==group_index) (-2-fi_group_index==group_index)) || (isEmpty fi_free_vars) + = (lifted_function_called, free_vars, fun_defs,macro_defs) + # (free_vars_added, free_vars) = add_free_variables fun_def_level fi_free_vars (False, free_vars) + = (True, free_vars, fun_defs,macro_defs) + + add_free_vars_of_recursive_calls_to_functions group_index group (fun_defs,macro_defs) + = foldSt (add_free_vars_of_recursive_calls_to_function group_index) group (False, (fun_defs,macro_defs)) + + add_free_vars_of_recursive_calls_to_function group_index (FunctionOrIclMacroIndex fun) (free_vars_added, (fun_defs,macro_defs)) + # (fun_def=:{fun_info}, fun_defs) = fun_defs![fun] + { fi_free_vars,fi_def_level,fi_calls } = fun_info + (free_vars_added, fi_free_vars, fun_defs,macro_defs) + = foldSt (add_free_vars_of_recursive_call fi_def_level group_index) fi_calls (free_vars_added, fi_free_vars, fun_defs,macro_defs) + fun_defs = { fun_defs & [fun] = { fun_def & fun_info = { fun_info & fi_free_vars = fi_free_vars }}} + = (free_vars_added, (fun_defs,macro_defs)) + add_free_vars_of_recursive_calls_to_function group_index (DclMacroIndex module_index fun) (free_vars_added, (fun_defs,macro_defs)) + # (fun_def=:{fun_info}, macro_defs) = macro_defs![module_index,fun] + { fi_free_vars,fi_def_level,fi_calls } = fun_info + (free_vars_added, fi_free_vars, fun_defs,macro_defs) + = foldSt (add_free_vars_of_recursive_call fi_def_level group_index) fi_calls (free_vars_added, fi_free_vars, fun_defs,macro_defs) + macro_defs = { macro_defs & [module_index,fun] = { fun_def & fun_info = { fun_info & fi_free_vars = fi_free_vars }}} + = (free_vars_added, (fun_defs,macro_defs)) + + add_free_vars_of_recursive_call fun_def_level group_index (FunCall fc_index _) (free_vars_added, free_vars, fun_defs,macro_defs) + # ({fun_info = {fi_free_vars,fi_group_index}}, fun_defs) = fun_defs![fc_index] + | if (fi_group_index>=NoIndex) (fi_group_index==group_index) (-2-fi_group_index==group_index) + # (free_vars_added, free_vars) = add_free_variables fun_def_level fi_free_vars (free_vars_added, free_vars) + = (free_vars_added, free_vars, fun_defs,macro_defs) + = (free_vars_added, free_vars, fun_defs,macro_defs) + add_free_vars_of_recursive_call fun_def_level group_index (MacroCall module_index fc_index _) (free_vars_added, free_vars, fun_defs,macro_defs) + # ({fun_info = {fi_free_vars,fi_group_index}}, macro_defs) = macro_defs![module_index,fc_index] + | if (fi_group_index>=NoIndex) (fi_group_index==group_index) (-2-fi_group_index==group_index) + # (free_vars_added, free_vars) = add_free_variables fun_def_level fi_free_vars (free_vars_added, free_vars) + = (free_vars_added, free_vars, fun_defs,macro_defs) + = (free_vars_added, free_vars, fun_defs,macro_defs) + + add_free_variables fun_level new_vars (free_vars_added, free_vars) + = add_free_global_variables (skip_local_variables fun_level new_vars) (free_vars_added, free_vars) + where + skip_local_variables level vars=:[{fv_def_level}:rest_vars] + | fv_def_level > level + = skip_local_variables level rest_vars + = vars + skip_local_variables _ [] + = [] + + add_free_global_variables [] (free_vars_added, free_vars) + = (free_vars_added, free_vars) + add_free_global_variables free_vars (free_vars_added, []) + = (True, free_vars) + add_free_global_variables [var:vars] (free_vars_added, free_vars) + # (free_var_added, free_vars) = newFreeVariable var free_vars + = add_free_global_variables vars (free_var_added || free_vars_added, free_vars) + + lift_functions group lift_state + = foldSt lift_function group lift_state + where + lift_function (FunctionOrIclMacroIndex fun) {ls_x=ls_x=:{x_fun_defs=fun_defs=:{[fun] = fun_def}}, ls_var_heap=var_heap, ls_expr_heap=expr_heap} + # {fi_free_vars} = fun_def.fun_info + fun_lifted = length fi_free_vars + (PartitioningFunction {cb_args,cb_rhs} fun_number) = fun_def.fun_body + (cb_args, var_heap) = add_lifted_args fi_free_vars cb_args var_heap + (cb_rhs, {ls_x,ls_var_heap,ls_expr_heap}) = lift cb_rhs { ls_x={ls_x & x_fun_defs = fun_defs}, ls_var_heap = var_heap, ls_expr_heap = expr_heap } + ls_var_heap = remove_lifted_args fi_free_vars ls_var_heap + fun_defs = ls_x.x_fun_defs + fun_defs = { fun_defs & [fun] = { fun_def & fun_lifted = fun_lifted, fun_body = PartitioningFunction {cb_args = cb_args, cb_rhs = cb_rhs} fun_number}} + = {ls_x={ls_x & x_fun_defs=fun_defs}, ls_var_heap=ls_var_heap, ls_expr_heap= ls_expr_heap} +// ---> ("lift_function", fun_def.fun_symb, fi_free_vars, cb_args, cb_rhs) + lift_function (DclMacroIndex module_index fun) {ls_x=ls_x=:{x_macro_defs=macro_defs=:{[module_index,fun] = fun_def}}, ls_var_heap=var_heap, ls_expr_heap=expr_heap} + # {fi_free_vars} = fun_def.fun_info + fun_lifted = length fi_free_vars + (PartitioningFunction {cb_args,cb_rhs} fun_number) = fun_def.fun_body + (cb_args, var_heap) = add_lifted_args fi_free_vars cb_args var_heap + (cb_rhs, {ls_x,ls_var_heap,ls_expr_heap}) = lift cb_rhs { ls_x={ls_x & x_macro_defs = macro_defs}, ls_var_heap = var_heap, ls_expr_heap = expr_heap } + ls_var_heap = remove_lifted_args fi_free_vars ls_var_heap + macro_defs = ls_x.x_macro_defs + macro_defs = { macro_defs & [module_index].[fun] = { fun_def & fun_lifted = fun_lifted, fun_body = PartitioningFunction {cb_args = cb_args, cb_rhs = cb_rhs} fun_number}} + = {ls_x={ls_x & x_macro_defs=macro_defs}, ls_var_heap=ls_var_heap, ls_expr_heap= ls_expr_heap} + + remove_lifted_args vars var_heap + = foldl (\var_heap {fv_name,fv_info_ptr} -> writePtr fv_info_ptr VI_Empty var_heap) var_heap vars + + add_lifted_args [lifted_arg=:{fv_name,fv_info_ptr} : lifted_args] args var_heap + # (new_info_ptr, var_heap) = newPtr VI_Empty var_heap + args = [{ lifted_arg & fv_info_ptr = new_info_ptr } : args ] + = add_lifted_args lifted_args args (writePtr fv_info_ptr (VI_LiftedVariable new_info_ptr) var_heap) + add_lifted_args [] args var_heap + = (args, var_heap) + unfoldVariable :: !BoundVar UnfoldInfo !*UnfoldState -> (!Expression, !*UnfoldState) unfoldVariable var=:{var_name,var_info_ptr} ui us # (var_info, us) = readVarInfo var_info_ptr us @@ -220,7 +345,6 @@ unfoldVariable var=:{var_name,var_info_ptr} ui us # (_,new_class_types, type_heaps) = substitute class_types type_heaps = (new_class_types, Yes type_heaps) - readVarInfo var_info_ptr us # (var_info, us_var_heap) = readPtr var_info_ptr us.us_var_heap us = { us & us_var_heap = us_var_heap } @@ -236,7 +360,7 @@ writeVarInfo var_info_ptr new_var_info var_heap _ -> writePtr var_info_ptr new_var_info var_heap :: CopiedLocalFunction = { - old_function_n :: !Int, + old_function_n :: !FunctionOrMacroIndex, new_function_n :: !Int } @@ -258,7 +382,7 @@ writeVarInfo var_info_ptr new_var_info var_heap :: UnfoldInfo = { ui_handle_aci_free_vars :: !AciFreeVarHandleMode, ui_convert_module_n :: !Int, // -1 if no conversion - ui_conversion_table :: !Optional ConversionTable + ui_conversion_table :: !Optional {#Int} } :: AciFreeVarHandleMode = LeaveThem | RemoveThem | SubstituteThem @@ -293,10 +417,7 @@ where unfold (TupleSelect symbol argn_nr expr) ui us # (expr, us) = unfold expr ui us = (TupleSelect symbol argn_nr expr, us) -/* unfold (Lambda vars expr) ui us - # (expr, us) = unfold expr ui us - = (Lambda vars expr, us) -*/ unfold (MatchExpr opt_tuple cons_symb expr) ui us + unfold (MatchExpr opt_tuple cons_symb expr) ui us # (expr, us) = unfold expr ui us = (MatchExpr opt_tuple cons_symb expr, us) unfold (DynamicExpr expr) ui us @@ -342,67 +463,27 @@ where unfold app=:{app_symb={symb_kind}, app_args, app_info_ptr} ui=:{ui_convert_module_n,ui_conversion_table} us = case symb_kind of SK_Function {glob_module,glob_object} - | ui_convert_module_n==glob_module + -> unfold_function_app app ui us + SK_IclMacro macro_index +/* | ui_convert_module_n<> (-1) # (Yes conversion_table) = ui_conversion_table -// | glob_object>=size conversion_table.[cFunctionDefs] -// -> abort ("unfold(App) "+++toString app.app_symb.symb_name+++" "+++toString glob_object+++" "+++toString (size conversion_table.[cFunctionDefs])) - # app={app & app_symb.symb_kind=SK_Function {glob_module=glob_module,glob_object=conversion_table.[cFunctionDefs].[glob_object]}} + # app={app & app_symb.symb_kind=SK_IclMacro (conversion_table.[macro_index])} -> unfold_function_app app ui us +*/ -> unfold_function_app app ui us - SK_Macro {glob_module,glob_object} - | ui_convert_module_n==glob_module + SK_DclMacro {glob_module,glob_object} +/* | ui_convert_module_n==glob_module # (Yes conversion_table) = ui_conversion_table - # app={app & app_symb.symb_kind=SK_Macro {glob_module=glob_module,glob_object=conversion_table.[cMacroDefs].[glob_object]}} + # app={app & app_symb.symb_kind=SK_DclMacro {glob_module=glob_module,glob_object=conversion_table.[glob_object]}} -> unfold_function_app app ui us +*/ -> unfold_function_app app ui us SK_OverloadedFunction {glob_module,glob_object} - | ui_convert_module_n==glob_module - # (Yes conversion_table) = ui_conversion_table - # app={app & app_symb.symb_kind=SK_OverloadedFunction {glob_module=glob_module,glob_object=conversion_table.[cFunctionDefs].[glob_object]}} - -> unfold_function_app app ui us - -> unfold_function_app app ui us + -> unfold_function_app app ui us SK_LocalMacroFunction local_macro_function_n - # (us_local_macro_functions,us) = us!us_local_macro_functions - -> case us_local_macro_functions of - No - -> unfold_function_app app ui us - uslocal_macro_functions=:(Yes local_macro_functions) - # (new_local_macro_function_n,us_local_macro_functions) = determine_new_local_macro_function_n local_macro_function_n local_macro_functions - with - determine_new_local_macro_function_n local_macro_function_n local_macro_functions=:{copied_local_functions,used_copied_local_functions,new_copied_local_functions,next_local_function_n} - # new_local_macro_function_n = search_new_local_macro_function_n used_copied_local_functions - | new_local_macro_function_n>=0 - = (new_local_macro_function_n,us_local_macro_functions) - # (new_local_macro_function_n,used_copied_local_functions) = search_new_local_macro_function_n_and_add_to_used_functions copied_local_functions used_copied_local_functions - | new_local_macro_function_n>=0 - = (new_local_macro_function_n,Yes {local_macro_functions & used_copied_local_functions=used_copied_local_functions}) - # (new_local_macro_function_n,used_copied_local_functions) = search_new_local_macro_function_n_and_add_to_used_functions new_copied_local_functions used_copied_local_functions - | new_local_macro_function_n>=0 - = (new_local_macro_function_n,Yes {local_macro_functions & used_copied_local_functions=used_copied_local_functions}) - # new_local_function = {old_function_n=local_macro_function_n,new_function_n=next_local_function_n} - # new_copied_local_functions=new_copied_local_functions++[new_local_function] - # us_local_macro_functions=Yes {copied_local_functions=copied_local_functions, - new_copied_local_functions=new_copied_local_functions, - used_copied_local_functions=[new_local_function:used_copied_local_functions], - next_local_function_n=next_local_function_n+1} - = (next_local_function_n,us_local_macro_functions) - where - search_new_local_macro_function_n [{old_function_n,new_function_n}:local_functions] - | local_macro_function_n==old_function_n - = new_function_n - = search_new_local_macro_function_n local_functions - search_new_local_macro_function_n [] - = -1 - - search_new_local_macro_function_n_and_add_to_used_functions [copied_local_function=:{old_function_n,new_function_n}:local_functions] used_copied_local_functions - | local_macro_function_n==old_function_n - = (new_function_n,[copied_local_function:used_copied_local_functions]) - = search_new_local_macro_function_n_and_add_to_used_functions local_functions used_copied_local_functions - search_new_local_macro_function_n_and_add_to_used_functions [] used_copied_local_functions - = (-1,used_copied_local_functions) - # us={us & us_local_macro_functions=us_local_macro_functions} - # app={app & app_symb.symb_kind=SK_LocalMacroFunction new_local_macro_function_n} - -> unfold_function_app app ui us + -> unfold_local_macro_function (FunctionOrIclMacroIndex local_macro_function_n) + SK_LocalDclMacroFunction {glob_module,glob_object} + -> unfold_local_macro_function (DclMacroIndex glob_module glob_object) SK_Constructor _ | not (isNilPtr app_info_ptr) # (app_info, us_symbol_heap) = readPtr app_info_ptr us.us_symbol_heap @@ -423,6 +504,49 @@ where # (app_args, us) = unfold app_args ui us = ({ app & app_args = app_args, app_info_ptr = new_info_ptr}, us) + unfold_local_macro_function local_macro_function_n + # (us_local_macro_functions,us) = us!us_local_macro_functions + = case us_local_macro_functions of + No + -> unfold_function_app app ui us + uslocal_macro_functions=:(Yes local_macro_functions) + # (new_local_macro_function_n,us_local_macro_functions) = determine_new_local_macro_function_n local_macro_function_n local_macro_functions + with + determine_new_local_macro_function_n local_macro_function_n local_macro_functions=:{copied_local_functions,used_copied_local_functions,new_copied_local_functions,next_local_function_n} + # new_local_macro_function_n = search_new_local_macro_function_n used_copied_local_functions + | new_local_macro_function_n>=0 + = (new_local_macro_function_n,us_local_macro_functions) + # (new_local_macro_function_n,used_copied_local_functions) = search_new_local_macro_function_n_and_add_to_used_functions copied_local_functions used_copied_local_functions + | new_local_macro_function_n>=0 + = (new_local_macro_function_n,Yes {local_macro_functions & used_copied_local_functions=used_copied_local_functions}) + # (new_local_macro_function_n,used_copied_local_functions) = search_new_local_macro_function_n_and_add_to_used_functions new_copied_local_functions used_copied_local_functions + | new_local_macro_function_n>=0 + = (new_local_macro_function_n,Yes {local_macro_functions & used_copied_local_functions=used_copied_local_functions}) + # new_local_function = {old_function_n=local_macro_function_n,new_function_n=next_local_function_n} + # new_copied_local_functions=new_copied_local_functions++[new_local_function] + # us_local_macro_functions=Yes {copied_local_functions=copied_local_functions, + new_copied_local_functions=new_copied_local_functions, + used_copied_local_functions=[new_local_function:used_copied_local_functions], + next_local_function_n=next_local_function_n+1} + = (next_local_function_n,us_local_macro_functions) + where + search_new_local_macro_function_n [{old_function_n,new_function_n}:local_functions] + | local_macro_function_n==old_function_n + = new_function_n + = search_new_local_macro_function_n local_functions + search_new_local_macro_function_n [] + = -1 + + search_new_local_macro_function_n_and_add_to_used_functions [copied_local_function=:{old_function_n,new_function_n}:local_functions] used_copied_local_functions + | local_macro_function_n==old_function_n + = (new_function_n,[copied_local_function:used_copied_local_functions]) + = search_new_local_macro_function_n_and_add_to_used_functions local_functions used_copied_local_functions + search_new_local_macro_function_n_and_add_to_used_functions [] used_copied_local_functions + = (-1,used_copied_local_functions) + # us={us & us_local_macro_functions=us_local_macro_functions} + # app={app & app_symb.symb_kind=SK_LocalMacroFunction new_local_macro_function_n} + -> unfold_function_app app ui us + substitute_EI_DictionaryType (EI_DictionaryType class_type) (Yes type_heaps) # (_,new_class_type, type_heaps) = substitute class_type type_heaps = (EI_DictionaryType new_class_type, Yes type_heaps) @@ -582,7 +706,6 @@ where instance unfold [a] | unfold a where unfold l ui us - // = mapSt unfold l ui us = map_st l us where map_st [x : xs] s @@ -595,7 +718,6 @@ where instance unfold (a,b) | unfold a & unfold b where -// unfold t ui us = app2St (unfold,unfold) t ui us unfold (a,b) ui us # (a,us) = unfold a ui us # (b,us) = unfold b ui us @@ -609,33 +731,71 @@ where unfold no ui us = (no, us) -//import StdDebug - updateFunctionCalls :: ![FunCall] ![FunCall] !*{# FunDef} !*SymbolTable -> (![FunCall], !*{# FunDef}, !*SymbolTable) updateFunctionCalls calls collected_calls fun_defs symbol_table = foldSt add_function_call calls (collected_calls, fun_defs, symbol_table) where - add_function_call fc=:{fc_index} (collected_calls, fun_defs, symbol_table) + add_function_call fc=:(FunCall fc_index _) (collected_calls, fun_defs, symbol_table) // # fc_index = trace ("add_function_call: "+++toString fc_index+++" ") fc_index # ({fun_symb}, fun_defs) = fun_defs![fc_index] (collected_calls, symbol_table) = examineFunctionCall fun_symb fc (collected_calls, symbol_table) = (collected_calls, fun_defs, symbol_table) -examineFunctionCall {id_info} fc=:{fc_index} (calls, symbol_table) +examineFunctionCall {id_info} fc=:(FunCall fc_index _) (calls, symbol_table) + # (entry, symbol_table) = readPtr id_info symbol_table + = case entry.ste_kind of + STE_Called indexes + | is_member fc_index indexes + -> (calls, symbol_table) + -> ([ fc : calls ], symbol_table <:= (id_info, { entry & ste_kind = STE_Called [ FunctionOrIclMacroIndex fc_index : indexes ]})) + _ + -> ( [ fc : calls ], symbol_table <:= + (id_info, { ste_kind = STE_Called [FunctionOrIclMacroIndex fc_index], ste_index = NoIndex, ste_def_level = NotALevel, ste_previous = entry })) + where + is_member fc_index [FunctionOrIclMacroIndex index:indexes] + | fc_index==index + = True + = is_member fc_index indexes + is_member fc_index [_:indexes] + = is_member fc_index indexes + is_member _ [] + = False +examineFunctionCall {id_info} fc=:(MacroCall macro_module_index fc_index _) (calls, symbol_table) # (entry, symbol_table) = readPtr id_info symbol_table = case entry.ste_kind of STE_Called indexes - | isMember fc_index indexes + | is_member macro_module_index fc_index indexes -> (calls, symbol_table) - -> ([ fc : calls ], symbol_table <:= (id_info, { entry & ste_kind = STE_Called [ fc_index : indexes ]})) + -> ([ fc : calls ], symbol_table <:= (id_info, { entry & ste_kind = STE_Called [ DclMacroIndex macro_module_index fc_index : indexes ]})) _ -> ( [ fc : calls ], symbol_table <:= - (id_info, { ste_kind = STE_Called [fc_index], ste_index = NoIndex, ste_def_level = NotALevel, ste_previous = entry })) + (id_info, { ste_kind = STE_Called [DclMacroIndex macro_module_index fc_index], ste_index = NoIndex, ste_def_level = NotALevel, ste_previous = entry })) + where + is_member macro_module_index fc_index [DclMacroIndex module_index index:indexes] + | fc_index==index && module_index==macro_module_index + = True + = is_member macro_module_index fc_index indexes + is_member macro_module_index fc_index [_:indexes] + = is_member macro_module_index fc_index indexes + is_member _ _ [] + = False + +:: ExpandState = + { es_symbol_table :: !.SymbolTable + , es_var_heap :: !.VarHeap + , es_symbol_heap :: !.ExpressionHeap + , es_error :: !.ErrorAdmin, + es_fun_defs :: !.{#FunDef}, + es_macro_defs :: !.{#.{#FunDef}}, + es_main_dcl_module_n :: !Int, + es_dcl_modules :: !.{# DclModule}, + es_expand_in_imp_module :: !Bool, + es_new_fun_def_numbers :: ![Int] + } -copy_macro_and_local_functions :: FunDef (Optional CopiedLocalFunctions) *ExpandState -> (!FunDef,![(CopiedLocalFunction,FunDef)],!Optional CopiedLocalFunctions,!*ExpandState); -copy_macro_and_local_functions macro=:{fun_kind} local_macro_functions es - # is_def_macro=case fun_kind of FK_DefMacro->True; _->False +copy_macro_and_local_functions :: FunDef (Optional CopiedLocalFunctions) Bool *ExpandState -> (!FunDef,![(CopiedLocalFunction,FunDef)],!Optional CopiedLocalFunctions,!*ExpandState); +copy_macro_and_local_functions macro=:{fun_kind} local_macro_functions is_def_macro es # (macro,local_macro_functions,es) = copy_macro_or_local_macro_function is_def_macro macro local_macro_functions es # (new_functions,local_macro_functions,es) = copy_local_functions_of_macro local_macro_functions is_def_macro [] es = (macro,new_functions,local_macro_functions,es) @@ -654,12 +814,20 @@ copy_local_functions_of_macro local_macro_functions is_def_macro local_functions [] -> ([],local_macro_functions,es) [(old_and_new_function_n=:{old_function_n,new_function_n}):local_functions_to_be_copied] - # (function,es)=es!es_fun_defs.[old_function_n] - - #! function_group_index=function.fun_info.fi_group_index - # es = {es & es_fun_defs.[old_function_n].fun_info.fi_group_index= if (function_group_index>NoIndex) (-2-function_group_index) function_group_index} - # function = {function & fun_info.fi_group_index=if (function_group_index<NoIndex) (-2-function_group_index) function_group_index} - + # (function,es) + = case old_function_n of + FunctionOrIclMacroIndex old_function_index + # (function,es)=es!es_fun_defs.[old_function_index] + #! function_group_index=function.fun_info.fi_group_index + # es = {es & es_fun_defs.[old_function_index].fun_info.fi_group_index= if (function_group_index>NoIndex) (-2-function_group_index) function_group_index} + # function = {function & fun_info.fi_group_index=if (function_group_index<NoIndex) (-2-function_group_index) function_group_index} + -> (function,es) + DclMacroIndex old_function_module_index old_function_index + # (function,es)=es!es_macro_defs.[old_function_module_index,old_function_index] + #! function_group_index=function.fun_info.fi_group_index + # es = {es & es_macro_defs.[old_function_module_index].[old_function_index].fun_info.fi_group_index= if (function_group_index>NoIndex) (-2-function_group_index) function_group_index} + # function = {function & fun_info.fi_group_index=if (function_group_index<NoIndex) (-2-function_group_index) function_group_index} + -> (function,es) # (function,local_macro_functions,es) = copy_macro_or_local_macro_function is_def_macro function local_macro_functions es # (new_functions,local_macro_functions,es) = copy_local_functions_of_macro local_macro_functions is_def_macro local_functions_to_be_copied es -> ([(old_and_new_function_n,function):new_functions],local_macro_functions,es) @@ -672,15 +840,28 @@ update_calls calls (Yes {used_copied_local_functions}) # calls = remove_old_calls calls = add_new_calls used_copied_local_functions calls where - remove_old_calls [call=:{fc_index}:calls] + remove_old_calls [call=:(FunCall fc_index _):calls] | contains_old_function_n used_copied_local_functions // # calls = trace ("remove_old_calls1: "+++toString fc_index) calls = remove_old_calls calls // # calls = trace ("remove_old_calls2: "+++toString fc_index) calls = [call:remove_old_calls calls] where - contains_old_function_n [{old_function_n}:local_functions] - = fc_index==old_function_n || contains_old_function_n local_functions + contains_old_function_n [{old_function_n=FunctionOrIclMacroIndex old_function_index }:local_functions] + = fc_index==old_function_index || contains_old_function_n local_functions + contains_old_function_n [_:local_functions] + = contains_old_function_n local_functions + contains_old_function_n [] + = False + remove_old_calls [call=:(MacroCall macro_module_index fc_index _):calls] + | contains_old_function_n used_copied_local_functions + = remove_old_calls calls + = [call:remove_old_calls calls] + where + contains_old_function_n [{old_function_n=DclMacroIndex old_macro_module_index old_function_index }:local_functions] + = fc_index==old_function_index && macro_module_index==old_macro_module_index || contains_old_function_n local_functions + contains_old_function_n [_:local_functions] + = contains_old_function_n local_functions contains_old_function_n [] = False remove_old_calls [] @@ -688,7 +869,7 @@ where add_new_calls [{new_function_n}:local_functions] calls // # local_functions = trace ("add_new_calls: "+++toString new_function_n) local_functions - = add_new_calls local_functions [{fc_index=new_function_n,fc_level=NotALevel}:calls] + = add_new_calls local_functions [FunCall new_function_n NotALevel:calls] add_new_calls [] calls = calls @@ -709,8 +890,8 @@ copy_macro_or_local_macro_function is_def_macro macro=:{fun_body = TransformedBo with unfold_and_convert dcl_modules us | es_expand_in_imp_module && is_def_macro - # (dcl_mod,dcl_modules) = dcl_modules![es_main_dcl_module_n] - # ui = {ui_handle_aci_free_vars = RemoveThem, ui_convert_module_n = es_main_dcl_module_n, ui_conversion_table=dcl_mod.dcl_conversions } + # (dcl_mod,dcl_modules) = dcl_modules![es_main_dcl_module_n] + # ui = {ui_handle_aci_free_vars = RemoveThem, ui_convert_module_n = es_main_dcl_module_n, ui_conversion_table=dcl_mod.dcl_macro_conversions } # (expr,es) = unfold tb_rhs ui us = (expr,dcl_modules,es) @@ -723,7 +904,6 @@ copy_macro_or_local_macro_function is_def_macro macro=:{fun_body = TransformedBo update_local_vars [fv=:{fv_info_ptr}:fvs] var_heap # (fvs,var_heap)=update_local_vars fvs var_heap # (fv_info,var_heap) = readPtr fv_info_ptr var_heap -// # fv = {fv & fv_info_ptr=case fv_info of (VI_Variable _ info_ptr) -> info_ptr} # fv = {fv & fv_info_ptr=case fv_info of (VI_Variable _ info_ptr) -> info_ptr } @@ -734,9 +914,8 @@ copy_macro_or_local_macro_function is_def_macro macro=:{fun_body = TransformedBo = ({macro & fun_body = TransformedBody {tb_args=tb_args,tb_rhs=result_expr},fun_info.fi_local_vars=fi_local_vars,fun_info.fi_calls=fi_calls},us_local_macro_functions, {es & es_var_heap=us_var_heap, es_symbol_heap=us_symbol_heap, es_dcl_modules=dcl_modules}) -unfoldMacro :: !FunDef ![Expression] !*ExpandInfo -> (!Expression, !*ExpandInfo) -unfoldMacro {fun_body = TransformedBody {tb_args,tb_rhs}, fun_info = {fi_calls},fun_kind,fun_symb} args (calls, es=:{es_var_heap,es_symbol_heap,es_fun_defs,es_expand_in_imp_module,es_main_dcl_module_n,es_dcl_modules}) - # is_def_macro=case fun_kind of FK_DefMacro->True; _->False +unfoldMacro :: !FunDef ![Expression] !Bool !*ExpandInfo -> (!Expression, !*ExpandInfo) +unfoldMacro {fun_body =fun_body=: TransformedBody {tb_args,tb_rhs}, fun_info = {fi_calls},fun_kind,fun_symb} args is_def_macro (calls, es=:{es_var_heap,es_symbol_heap,es_fun_defs,es_expand_in_imp_module,es_main_dcl_module_n,es_dcl_modules}) # (let_binds, var_heap) = bind_expressions tb_args args [] es_var_heap #! size_fun_defs = size es_fun_defs # copied_local_functions = Yes { copied_local_functions=[],used_copied_local_functions=[],new_copied_local_functions=[],next_local_function_n=size_fun_defs} @@ -746,7 +925,7 @@ unfoldMacro {fun_body = TransformedBody {tb_args,tb_rhs}, fun_info = {fi_calls}, unfold_and_convert dcl_modules us | es_expand_in_imp_module && is_def_macro # (dcl_mod,dcl_modules) = dcl_modules![es_main_dcl_module_n] - # ui = {ui_handle_aci_free_vars = RemoveThem, ui_convert_module_n = es_main_dcl_module_n, ui_conversion_table=dcl_mod.dcl_conversions } + # ui = {ui_handle_aci_free_vars = RemoveThem, ui_convert_module_n = es_main_dcl_module_n, ui_conversion_table=dcl_mod.dcl_macro_conversions } # (result_expr,us) = unfold tb_rhs ui us = (result_expr,dcl_modules,us) @@ -797,101 +976,151 @@ where :: Group = { group_members :: ![Int] -// , group_number :: !Int } :: PartitioningInfo = { pi_symbol_table :: !.SymbolTable -// , pi_marks :: !.{# Int} , pi_var_heap :: !.VarHeap , pi_symbol_heap :: !.ExpressionHeap , pi_error :: !.ErrorAdmin + , pi_fun_defs :: !.{#FunDef} + , pi_macro_defs :: !.{#.{#FunDef}} , pi_next_num :: !Int , pi_next_group :: !Int - , pi_groups :: ![[Int]] - , pi_deps :: ![Int] + , pi_groups :: ![[FunctionOrMacroIndex]] + , pi_deps :: ![FunctionOrMacroIndex] + , pi_unexpanded_dcl_macros :: ![(Int,Int,FunDef)] } NotChecked :== -1 :: PredefSymbolsForTransform = { predef_alias_dummy :: !PredefinedSymbol, predef_and :: !PredefinedSymbol, predef_or :: !PredefinedSymbol }; -partitionateMacros :: !IndexRange !Index !PredefSymbolsForTransform !*{# FunDef} !*{# DclModule} !*VarHeap !*ExpressionHeap !*SymbolTable !*ErrorAdmin - -> (!*{# FunDef}, !.{# DclModule}, !*VarHeap, !*ExpressionHeap, !*SymbolTable, !*ErrorAdmin ) -partitionateMacros {ir_from,ir_to} mod_index predef_symbols_for_transform fun_defs modules var_heap symbol_heap symbol_table error - #! max_fun_nr = size fun_defs - # partitioning_info = { pi_var_heap = var_heap, pi_symbol_heap = symbol_heap, - pi_symbol_table = symbol_table, - pi_error = error, pi_deps = [], pi_next_num = 0, pi_next_group = 0, pi_groups = [] } - (fun_defs, modules, {pi_symbol_table, pi_var_heap, pi_symbol_heap, pi_error, pi_next_group, pi_groups, pi_deps}) - = iFoldSt (pationate_macro mod_index max_fun_nr) ir_from ir_to (fun_defs, modules, partitioning_info) - -// # (size_fun_defs,fun_defs) = usize fun_defs -// # fun_defs=trace ("size_fun_defs: "+++toString size_fun_defs+++" ") fun_defs; - - = (foldSt reset_body_of_rhs_macro pi_deps fun_defs, modules, pi_var_heap, pi_symbol_heap, pi_symbol_table, pi_error) -where - reset_body_of_rhs_macro macro_index macro_defs - # (macro_def, macro_defs) = macro_defs![macro_index] - = case macro_def.fun_body of - RhsMacroBody body - -> { macro_defs & [macro_index] = { macro_def & fun_body = CheckedBody body }} - _ - -> macro_defs - - pationate_macro mod_index max_fun_nr macro_index (macro_defs, modules, pi) - # (macro_def, macro_defs) = macro_defs![macro_index] -// | macro_def.fun_kind == FK_Macro - | case macro_def.fun_kind of FK_DefMacro->True ; FK_ImpMacro->True; _ -> False - = case macro_def.fun_body of - CheckedBody body - # macros_modules_pi = foldSt (visit_macro mod_index max_fun_nr) macro_def.fun_info.fi_calls - ({ macro_defs & [macro_index] = { macro_def & fun_body = PartioningMacro }}, modules, pi) - -> expand_simple_macro mod_index macro_index macro_def macros_modules_pi - PartioningMacro - # identPos = newPosition macro_def.fun_symb macro_def.fun_pos - -> (macro_defs, modules, { pi & pi_error = checkError macro_def.fun_symb "recursive macro definition" (setErrorAdmin identPos pi.pi_error) }) - _ - -> (macro_defs, modules, pi) - = (macro_defs, modules, pi) - - visit_macro mod_index max_fun_nr {fc_index} macros_modules_pi - = pationate_macro mod_index max_fun_nr fc_index macros_modules_pi - - expand_simple_macro mod_index macro_index macro=:{fun_body = CheckedBody body, fun_info, fun_symb, fun_pos,fun_kind} - (macro_defs, modules, pi=:{pi_symbol_table,pi_symbol_heap,pi_var_heap,pi_error}) - | macros_are_simple fun_info.fi_calls macro_defs && has_no_curried_macro body.cb_rhs macro_defs - # identPos = newPosition fun_symb fun_pos - # expand_in_imp_module=case fun_kind of FK_ImpMacro->True; _ -> False - es = { es_symbol_table = pi_symbol_table, es_var_heap = pi_var_heap, - es_symbol_heap = pi_symbol_heap, es_error = setErrorAdmin identPos pi_error, - es_fun_defs=macro_defs, es_main_dcl_module_n = mod_index, es_dcl_modules=modules, - es_expand_in_imp_module=expand_in_imp_module,es_new_fun_def_numbers=[] - } - # (tb_args, tb_rhs, local_vars, fi_calls, fi_dynamics,{es_symbol_table, es_var_heap, es_symbol_heap, es_error,es_dcl_modules,es_fun_defs}) - = expandMacrosInBody [] body fun_info.fi_dynamics predef_symbols_for_transform es - # macro = { macro & fun_body = TransformedBody { tb_args = tb_args, tb_rhs = tb_rhs}, - fun_info = { fun_info & fi_calls = fi_calls, fi_local_vars = local_vars, fi_dynamics=fi_dynamics }} - = ({ es_fun_defs & [macro_index] = macro }, es_dcl_modules, - { pi & pi_symbol_table = es_symbol_table, pi_symbol_heap = es_symbol_heap, pi_var_heap = es_var_heap, pi_error = es_error }) - # pi = { pi & pi_deps = [macro_index:pi.pi_deps] } - = ({ macro_defs & [macro_index] = { macro & fun_body = RhsMacroBody body }}, modules, pi) - - macros_are_simple :: [FunCall] {#FunDef} -> Bool; - macros_are_simple [] macro_defs - = True - macros_are_simple [ {fc_index} : calls ] macro_defs - # {fun_kind,fun_body, fun_symb} = macro_defs.[fc_index] - = is_a_pattern_macro fun_kind fun_body && macros_are_simple calls macro_defs +reset_body_of_rhs_macros pi_deps fun_defs macro_defs + = foldSt reset_body_of_rhs_macro pi_deps (fun_defs,macro_defs) where - is_a_pattern_macro FK_DefMacro (TransformedBody {tb_args}) - = True - is_a_pattern_macro FK_ImpMacro (TransformedBody {tb_args}) - = True - is_a_pattern_macro _ _ - = False - -add_new_macros_to_groups :: ![Int] !Int Int *{#FunDef} [Int] [[Int]] -> (!Int,!*{#FunDef},![Int],![[Int]]); + reset_body_of_rhs_macro (FunctionOrIclMacroIndex macro_index) (fun_defs,macro_defs) + # (macro_def,fun_defs) = fun_defs![macro_index] + = case macro_def.fun_body of + RhsMacroBody body + -> ({ fun_defs & [macro_index] = { macro_def & fun_body = CheckedBody body }},macro_defs) + _ + -> (fun_defs,macro_defs) + reset_body_of_rhs_macro (DclMacroIndex module_index macro_index) (fun_defs,macro_defs) + # (macro_def,macro_defs) = macro_defs![module_index,macro_index] + = case macro_def.fun_body of + RhsMacroBody body + -> (fun_defs,{ macro_defs & [module_index,macro_index] = { macro_def & fun_body = CheckedBody body }}) + _ + -> (fun_defs,macro_defs) + +expand_simple_macro mod_index macro=:{fun_body = CheckedBody body, fun_info, fun_symb, fun_pos,fun_kind} expand_in_imp_module + predef_symbols_for_transform modules pi=:{pi_symbol_table,pi_symbol_heap,pi_var_heap,pi_fun_defs,pi_macro_defs,pi_error} + # identPos = newPosition fun_symb fun_pos + # es = { es_symbol_table = pi_symbol_table, es_var_heap = pi_var_heap, + es_symbol_heap = pi_symbol_heap, es_error = setErrorAdmin identPos pi_error, + es_fun_defs=pi_fun_defs, es_macro_defs=pi_macro_defs, es_main_dcl_module_n = mod_index, es_dcl_modules=modules, + es_expand_in_imp_module=expand_in_imp_module,es_new_fun_def_numbers=[] + } + # (tb_args, tb_rhs, local_vars, fi_calls, fi_dynamics,{es_symbol_table, es_var_heap, es_symbol_heap, es_error,es_dcl_modules,es_fun_defs,es_macro_defs}) + = expandMacrosInBody [] body fun_info.fi_dynamics predef_symbols_for_transform es + # macro = { macro & fun_body = TransformedBody { tb_args = tb_args, tb_rhs = tb_rhs}, + fun_info = { fun_info & fi_calls = fi_calls, fi_local_vars = local_vars, fi_dynamics=fi_dynamics }} + = ( macro, es_dcl_modules, + { pi & pi_symbol_table = es_symbol_table, pi_symbol_heap = es_symbol_heap, pi_var_heap = es_var_heap, pi_fun_defs = es_fun_defs,pi_macro_defs=es_macro_defs,pi_error = es_error }) + +expand_dcl_macro_if_simple mod_index macro_index macro=:{fun_body = CheckedBody body, fun_info} + predef_symbols_for_transform (modules, pi=:{pi_symbol_table,pi_symbol_heap,pi_var_heap,pi_fun_defs,pi_macro_defs,pi_error}) + | macros_are_simple fun_info.fi_calls pi_fun_defs pi_macro_defs && has_no_curried_macro body.cb_rhs pi_fun_defs pi_macro_defs + # (macro,modules,pi) = expand_simple_macro mod_index macro False predef_symbols_for_transform modules pi + = (modules, { pi & pi_macro_defs.[mod_index,macro_index] = macro }) + = (modules, { pi & pi_deps = [DclMacroIndex mod_index macro_index:pi.pi_deps], pi_macro_defs.[mod_index,macro_index] = { macro & fun_body = RhsMacroBody body }}) + +expand_icl_macro_if_simple mod_index macro_index macro=:{fun_body = CheckedBody body, fun_info} + predef_symbols_for_transform (modules, pi=:{pi_symbol_table,pi_symbol_heap,pi_var_heap,pi_fun_defs,pi_macro_defs,pi_error}) + | macros_are_simple fun_info.fi_calls pi_fun_defs pi_macro_defs && has_no_curried_macro body.cb_rhs pi_fun_defs pi_macro_defs + # (macro,modules,pi) = expand_simple_macro mod_index macro True predef_symbols_for_transform modules pi + = (modules, { pi & pi_fun_defs.[macro_index] = macro }) + = (modules, { pi & pi_deps = [FunctionOrIclMacroIndex macro_index:pi.pi_deps], pi_fun_defs.[macro_index] = { macro & fun_body = RhsMacroBody body }}) + +macros_are_simple :: [FunCall] {#FunDef} {#{#FunDef}} -> Bool; +macros_are_simple [] fun_defs macro_defs + = True +macros_are_simple [FunCall fc_index _ : calls ] fun_defs macro_defs + # {fun_kind,fun_body, fun_symb} = fun_defs.[fc_index] + = is_a_pattern_macro fun_kind fun_body && macros_are_simple calls fun_defs macro_defs +macros_are_simple [MacroCall module_index fc_index _ : calls ] fun_defs macro_defs + # {fun_kind,fun_body, fun_symb} = macro_defs.[module_index,fc_index] + = is_a_pattern_macro fun_kind fun_body && macros_are_simple calls fun_defs macro_defs + +is_a_pattern_macro FK_Macro (TransformedBody {tb_args}) + = True +is_a_pattern_macro _ _ + = False + +visit_macro mod_index max_fun_nr predef_symbols_for_transform (FunCall fc_index _) modules_pi + = partitionate_icl_macro mod_index max_fun_nr predef_symbols_for_transform fc_index modules_pi +visit_macro mod_index max_fun_nr predef_symbols_for_transform (MacroCall macro_module_index fc_index _) modules_pi + = partitionate_dcl_macro macro_module_index max_fun_nr predef_symbols_for_transform fc_index modules_pi + +partitionate_dcl_macro mod_index max_fun_nr predef_symbols_for_transform macro_index (modules, pi) + # (macro_def, pi) = pi!pi_macro_defs.[mod_index,macro_index] + | case macro_def.fun_kind of FK_Macro->True ; _ -> False + = case macro_def.fun_body of + CheckedBody body + # pi={ pi & pi_macro_defs.[mod_index,macro_index] = { macro_def & fun_body = PartitioningMacro }} + # macros_modules_pi = foldSt (visit_macro mod_index max_fun_nr predef_symbols_for_transform) macro_def.fun_info.fi_calls (modules, pi) + -> expand_dcl_macro_if_simple mod_index macro_index macro_def predef_symbols_for_transform macros_modules_pi + PartitioningMacro + # identPos = newPosition macro_def.fun_symb macro_def.fun_pos + -> (modules, { pi & pi_error = checkError macro_def.fun_symb "recursive macro definition" (setErrorAdmin identPos pi.pi_error) }) + _ + -> (modules, pi) + = (modules, pi) + +partitionate_icl_macro mod_index max_fun_nr predef_symbols_for_transform macro_index (modules, pi) + # (macro_def, pi) = pi!pi_fun_defs.[macro_index] + | case macro_def.fun_kind of FK_Macro->True; _ -> False + = case macro_def.fun_body of + CheckedBody body + # pi={ pi & pi_fun_defs.[macro_index] = { macro_def & fun_body = PartitioningMacro }} + # macros_modules_pi = foldSt (visit_macro mod_index max_fun_nr predef_symbols_for_transform) macro_def.fun_info.fi_calls (modules, pi) + -> expand_icl_macro_if_simple mod_index macro_index macro_def predef_symbols_for_transform macros_modules_pi + PartitioningMacro + # identPos = newPosition macro_def.fun_symb macro_def.fun_pos + -> (modules, { pi & pi_error = checkError macro_def.fun_symb "recursive macro definition" (setErrorAdmin identPos pi.pi_error) }) + _ + -> (modules, pi) + = (modules, pi) + +partitionateDclMacros :: !IndexRange !Index !PredefSymbolsForTransform !*{#FunDef} !*{#*{#FunDef}} !*{#DclModule} !*VarHeap !*ExpressionHeap !*SymbolTable !*ErrorAdmin + -> (!*{#FunDef},!*{#*{#FunDef}},!.{#DclModule},!*VarHeap,!*ExpressionHeap,!*SymbolTable,!*ErrorAdmin ) +partitionateDclMacros {ir_from,ir_to} mod_index predef_symbols_for_transform fun_defs macro_defs modules var_heap symbol_heap symbol_table error + #! max_fun_nr = cMAXINT + # partitioning_info = { pi_var_heap = var_heap, pi_symbol_heap = symbol_heap, + pi_symbol_table = symbol_table, pi_fun_defs=fun_defs, pi_macro_defs=macro_defs, + pi_error = error, pi_deps = [], pi_next_num = 0, pi_next_group = 0, pi_groups = [], + pi_unexpanded_dcl_macros=[] } + (modules, {pi_symbol_table, pi_var_heap, pi_symbol_heap, pi_fun_defs, pi_macro_defs, pi_error, pi_next_group, pi_groups, pi_deps}) + = iFoldSt (partitionate_dcl_macro mod_index max_fun_nr predef_symbols_for_transform) ir_from ir_to (modules, partitioning_info) + (fun_defs,macro_defs) = reset_body_of_rhs_macros pi_deps pi_fun_defs pi_macro_defs + = (fun_defs,macro_defs,modules, pi_var_heap, pi_symbol_heap, pi_symbol_table, pi_error) + +partitionateIclMacros :: !IndexRange !Index !PredefSymbolsForTransform !*{#FunDef} !*{#*{#FunDef}} !*{#DclModule} !*VarHeap !*ExpressionHeap !*SymbolTable !*ErrorAdmin + -> (!*{#FunDef},!*{#*{#FunDef}},!.{#DclModule},!*VarHeap,!*ExpressionHeap,!*SymbolTable,!*ErrorAdmin ) +partitionateIclMacros {ir_from,ir_to} mod_index predef_symbols_for_transform fun_defs macro_defs modules var_heap symbol_heap symbol_table error + #! max_fun_nr = cMAXINT + # partitioning_info = { pi_var_heap = var_heap, pi_symbol_heap = symbol_heap, + pi_symbol_table = symbol_table, pi_fun_defs=fun_defs, pi_macro_defs=macro_defs, + pi_error = error, pi_deps = [], pi_next_num = 0, pi_next_group = 0, pi_groups = [], + pi_unexpanded_dcl_macros=[] } + (modules, {pi_symbol_table, pi_var_heap, pi_symbol_heap, pi_fun_defs, pi_macro_defs, pi_error, pi_next_group, pi_groups, pi_deps}) + = iFoldSt (partitionate_icl_macro mod_index max_fun_nr predef_symbols_for_transform) ir_from ir_to (modules, partitioning_info) + (fun_defs,macro_defs) = reset_body_of_rhs_macros pi_deps pi_fun_defs pi_macro_defs + = (fun_defs,macro_defs,modules, pi_var_heap, pi_symbol_heap, pi_symbol_table, pi_error) + +add_new_macros_to_groups :: ![Int] !Int Int *{#FunDef} [FunctionOrMacroIndex] [[FunctionOrMacroIndex]] + -> (!Int,!*{#FunDef},![FunctionOrMacroIndex],![[FunctionOrMacroIndex]]); add_new_macros_to_groups [new_macro_fun_def_index] n_fun_defs_after_expanding_macros pi_next_group es_fun_defs functions_in_group pi_groups = add_new_macro_and_local_functions_to_groups new_macro_fun_def_index n_fun_defs_after_expanding_macros pi_next_group es_fun_defs functions_in_group pi_groups add_new_macros_to_groups [new_macro_fun_def_index:macro_fun_def_numbers=:[next_macro_fun_def_index:_]] n_fun_defs_after_expanding_macros pi_next_group es_fun_defs functions_in_group pi_groups @@ -901,7 +1130,8 @@ add_new_macros_to_groups [new_macro_fun_def_index:macro_fun_def_numbers=:[next_m add_new_macros_to_groups [] n_fun_defs_after_expanding_macros pi_next_group es_fun_defs functions_in_group pi_groups = (pi_next_group,es_fun_defs,functions_in_group,pi_groups) -add_new_macro_and_local_functions_to_groups :: !Int !Int Int *{#FunDef} [Int] [[Int]] -> (!Int,!*{#FunDef},![Int],![[Int]]); +add_new_macro_and_local_functions_to_groups :: !Int !Int Int *{#FunDef} [FunctionOrMacroIndex] [[FunctionOrMacroIndex]] + -> (!Int,!*{#FunDef},![FunctionOrMacroIndex],![[FunctionOrMacroIndex]]); add_new_macro_and_local_functions_to_groups new_macro_fun_def_index n_fun_defs_after_expanding_macros pi_next_group es_fun_defs functions_in_group pi_groups # (pi_next_group,es_fun_defs,functions_in_group,macros) = add_macros_to_current_group new_macro_fun_def_index n_fun_defs_after_expanding_macros pi_next_group es_fun_defs functions_in_group [] @@ -918,20 +1148,20 @@ add_new_macro_and_local_functions_to_groups new_macro_fun_def_index n_fun_defs_a # (pi_next_group,pi_groups) = partition_macros_in_groups sorted_macros_with_group_numbers [] (-1) pi_next_group pi_groups with partition_macros_in_groups [(fun_def_index,fun_def_group_number):l] [] group_number pi_next_group pi_groups - = partition_macros_in_groups l [fun_def_index] fun_def_group_number pi_next_group pi_groups + = partition_macros_in_groups l [FunctionOrIclMacroIndex fun_def_index] fun_def_group_number pi_next_group pi_groups partition_macros_in_groups [(fun_def_index,fun_def_group_number):l] group group_number pi_next_group pi_groups | fun_def_group_number==group_number - = partition_macros_in_groups l [fun_def_index:group] group_number pi_next_group pi_groups + = partition_macros_in_groups l [FunctionOrIclMacroIndex fun_def_index:group] group_number pi_next_group pi_groups # pi_groups=[group:pi_groups] # pi_next_group=pi_next_group+1 - = partition_macros_in_groups l [fun_def_index] fun_def_group_number pi_next_group pi_groups + = partition_macros_in_groups l [FunctionOrIclMacroIndex fun_def_index] fun_def_group_number pi_next_group pi_groups partition_macros_in_groups [] [] group_number pi_next_group pi_groups = (pi_next_group,pi_groups) partition_macros_in_groups [] last_group group_number pi_next_group pi_groups = (pi_next_group+1,[last_group:pi_groups]) = (pi_next_group,es_fun_defs,functions_in_group,pi_groups) -add_macros_to_current_group :: !Int !Int Int *{#FunDef} [Int] [Int] -> (!Int,!*{#FunDef},![Int],![Int]); +add_macros_to_current_group :: !Int !Int Int *{#FunDef} [FunctionOrMacroIndex] [Int] -> (!Int,!*{#FunDef},![FunctionOrMacroIndex],![Int]); add_macros_to_current_group new_macro_fun_def_index n_fun_defs_after_expanding_macros pi_next_group es_fun_defs functions_in_group macros | new_macro_fun_def_index>=n_fun_defs_after_expanding_macros = (pi_next_group,es_fun_defs,functions_in_group,macros) @@ -941,7 +1171,7 @@ add_macros_to_current_group new_macro_fun_def_index n_fun_defs_after_expanding_m | es_fun_defs.[new_macro_fun_def_index].fun_info.fi_group_index==pi_next_group // # new_macro_fun_def_index=trace ("add_macros_to_current_group1: "+++toString new_macro_fun_def_index+++"\n") new_macro_fun_def_index; - # functions_in_group=[new_macro_fun_def_index:functions_in_group] + # functions_in_group=[FunctionOrIclMacroIndex new_macro_fun_def_index:functions_in_group] = add_macros_to_current_group (new_macro_fun_def_index+1) n_fun_defs_after_expanding_macros pi_next_group es_fun_defs functions_in_group macros // # new_macro_fun_def_index=trace ("add_macros_to_current_group2: "+++toString new_macro_fun_def_index+++"\n") new_macro_fun_def_index; @@ -949,7 +1179,7 @@ add_macros_to_current_group new_macro_fun_def_index n_fun_defs_after_expanding_m // # pi_next_group=pi_next_group+1 = add_macros_to_current_group (new_macro_fun_def_index+1) n_fun_defs_after_expanding_macros pi_next_group es_fun_defs functions_in_group [new_macro_fun_def_index:macros] -has_no_curried_macro cb_rhs fun_defs +has_no_curried_macro cb_rhs fun_defs macro_defs = has_no_curried_macro_CheckedAlternative cb_rhs where has_no_curried_macro_CheckedAlternative [{ca_rhs}:cas] @@ -957,7 +1187,11 @@ where has_no_curried_macro_CheckedAlternative [] = True - has_no_curried_macro_Expression (App app=:{app_symb={symb_arity, symb_kind = SK_Macro {glob_object,glob_module}}, app_args}) + has_no_curried_macro_Expression (App app=:{app_symb={symb_arity, symb_kind = SK_DclMacro {glob_object,glob_module}}, app_args}) + | macro_defs.[glob_module,glob_object].fun_arity<>symb_arity + = False; + = has_no_curried_macro_Expressions app_args + has_no_curried_macro_Expression (App app=:{app_symb={symb_arity, symb_kind = SK_IclMacro glob_object}, app_args}) | fun_defs.[glob_object].fun_arity<>symb_arity = False; = has_no_curried_macro_Expressions app_args @@ -1031,18 +1265,27 @@ where has_no_curried_macro_Selections [] = True -partitionateAndLiftFunctions :: ![IndexRange] !Index !PredefSymbolsForTransform !*{# FunDef} !*{# DclModule} !*VarHeap !*ExpressionHeap !*SymbolTable !*ErrorAdmin - -> (!*{! Group}, !*{# FunDef}, !.{# DclModule}, !*VarHeap, !*ExpressionHeap, !*SymbolTable, !*ErrorAdmin ) -partitionateAndLiftFunctions ranges main_dcl_module_n predef_symbols_for_transform fun_defs modules var_heap symbol_heap symbol_table error - #! max_fun_nr = size fun_defs - # partitioning_info = { pi_var_heap = var_heap, pi_symbol_heap = symbol_heap, pi_symbol_table = symbol_table, - pi_error = error, pi_deps = [], pi_next_num = 0, pi_next_group = 0, pi_groups = [] } - (fun_defs, modules, {pi_groups, pi_symbol_table, pi_var_heap, pi_symbol_heap, pi_error}) - = foldSt (partitionate_functions main_dcl_module_n max_fun_nr) ranges (fun_defs, modules, partitioning_info) - # (reversed_pi_groups,fun_defs) = remove_macros_from_groups_and_reverse pi_groups fun_defs [] +import StdDebug + +partitionateAndLiftFunctions :: ![IndexRange] !Index !PredefSymbolsForTransform !*{#FunDef} !*{#*{#FunDef}} !*{#DclModule} !*VarHeap !*ExpressionHeap !*SymbolTable !*ErrorAdmin + -> (!*{!Group}, !*{#FunDef},!*{#*{#FunDef}},!.{#DclModule},!*VarHeap,!*ExpressionHeap,!*SymbolTable,!*ErrorAdmin ) +partitionateAndLiftFunctions ranges main_dcl_module_n predef_symbols_for_transform fun_defs macro_defs modules var_heap symbol_heap symbol_table error + #! max_fun_nr = cMAXINT + # partitioning_info = { pi_var_heap = var_heap, pi_symbol_heap = symbol_heap, pi_symbol_table = symbol_table, pi_fun_defs=fun_defs, pi_macro_defs=macro_defs, + pi_error = error, pi_deps = [], pi_next_num = 0, pi_next_group = 0, pi_groups = [], + pi_unexpanded_dcl_macros=[] } + (modules, {pi_groups, pi_symbol_table, pi_var_heap, pi_symbol_heap, pi_fun_defs, pi_macro_defs, pi_error,pi_unexpanded_dcl_macros}) + = foldSt (partitionate_functions main_dcl_module_n max_fun_nr) ranges (modules, partitioning_info) + # (reversed_pi_groups,fun_defs) = remove_macros_from_groups_and_reverse pi_groups pi_fun_defs [] # groups = { {group_members = group} \\ group <- reversed_pi_groups } -// # groups = { {group_members = group} \\ group <- reverse pi_groups } - = (groups, fun_defs, modules, pi_var_heap, pi_symbol_heap, pi_symbol_table, pi_error) + # pi_macro_defs = restore_unexpanded_dcl_macros pi_unexpanded_dcl_macros pi_macro_defs + with + restore_unexpanded_dcl_macros [(macro_module_index,macro_index,macro_def):unexpanded_dcl_macros] macro_defs + # macro_defs = {macro_defs & [macro_module_index,macro_index] = macro_def} + = restore_unexpanded_dcl_macros unexpanded_dcl_macros macro_defs + restore_unexpanded_dcl_macros [] macro_defs + = macro_defs + = (groups, fun_defs, pi_macro_defs, modules, pi_var_heap, pi_symbol_heap, pi_symbol_table, pi_error) where remove_macros_from_groups_and_reverse [group:groups] fun_defs result_groups # (group,fun_defs) = remove_macros_from_group group fun_defs @@ -1050,146 +1293,190 @@ where [] -> remove_macros_from_groups_and_reverse groups fun_defs result_groups _ -> remove_macros_from_groups_and_reverse groups fun_defs [group:result_groups] where - remove_macros_from_group [fun:funs] fun_defs + remove_macros_from_group [FunctionOrIclMacroIndex fun:funs] fun_defs # (funs,fun_defs)=remove_macros_from_group funs fun_defs - | fun_defs.[fun].fun_info.fi_group_index<NoIndex = (funs,fun_defs) - - = ([fun:funs],fun_defs) + = ([fun:funs],fun_defs) + remove_macros_from_group [DclMacroIndex macro_module_index macro_index:funs] fun_defs + = remove_macros_from_group funs fun_defs remove_macros_from_group [] fun_defs = ([],fun_defs); remove_macros_from_groups_and_reverse [] fun_defs result_groups = (result_groups,fun_defs); - partitionate_functions mod_index max_fun_nr {ir_from,ir_to} funs_modules_pi - = iFoldSt (partitionate_global_function mod_index max_fun_nr) ir_from ir_to funs_modules_pi + partitionate_functions mod_index max_fun_nr {ir_from,ir_to} modules_pi + = iFoldSt (partitionate_global_function mod_index max_fun_nr) ir_from ir_to modules_pi - partitionate_global_function mod_index max_fun_nr fun_index funs_modules_pi - # (_, funs_modules_pi) = partitionate_function mod_index max_fun_nr fun_index funs_modules_pi - = funs_modules_pi + partitionate_global_function mod_index max_fun_nr fun_index modules_pi + # (_, modules_pi) = partitionate_function mod_index max_fun_nr fun_index modules_pi + = modules_pi - partitionate_function mod_index max_fun_nr fun_index (fun_defs, modules, pi) -// # fun_index = trace ("partitionate_function: "+++toString fun_index+++" ") fun_index - # (fun_def, fun_defs) = fun_defs![fun_index] + partitionate_function mod_index max_fun_nr fun_index (modules, pi) + # (fun_def, pi) = pi!pi_fun_defs.[fun_index] = case fun_def.fun_body of CheckedBody body # fun_number = pi.pi_next_num - # (min_dep, funs_modules_pi) = foldSt (visit_function mod_index max_fun_nr) fun_def.fun_info.fi_calls - (max_fun_nr, ({ fun_defs & [fun_index] = { fun_def & fun_body = PartioningFunction body fun_number }}, modules, - { pi & pi_next_num = inc fun_number, pi_deps = [fun_index : pi.pi_deps] })) - -> try_to_close_group mod_index max_fun_nr fun_index fun_number min_dep funs_modules_pi - PartioningFunction _ fun_number - -> (fun_number, (fun_defs, modules, pi)) + # (min_dep, modules_pi) = foldSt (visit_function mod_index max_fun_nr) fun_def.fun_info.fi_calls + (max_fun_nr, (modules, + { pi & pi_fun_defs={ pi.pi_fun_defs & [fun_index] = { fun_def & fun_body = PartitioningFunction body fun_number }}, + pi_next_num = inc fun_number, pi_deps = [FunctionOrIclMacroIndex fun_index : pi.pi_deps] })) + -> try_to_close_group mod_index max_fun_nr (-1) fun_index fun_number min_dep modules_pi + PartitioningFunction _ fun_number + -> (fun_number, (modules, pi)) TransformedBody _ | fun_def.fun_info.fi_group_index == NoIndex - # (fun_defs, pi) = add_called_macros fun_def.fun_info.fi_calls (fun_defs, pi) - -> (max_fun_nr, ({ fun_defs & [fun_index] = {fun_def & fun_info.fi_group_index = pi.pi_next_group }}, modules, + # pi = add_called_macros fun_def.fun_info.fi_calls pi + -> (max_fun_nr, (modules, // -> (max_fun_nr, ({ fun_defs & [fun_index] = {fun_def & fun_info.fi_group_index = -2-pi.pi_next_group }}, modules, - {pi & pi_next_group = inc pi.pi_next_group, pi_groups = [ [fun_index] : pi.pi_groups]} + {pi & pi_fun_defs.[fun_index] = {fun_def & fun_info.fi_group_index = pi.pi_next_group }, + pi_next_group = inc pi.pi_next_group, pi_groups = [ [FunctionOrIclMacroIndex fun_index] : pi.pi_groups]} // {pi & pi_next_group = pi.pi_next_group} )) - -> (max_fun_nr, (fun_defs, modules, pi)) - - visit_function mod_index max_fun_nr {fc_index} (min_dep, funs_modules_pi) - # (next_min, funs_modules_pi) = partitionate_function mod_index max_fun_nr fc_index funs_modules_pi - = (min next_min min_dep, funs_modules_pi) + -> (max_fun_nr, (modules, pi)) - try_to_close_group mod_index max_fun_nr fun_index fun_number min_dep (fun_defs, modules, - pi=:{pi_symbol_table, pi_var_heap, pi_symbol_heap, pi_deps, pi_groups, pi_next_group, pi_error}) + partitionate_macro mod_index max_fun_nr macro_module_index macro_index (modules, pi) + # (fun_def, pi) = pi!pi_macro_defs.[macro_module_index,macro_index] + = case fun_def.fun_body of + CheckedBody body + # fun_number = pi.pi_next_num + # pi={pi & pi_unexpanded_dcl_macros=[(macro_module_index,macro_index,fun_def):pi.pi_unexpanded_dcl_macros]} + # (min_dep, modules_pi) = foldSt (visit_function mod_index max_fun_nr) fun_def.fun_info.fi_calls + (max_fun_nr, (modules, + { pi & pi_macro_defs.[macro_module_index,macro_index] = { fun_def & fun_body = PartitioningFunction body fun_number }, + pi_next_num = inc fun_number, pi_deps = [DclMacroIndex macro_module_index macro_index : pi.pi_deps] })) + -> try_to_close_group mod_index max_fun_nr macro_module_index macro_index fun_number min_dep modules_pi + PartitioningFunction _ fun_number + -> (fun_number, (modules, pi)) + TransformedBody _ + | fun_def.fun_info.fi_group_index == NoIndex + # pi = add_called_macros fun_def.fun_info.fi_calls pi + -> (max_fun_nr, (modules, + {pi & pi_macro_defs.[macro_module_index,macro_index] = {fun_def & fun_info.fi_group_index = pi.pi_next_group }, + pi_next_group = inc pi.pi_next_group, pi_groups = [ [DclMacroIndex macro_module_index macro_index] : pi.pi_groups]} + )) + -> (max_fun_nr, (modules, pi)) + + visit_function mod_index max_fun_nr (FunCall fc_index _) (min_dep, modules_pi) + # (next_min, modules_pi) = partitionate_function mod_index max_fun_nr fc_index modules_pi + = (min next_min min_dep, modules_pi) + visit_function mod_index max_fun_nr (MacroCall macro_module_index fc_index _) (min_dep, modules_pi) + # (next_min, modules_pi) = partitionate_macro mod_index max_fun_nr macro_module_index fc_index modules_pi + = (min next_min min_dep, modules_pi) + + try_to_close_group mod_index max_fun_nr macro_module_index fun_index fun_number min_dep (modules, + pi=:{pi_symbol_table, pi_var_heap, pi_symbol_heap, pi_fun_defs,pi_macro_defs,pi_deps, pi_groups, pi_next_group, pi_error,pi_unexpanded_dcl_macros}) | fun_number <= min_dep - # (pi_deps, functions_in_group, macros_in_group, fun_defs) - = close_group fun_index pi_deps [] [] max_fun_nr pi_next_group fun_defs - {ls_x={x_fun_defs=fun_defs}, ls_var_heap=pi_var_heap, ls_expr_heap=pi_symbol_heap} - = liftFunctions (functions_in_group ++ macros_in_group) pi_next_group main_dcl_module_n fun_defs pi_var_heap pi_symbol_heap - # es - = expand_macros_in_group macros_in_group + # (pi_deps, functions_in_group, macros_in_group, fun_defs,pi_macro_defs) + = close_group macro_module_index fun_index pi_deps [] [] max_fun_nr pi_next_group pi_fun_defs pi_macro_defs + {ls_x={x_fun_defs=fun_defs,x_macro_defs}, ls_var_heap=pi_var_heap, ls_expr_heap=pi_symbol_heap} + = liftFunctions (functions_in_group ++ macros_in_group) pi_next_group main_dcl_module_n fun_defs pi_macro_defs pi_var_heap pi_symbol_heap + # es = expand_macros_in_group macros_in_group { es_symbol_table = pi_symbol_table, es_var_heap = pi_var_heap, es_symbol_heap = pi_symbol_heap, - es_fun_defs=fun_defs, es_main_dcl_module_n=mod_index, es_dcl_modules=modules, es_new_fun_def_numbers=[], + es_fun_defs=fun_defs, es_macro_defs=x_macro_defs, es_main_dcl_module_n=mod_index, es_dcl_modules=modules, es_new_fun_def_numbers=[], es_expand_in_imp_module=False, // function expand_macros fills in correct value es_error = pi_error } - # {es_symbol_table, es_var_heap, es_symbol_heap, es_error,es_dcl_modules,es_fun_defs,es_new_fun_def_numbers} + # {es_symbol_table, es_var_heap, es_symbol_heap, es_error,es_dcl_modules,es_fun_defs,es_macro_defs,es_new_fun_def_numbers} = expand_macros_in_group functions_in_group es # (n_fun_defs_after_expanding_macros,es_fun_defs) = usize es_fun_defs # (pi_next_group,es_fun_defs,functions_in_group,pi_groups) = add_new_macros_to_groups (reverse es_new_fun_def_numbers) n_fun_defs_after_expanding_macros pi_next_group es_fun_defs functions_in_group pi_groups - = (max_fun_nr, (es_fun_defs, es_dcl_modules, { pi & pi_deps = pi_deps, pi_var_heap = es_var_heap, - pi_symbol_table = es_symbol_table, pi_error = es_error, pi_symbol_heap = es_symbol_heap, + = (max_fun_nr, (es_dcl_modules, { pi & pi_deps = pi_deps, pi_var_heap = es_var_heap, + pi_symbol_table = es_symbol_table, pi_fun_defs=es_fun_defs, pi_macro_defs=es_macro_defs, + pi_error = es_error, pi_symbol_heap = es_symbol_heap, pi_next_group = inc pi_next_group, - pi_groups = [ functions_in_group ++ macros_in_group : pi_groups ] })) - = (min_dep, (fun_defs, modules, pi)) + pi_groups = [ functions_in_group ++ macros_in_group : pi_groups ],pi_unexpanded_dcl_macros=pi_unexpanded_dcl_macros })) + = (min_dep, (modules, pi)) where - close_group fun_index [d:ds] functions_in_group macros_in_group nr_of_fun_defs group_number fun_defs + close_group macro_module_index fun_index [index=:FunctionOrIclMacroIndex d:ds] functions_in_group macros_in_group nr_of_fun_defs group_number fun_defs macro_defs # (fun_def, fun_defs) = fun_defs![d] -// fun_defs = { fun_defs & [d] = { fun_def & fun_info.fi_group_index = group_number }} -// | fun_def.fun_kind == FK_Macro - | case fun_def.fun_kind of FK_DefMacro->True ; FK_ImpMacro->True; _ -> False + | case fun_def.fun_kind of FK_Macro->True; _ -> False # fun_defs = { fun_defs & [d] = { fun_def & fun_info.fi_group_index = -2-group_number }} // # fun_defs = { fun_defs & [d] = { fun_def & fun_info.fi_group_index = group_number }} - # macros_in_group = [d : macros_in_group] - | d == fun_index - = (ds, functions_in_group, macros_in_group, fun_defs) - = close_group fun_index ds functions_in_group macros_in_group nr_of_fun_defs group_number fun_defs + # macros_in_group = [index : macros_in_group] + | d == fun_index && macro_module_index==(-1) + = (ds, functions_in_group, macros_in_group, fun_defs,macro_defs) + = close_group macro_module_index fun_index ds functions_in_group macros_in_group nr_of_fun_defs group_number fun_defs macro_defs # fun_defs = { fun_defs & [d] = { fun_def & fun_info.fi_group_index = group_number }} - # functions_in_group = [d : functions_in_group] - | d == fun_index - = (ds, functions_in_group, macros_in_group, fun_defs) - = close_group fun_index ds functions_in_group macros_in_group nr_of_fun_defs group_number fun_defs - + # functions_in_group = [index : functions_in_group] + | d == fun_index && macro_module_index==(-1) + = (ds, functions_in_group, macros_in_group, fun_defs,macro_defs) + = close_group macro_module_index fun_index ds functions_in_group macros_in_group nr_of_fun_defs group_number fun_defs macro_defs + close_group macro_module_index fun_index [index=:DclMacroIndex module_index d:ds] functions_in_group macros_in_group nr_of_fun_defs group_number fun_defs macro_defs + # (fun_def, macro_defs) = macro_defs![module_index,d] + | case fun_def.fun_kind of FK_Macro->True; _ -> False + # macro_defs = { macro_defs & [module_index,d] = { fun_def & fun_info.fi_group_index = -2-group_number }} + # macros_in_group = [index : macros_in_group] + | d == fun_index && macro_module_index==module_index + = (ds, functions_in_group, macros_in_group, fun_defs,macro_defs) + = close_group macro_module_index fun_index ds functions_in_group macros_in_group nr_of_fun_defs group_number fun_defs macro_defs + # macro_defs = { macro_defs & [module_index,d] = { fun_def & fun_info.fi_group_index = group_number }} + # functions_in_group = [index : functions_in_group] + | d == fun_index && macro_module_index==module_index + = (ds, functions_in_group, macros_in_group, fun_defs,macro_defs) + = close_group macro_module_index fun_index ds functions_in_group macros_in_group nr_of_fun_defs group_number fun_defs macro_defs + expand_macros_in_group group es = foldSt expand_macros group es - - expand_macros fun_index es - # (fun_def,es) = es!es_fun_defs.[fun_index] - {fun_symb,fun_body = PartioningFunction body _, fun_info, fun_pos,fun_kind} = fun_def - identPos = newPosition fun_symb fun_pos - # expand_in_imp_module=case fun_kind of FK_ImpFunction _->True; FK_ImpMacro->True; FK_ImpCaf->True; _ -> False - es={ es & es_expand_in_imp_module=expand_in_imp_module, es_error = setErrorAdmin identPos es.es_error } - # (tb_args, tb_rhs, fi_local_vars, fi_calls,fi_dynamics, es) - = expandMacrosInBody fun_info.fi_calls body fun_info.fi_dynamics predef_symbols_for_transform es - fun_def = { fun_def & fun_body = TransformedBody { tb_args = tb_args, tb_rhs = tb_rhs}, - fun_info = { fun_info & fi_calls = fi_calls, fi_local_vars = fi_local_vars,fi_dynamics=fi_dynamics }} - = {es & es_fun_defs.[fun_index] = fun_def } + where + expand_macros (FunctionOrIclMacroIndex fun_index) es + # (fun_def,es) = es!es_fun_defs.[fun_index] + {fun_symb,fun_body = PartitioningFunction body _, fun_info, fun_pos,fun_kind} = fun_def + identPos = newPosition fun_symb fun_pos + # es={ es & es_expand_in_imp_module=True, es_error = setErrorAdmin identPos es.es_error } + # (tb_args, tb_rhs, fi_local_vars, fi_calls,fi_dynamics, es) + = expandMacrosInBody fun_info.fi_calls body fun_info.fi_dynamics predef_symbols_for_transform es + fun_def = { fun_def & fun_body = TransformedBody { tb_args = tb_args, tb_rhs = tb_rhs}, + fun_info = { fun_info & fi_calls = fi_calls, fi_local_vars = fi_local_vars,fi_dynamics=fi_dynamics }} + = {es & es_fun_defs.[fun_index] = fun_def } + expand_macros (DclMacroIndex macro_module_index fun_index) es + # (old_fun_def,es) = es!es_macro_defs.[macro_module_index,fun_index] + {fun_symb,fun_body = PartitioningFunction body _, fun_info, fun_pos,fun_kind} = old_fun_def + identPos = newPosition fun_symb fun_pos + # es={ es & es_expand_in_imp_module=False, es_error = setErrorAdmin identPos es.es_error } + # (tb_args, tb_rhs, fi_local_vars, fi_calls,fi_dynamics, es) + = expandMacrosInBody fun_info.fi_calls body fun_info.fi_dynamics predef_symbols_for_transform es + fun_def = { old_fun_def & fun_body = TransformedBody { tb_args = tb_args, tb_rhs = tb_rhs}, + fun_info = { fun_info & fi_calls = fi_calls, fi_local_vars = fi_local_vars,fi_dynamics=fi_dynamics }} + = {es & es_macro_defs.[macro_module_index,fun_index] = fun_def } - add_called_macros calls macro_defs_and_pi - = foldSt add_called_macro calls macro_defs_and_pi + add_called_macros calls pi + = foldSt add_called_macro calls pi where - add_called_macro {fc_index} (macro_defs, pi) + add_called_macro (FunCall fc_index _) pi // # fc_index = trace ("add_called_macro: "+++toString fc_index+++" ") fc_index - # (macro_def, macro_defs) = macro_defs![fc_index] + # (macro_def, pi) = pi!pi_fun_defs.[fc_index] = case macro_def.fun_body of TransformedBody _ | macro_def.fun_info.fi_group_index == NoIndex - # (macro_defs, pi) = add_called_macros macro_def.fun_info.fi_calls (macro_defs, pi) + # pi = add_called_macros macro_def.fun_info.fi_calls pi // -> ({ macro_defs & [fc_index] = {macro_def & fun_info.fi_group_index = pi.pi_next_group }}, // # fc_index = trace ("add_called_macro2: "+++toString fc_index+++" ") fc_index // -> ({ macro_defs & [fc_index] = {macro_def & fun_info.fi_group_index = -2-pi.pi_next_group }}, - -> ({ macro_defs & [fc_index] = {macro_def & fun_info.fi_group_index = pi.pi_next_group }}, - {pi & pi_next_group = inc pi.pi_next_group,pi_groups = [ [fc_index] : pi.pi_groups]} + -> {pi & pi_fun_defs.[fc_index] = {macro_def & fun_info.fi_group_index = pi.pi_next_group }, + pi_next_group = inc pi.pi_next_group, pi_groups = [ [FunctionOrIclMacroIndex fc_index] : pi.pi_groups]} // {pi & pi_next_group = pi.pi_next_group} - ) - -> (macro_defs, pi) + -> pi -addFunctionCallsToSymbolTable calls fun_defs symbol_table - = foldSt add_function_call_to_symbol_table calls ([], fun_defs, symbol_table) +addFunctionCallsToSymbolTable calls fun_defs macro_defs symbol_table + = foldSt add_function_call_to_symbol_table calls ([], fun_defs,macro_defs, symbol_table) where - add_function_call_to_symbol_table fc=:{fc_index} (collected_calls, fun_defs, symbol_table) + add_function_call_to_symbol_table fc=:(FunCall fc_index _) (collected_calls, fun_defs,macro_defs, symbol_table) # ({fun_symb = { id_info }, fun_kind}, fun_defs) = fun_defs![fc_index] -// | fun_kind == FK_Macro = case fun_kind of - FK_DefMacro - -> (collected_calls, fun_defs, symbol_table) - FK_ImpMacro - -> (collected_calls, fun_defs, symbol_table) + FK_Macro + -> (collected_calls, fun_defs,macro_defs,symbol_table) _ # (entry, symbol_table) = readPtr id_info symbol_table - -> ([fc : collected_calls], fun_defs, - symbol_table <:= (id_info, { ste_kind = STE_Called [fc_index], ste_index = NoIndex, ste_def_level = NotALevel, ste_previous = entry })) + -> ([fc : collected_calls], fun_defs,macro_defs, + symbol_table <:= (id_info, { ste_kind = STE_Called [FunctionOrIclMacroIndex fc_index], ste_index = NoIndex, ste_def_level = NotALevel, ste_previous = entry })) + add_function_call_to_symbol_table (MacroCall _ _ _) (collected_calls, fun_defs,macro_defs, symbol_table) + = (collected_calls, fun_defs,macro_defs,symbol_table) removeFunctionCallsFromSymbolTable calls fun_defs symbol_table = foldSt remove_function_call_from_symbol_table calls (fun_defs, symbol_table) where - remove_function_call_from_symbol_table {fc_index} (fun_defs, symbol_table) + remove_function_call_from_symbol_table (FunCall fc_index _) (fun_defs, symbol_table) # ({fun_symb = { id_info }}, fun_defs) = fun_defs![fc_index] (entry, symbol_table) = readPtr id_info symbol_table = case entry.ste_kind of @@ -1199,45 +1486,38 @@ where -> (fun_defs, symbol_table) expandMacrosInBody :: [.FunCall] CheckedBody ![ExprInfoPtr] PredefSymbolsForTransform *ExpandState -> ([FreeVar],Expression,[FreeVar],[FunCall],![ExprInfoPtr],.ExpandState); -expandMacrosInBody fi_calls {cb_args,cb_rhs} fi_dynamics predef_symbols_for_transform es=:{es_symbol_table,es_symbol_heap,es_fun_defs} - // MV .. +expandMacrosInBody fi_calls {cb_args,cb_rhs} fi_dynamics predef_symbols_for_transform es=:{es_symbol_table,es_symbol_heap,es_fun_defs,es_macro_defs} # (max_index,es_symbol_heap) - = determine_amount_of_dynamics 0 fi_dynamics es_symbol_heap + = determine_amount_of_dynamics 0 fi_dynamics es_symbol_heap # cos_used_dynamics - = createArray (inc max_index) False // means not removed - // ... MV - # (prev_calls, fun_defs, es_symbol_table) - = addFunctionCallsToSymbolTable fi_calls es_fun_defs es_symbol_table + = createArray (inc max_index) False // means not removed + # (prev_calls, fun_defs, macro_defs,es_symbol_table) + = addFunctionCallsToSymbolTable fi_calls es_fun_defs es_macro_defs es_symbol_table ([rhs:rhss], (all_calls, es) ) - = mapSt expandCheckedAlternative cb_rhs (prev_calls, { es & es_fun_defs=fun_defs, es_symbol_table = es_symbol_table, es_symbol_heap=es_symbol_heap }) + = mapSt expandCheckedAlternative cb_rhs (prev_calls, { es & es_fun_defs=fun_defs, es_macro_defs=macro_defs,es_symbol_table = es_symbol_table, es_symbol_heap=es_symbol_heap }) (fun_defs, symbol_table) = removeFunctionCallsFromSymbolTable all_calls es.es_fun_defs es.es_symbol_table ((merged_rhs, _), es_var_heap, es_symbol_heap, es_error) = mergeCases rhs rhss es.es_var_heap es.es_symbol_heap es.es_error - (new_rhs, new_args, local_vars, {cos_error, cos_var_heap, cos_symbol_heap /* MV ... */, cos_used_dynamics /* ... MV */}) + (new_rhs, new_args, local_vars, {cos_error, cos_var_heap, cos_symbol_heap, cos_used_dynamics}) = determineVariablesAndRefCounts cb_args merged_rhs { cos_error = es_error, cos_var_heap = es_var_heap, cos_symbol_heap = es_symbol_heap, cos_predef_symbols_for_transform = predef_symbols_for_transform, cos_used_dynamics = cos_used_dynamics } - // MV ... # (changed,fi_dynamics,_,cos_symbol_heap) - = foldSt remove_fi_dynamic fi_dynamics (False,[],cos_used_dynamics,cos_symbol_heap) + = foldSt remove_fi_dynamic fi_dynamics (False,[],cos_used_dynamics,cos_symbol_heap) = (new_args, new_rhs, local_vars, all_calls,fi_dynamics, - { es & es_error = cos_error, es_var_heap = cos_var_heap, es_symbol_heap = cos_symbol_heap, - es_fun_defs=fun_defs, es_symbol_table = symbol_table }) - // ---> ("expandMacrosInBody", (cb_args, ca_rhs, '\n'), ("merged_rhs", merged_rhs, '\n'), ("new_rhs", new_args, local_vars, (new_rhs, '\n'))) - // MV ... + { es & es_error = cos_error, es_var_heap = cos_var_heap, es_symbol_heap = cos_symbol_heap, es_fun_defs=fun_defs, es_symbol_table = symbol_table }) +// ---> ("expandMacrosInBody", (cb_args, ca_rhs, '\n'), ("merged_rhs", merged_rhs, '\n'), ("new_rhs", new_args, local_vars, (new_rhs, '\n'))) where remove_fi_dynamic dyn_expr_ptr (changed,accu,cos_used_dynamics,cos_symbol_heap) # (expr_info,cos_symbol_heap) = readPtr dyn_expr_ptr cos_symbol_heap | not (isEI_Dynamic expr_info) - = (changed,[dyn_expr_ptr:accu],cos_used_dynamics,cos_symbol_heap) - + = (changed,[dyn_expr_ptr:accu],cos_used_dynamics,cos_symbol_heap) # (EI_Dynamic _ id) = expr_info | cos_used_dynamics.[id] = (changed,[dyn_expr_ptr:accu],cos_used_dynamics,cos_symbol_heap) - // unused = (True,accu,cos_used_dynamics,cos_symbol_heap) where @@ -1258,154 +1538,43 @@ where // EI_DynamicType _ expr_info_ptrs2 // -> determine_amount_of_dynamics max_index expr_info_ptrs2 es_symbol_table = determine_amount_of_dynamics max_index expr_info_ptrs es_symbol_table -// ... MV expandCheckedAlternative {ca_rhs, ca_position} ei # (ca_rhs, ei) = expand ca_rhs ei = ((ca_rhs, ca_position), ei) -/* -cContainsFreeVars :== True -cContainsNoFreeVars :== False - -cMacroIsCalled :== True -cNoMacroIsCalled :== False -*/ - -liftFunctions :: [Int] Int Int *{#FunDef} *(Heap VarInfo) *(Heap ExprInfo) -> .LiftState; -liftFunctions group group_index main_dcl_module_n fun_defs var_heap expr_heap - # (contains_free_vars, lifted_function_called, fun_defs) - = foldSt (add_free_vars_of_non_recursive_calls_to_function group_index) group (False, False, fun_defs) - | contains_free_vars - # fun_defs = iterateSt (add_free_vars_of_recursive_calls_to_functions group_index group) fun_defs - = lift_functions group {ls_x={x_fun_defs=fun_defs,x_main_dcl_module_n=main_dcl_module_n},ls_var_heap=var_heap,ls_expr_heap=expr_heap} - | lifted_function_called - = lift_functions group {ls_x={x_fun_defs=fun_defs,x_main_dcl_module_n=main_dcl_module_n},ls_var_heap=var_heap,ls_expr_heap=expr_heap} - = {ls_x={x_fun_defs=fun_defs,x_main_dcl_module_n=main_dcl_module_n},ls_var_heap=var_heap, ls_expr_heap=expr_heap} -where - add_free_vars_of_non_recursive_calls_to_function group_index fun (contains_free_vars, lifted_function_called, fun_defs) - # (fun_def=:{fun_info}, fun_defs) = fun_defs![fun] - { fi_free_vars,fi_def_level,fi_calls } = fun_info - (lifted_function_called, fi_free_vars, fun_defs) - = foldSt (add_free_vars_of_non_recursive_call fi_def_level group_index) fi_calls (lifted_function_called, fi_free_vars, fun_defs) - = (contains_free_vars || not (isEmpty fi_free_vars), lifted_function_called, - { fun_defs & [fun] = { fun_def & fun_info = { fun_info & fi_free_vars = fi_free_vars }}}) - where - add_free_vars_of_non_recursive_call fun_def_level group_index {fc_index} (lifted_function_called, free_vars, fun_defs) - # ({fun_info = {fi_free_vars,fi_group_index}}, fun_defs) = fun_defs![fc_index] -// | fi_group_index == group_index - | if (fi_group_index>=NoIndex) (fi_group_index==group_index) (-2-fi_group_index==group_index) - = (lifted_function_called, free_vars, fun_defs) - | isEmpty fi_free_vars - = (lifted_function_called, free_vars, fun_defs) - # (free_vars_added, free_vars) = add_free_variables fun_def_level fi_free_vars (False, free_vars) - = (True, free_vars, fun_defs) - - add_free_vars_of_recursive_calls_to_functions group_index group fun_defs - = foldSt (add_free_vars_of_recursive_calls_to_function group_index) group (False, fun_defs) - - add_free_vars_of_recursive_calls_to_function group_index fun (free_vars_added, fun_defs) - # (fun_def=:{fun_info}, fun_defs) = fun_defs![fun] - { fi_free_vars,fi_def_level,fi_calls } = fun_info - (free_vars_added, fi_free_vars, fun_defs) - = foldSt (add_free_vars_of_recursive_call fi_def_level group_index) fi_calls (free_vars_added, fi_free_vars, fun_defs) - = (free_vars_added, { fun_defs & [fun] = { fun_def & fun_info = { fun_info & fi_free_vars = fi_free_vars }}}) - where - add_free_vars_of_recursive_call fun_def_level group_index {fc_index} (free_vars_added, free_vars, fun_defs) - # ({fun_info = {fi_free_vars,fi_group_index}}, fun_defs) = fun_defs![fc_index] -// | fi_group_index == group_index - | if (fi_group_index>=NoIndex) (fi_group_index==group_index) (-2-fi_group_index==group_index) - # (free_vars_added, free_vars) = add_free_variables fun_def_level fi_free_vars (free_vars_added, free_vars) - = (free_vars_added, free_vars, fun_defs) - = (free_vars_added, free_vars, fun_defs) - - add_free_variables fun_level new_vars (free_vars_added, free_vars) - = add_free_global_variables (skip_local_variables fun_level new_vars) (free_vars_added, free_vars) - where - skip_local_variables level vars=:[{fv_def_level}:rest_vars] - | fv_def_level > level - = skip_local_variables level rest_vars - = vars - skip_local_variables _ [] - = [] - - add_free_global_variables [] (free_vars_added, free_vars) - = (free_vars_added, free_vars) - add_free_global_variables free_vars (free_vars_added, []) - = (True, free_vars) - add_free_global_variables [var:vars] (free_vars_added, free_vars) - # (free_var_added, free_vars) = newFreeVariable var free_vars - = add_free_global_variables vars (free_var_added || free_vars_added, free_vars) - - lift_functions group lift_state - = foldSt lift_function group lift_state - where - lift_function fun {ls_x=ls_x=:{x_fun_defs=fun_defs=:{[fun] = fun_def}}, ls_var_heap=var_heap, ls_expr_heap=expr_heap} - # {fi_free_vars} = fun_def.fun_info - fun_lifted = length fi_free_vars - (PartioningFunction {cb_args,cb_rhs} fun_number) = fun_def.fun_body - (cb_args, var_heap) = add_lifted_args fi_free_vars cb_args var_heap - (cb_rhs, {ls_x,ls_var_heap,ls_expr_heap}) = lift cb_rhs { ls_x={ls_x & x_fun_defs = fun_defs}, ls_var_heap = var_heap, ls_expr_heap = expr_heap } - ls_var_heap = remove_lifted_args fi_free_vars ls_var_heap - ls_fun_defs = ls_x.x_fun_defs - ls_fun_defs = { ls_fun_defs & [fun] = { fun_def & fun_lifted = fun_lifted, fun_body = PartioningFunction {cb_args = cb_args, cb_rhs = cb_rhs} fun_number}} - = {ls_x={ls_x & x_fun_defs=ls_fun_defs}, ls_var_heap=ls_var_heap, ls_expr_heap= ls_expr_heap} -// ---> ("lift_function", fun_def.fun_symb, fi_free_vars, cb_args, cb_rhs) - - remove_lifted_args vars var_heap - = foldl (\var_heap {fv_name,fv_info_ptr} -> writePtr fv_info_ptr VI_Empty var_heap) var_heap vars - - add_lifted_args [lifted_arg=:{fv_name,fv_info_ptr} : lifted_args] args var_heap - # (new_info_ptr, var_heap) = newPtr VI_Empty var_heap - args = [{ lifted_arg & fv_info_ptr = new_info_ptr } : args ] - = add_lifted_args lifted_args args (writePtr fv_info_ptr (VI_LiftedVariable new_info_ptr) var_heap) - add_lifted_args [] args var_heap - = (args, var_heap) :: ExpandInfo :== (![FunCall], !.ExpandState) -:: ExpandState = - { es_symbol_table :: !.SymbolTable - , es_var_heap :: !.VarHeap - , es_symbol_heap :: !.ExpressionHeap - , es_error :: !.ErrorAdmin, - es_fun_defs :: !.{#FunDef}, - es_main_dcl_module_n :: !Int, - es_dcl_modules :: !.{# DclModule}, - es_expand_in_imp_module :: !Bool, - es_new_fun_def_numbers :: ![Int] - } +add_new_fun_defs new_functions new_function_index last_function_index es=:{es_fun_defs,es_new_fun_def_numbers} + # new_fun_defs = new_fun_defs + with + new_fun_defs :: *{!FunDef} + new_fun_defs => {fun_def \\ (_,fun_def)<-new_functions} + # es_fun_defs = {if (i<new_function_index) es_fun_defs.[i] new_fun_defs.[i-new_function_index] \\ i<-[0..last_function_index]} // inefficient + = {es & es_fun_defs=es_fun_defs,es_new_fun_def_numbers=[new_function_index:es_new_fun_def_numbers]} class expand a :: !a !*ExpandInfo -> (!a, !*ExpandInfo) instance expand Expression where - expand (App app=:{app_symb = symb=:{symb_arity, symb_kind = SK_Macro {glob_object,glob_module}}, app_args}) ei + expand (App app=:{app_symb = symb=:{symb_arity, symb_kind = SK_DclMacro {glob_object,glob_module}}, app_args}) ei # (app_args, (calls, es)) = expand app_args ei - # (macro, es) = es!es_fun_defs.[glob_object] + # (macro, es) = es!es_macro_defs.[glob_module,glob_object] #! macro_group_index=macro.fun_info.fi_group_index - # es = {es & es_fun_defs.[glob_object].fun_info.fi_group_index= if (macro_group_index>NoIndex) (-2-macro_group_index) macro_group_index} + # es = {es & es_macro_defs.[glob_module,glob_object].fun_info.fi_group_index= if (macro_group_index>NoIndex) (-2-macro_group_index) macro_group_index} | macro.fun_arity == symb_arity - = unfoldMacro macro app_args (calls, es) + = unfoldMacro macro app_args True (calls, es) # macro = {macro & fun_info.fi_group_index=if (macro_group_index<NoIndex) (-2-macro_group_index) macro_group_index} #! new_function_index = size es.es_fun_defs # copied_local_functions = Yes { copied_local_functions=[],used_copied_local_functions=[],new_copied_local_functions=[],next_local_function_n=new_function_index+1} - # (macro,new_functions,local_macro_functions,es) = copy_macro_and_local_functions macro copied_local_functions es + # (macro,new_functions,local_macro_functions,es) = copy_macro_and_local_functions macro copied_local_functions True es // # new_function_index=trace ("new_function_index: "+++toString new_function_index+++"\n") new_function_index; # last_function_index = case local_macro_functions of (Yes {next_local_function_n}) -> next_local_function_n-1 - # es = add_new_fun_defs [({old_function_n=glob_object,new_function_n=new_function_index},macro):new_functions] new_function_index last_function_index es - with - add_new_fun_defs new_functions new_function_index last_function_index es=:{es_fun_defs,es_new_fun_def_numbers} - # new_fun_defs = new_fun_defs - with - new_fun_defs :: *{!FunDef} - new_fun_defs => {fun_def \\ (_,fun_def)<-new_functions} - # es_fun_defs = {if (i<new_function_index) es_fun_defs.[i] new_fun_defs.[i-new_function_index] \\ i<-[0..last_function_index]} // inefficient - = {es & es_fun_defs=es_fun_defs,es_new_fun_def_numbers=[new_function_index:es_new_fun_def_numbers]} - - # (calls, es_symbol_table) = examineFunctionCall macro.fun_symb {fc_index = new_function_index, fc_level = NotALevel} (calls, es.es_symbol_table) + # es = add_new_fun_defs [({old_function_n=DclMacroIndex glob_module glob_object,new_function_n=new_function_index},macro):new_functions] new_function_index last_function_index es + # (calls, es_symbol_table) = examineFunctionCall macro.fun_symb (FunCall new_function_index NotALevel) (calls, es.es_symbol_table) # app = App { app & app_symb = { symb & symb_kind = SK_LocalMacroFunction new_function_index }, app_args = app_args } /* | macro.fun_info.fi_group_index>NoIndex @@ -1424,6 +1593,26 @@ where = (app, (calls, { es & es_symbol_table = es_symbol_table })) = (app, (calls, { es & es_symbol_table = es_symbol_table })) */ + expand (App app=:{app_symb = symb=:{symb_arity, symb_kind = SK_IclMacro glob_object}, app_args}) ei + # (app_args, (calls, es)) = expand app_args ei + # (macro, es) = es!es_fun_defs.[glob_object] + #! macro_group_index=macro.fun_info.fi_group_index + # es = {es & es_fun_defs.[glob_object].fun_info.fi_group_index= if (macro_group_index>NoIndex) (-2-macro_group_index) macro_group_index} + | macro.fun_arity == symb_arity + = unfoldMacro macro app_args False (calls, es) + + # macro = {macro & fun_info.fi_group_index=if (macro_group_index<NoIndex) (-2-macro_group_index) macro_group_index} + #! new_function_index = size es.es_fun_defs + # copied_local_functions = Yes { copied_local_functions=[],used_copied_local_functions=[],new_copied_local_functions=[],next_local_function_n=new_function_index+1} + + # (macro,new_functions,local_macro_functions,es) = copy_macro_and_local_functions macro copied_local_functions False es +// # new_function_index=trace ("new_function_index: "+++toString new_function_index+++"\n") new_function_index; + # last_function_index = case local_macro_functions of (Yes {next_local_function_n}) -> next_local_function_n-1 + # es = add_new_fun_defs [({old_function_n=FunctionOrIclMacroIndex glob_object,new_function_n=new_function_index},macro):new_functions] new_function_index last_function_index es + # (calls, es_symbol_table) = examineFunctionCall macro.fun_symb (FunCall new_function_index NotALevel) (calls, es.es_symbol_table) + # app = App { app & app_symb = { symb & symb_kind = SK_LocalMacroFunction new_function_index }, app_args = app_args } + = (app, (calls, { es & es_symbol_table = es_symbol_table })) + expand (App app=:{app_args}) ei # (app_args, ei) = expand app_args ei = (App { app & app_args = app_args }, ei) @@ -1450,10 +1639,7 @@ where expand (TupleSelect symbol argn_nr expr) ei # (expr, ei) = expand expr ei = (TupleSelect symbol argn_nr expr, ei) -/* expand (Lambda vars expr) ei - # (expr, ei) = expand expr ei - = (Lambda vars expr, ei) -*/ expand (MatchExpr opt_tuple cons_symb expr) ei + expand (MatchExpr opt_tuple cons_symb expr) ei # (expr, ei) = expand expr ei = (MatchExpr opt_tuple cons_symb expr, ei) expand expr ei @@ -1877,12 +2063,7 @@ instance <<< (Ptr a) where (<<<) file p = file <<< ptrToInt p -instance <<< FunCall -where - (<<<) file {fc_index} = file <<< fc_index - instance <<< VarInfo where (<<<) file (VI_Expression expr) = file <<< expr (<<<) file vi = file <<< "VI??" - diff --git a/frontend/type.icl b/frontend/type.icl index 342b733..01474a7 100644 --- a/frontend/type.icl +++ b/frontend/type.icl @@ -1958,7 +1958,7 @@ typeProgram comps main_dcl_module_n fun_defs specials list_inferred_types icl_de ti_common_defs = {{dcl_common \\ {dcl_common} <-: modules } & [main_dcl_module_n] = icl_defs } ti_functions = {dcl_functions \\ {dcl_functions} <-: modules } - type_def_sizes = [ size com_type_defs \\ {com_type_defs} <-: ti_common_defs ] +// type_def_sizes = [ size com_type_defs \\ {com_type_defs} <-: ti_common_defs ] class_def_sizes = [ size com_class_defs \\ {com_class_defs} <-: ti_common_defs ] class_instances = { { IT_Empty \\ i <- [0 .. dec size] } \\ size <- class_def_sizes } state = collect_imported_instances imports ti_common_defs {} ts_error class_instances hp_type_heaps.th_vars td_infos @@ -2400,7 +2400,7 @@ where | n_new_elements==0 = fun_defs # dummy_fun_def = { fun_symb = {id_name="",id_info=nilPtr},fun_arity=0,fun_priority=NoPrio,fun_body=NoBody,fun_type=No,fun_pos=NoPos, - fun_kind=FK_DefOrImpUnknown,fun_lifted=0,fun_info = {fi_calls=[],fi_group_index=0,fi_def_level=NotALevel,fi_free_vars=[],fi_local_vars=[],fi_dynamics=[],fi_properties=0}} + fun_kind=FK_Unknown,fun_lifted=0,fun_info = {fi_calls=[],fi_group_index=0,fi_def_level=NotALevel,fi_free_vars=[],fi_local_vars=[],fi_dynamics=[],fi_properties=0}} = {createArray (size fun_defs+n_new_elements) dummy_fun_def & [i]=fun_defs.[i] \\ i<-[0..size fun_defs-1]} (array_first_instance_indices,fun_defs, predef_symbols, type_heaps, error) = convert_array_instances si_array_instances common_defs fun_defs predef_symbols type_heaps error @@ -2452,7 +2452,7 @@ where , fun_body = NoBody , fun_type = Yes instance_type , fun_pos = me_pos - , fun_kind = FK_DefOrImpUnknown + , fun_kind = FK_Unknown , fun_lifted = 0 , fun_info = EmptyFunInfo } @@ -2494,7 +2494,7 @@ where , fun_body = NoBody , fun_type = Yes instance_type , fun_pos = me_pos - , fun_kind = FK_DefOrImpUnknown + , fun_kind = FK_Unknown , fun_lifted = 0 , fun_info = EmptyFunInfo } diff --git a/frontend/typesupport.icl b/frontend/typesupport.icl index f500764..2f62469 100644 --- a/frontend/typesupport.icl +++ b/frontend/typesupport.icl @@ -1274,6 +1274,7 @@ where = writeWithinBrackets "(" ")" file opt_beautifulizer (clearProperty (setProperty form cArrowSeparator) cBrackets, [arg_type, res_type]) = writeType file opt_beautifulizer (setProperty form (cBrackets bitor cArrowSeparator), [arg_type, res_type]) + writeType file opt_beautifulizer (form, type :@: types) | checkProperty form cBrackets # (file, opt_beautifulizer) |