diff options
| -rw-r--r-- | frontend/check.icl | 504 | ||||
| -rw-r--r-- | frontend/checksupport.dcl | 12 | ||||
| -rw-r--r-- | frontend/checksupport.icl | 2 | ||||
| -rw-r--r-- | frontend/checktypes.dcl | 6 | ||||
| -rw-r--r-- | frontend/checktypes.icl | 70 | ||||
| -rw-r--r-- | frontend/postparse.icl | 12 | ||||
| -rw-r--r-- | frontend/predef.icl | 5 | ||||
| -rw-r--r-- | frontend/syntax.dcl | 13 | ||||
| -rw-r--r-- | frontend/syntax.icl | 12 | ||||
| -rw-r--r-- | frontend/utilities.icl | 1 |
10 files changed, 284 insertions, 353 deletions
diff --git a/frontend/check.icl b/frontend/check.icl index c2540e2..705cc38 100644 --- a/frontend/check.icl +++ b/frontend/check.icl @@ -6,7 +6,6 @@ import syntax, typesupport, parse, checksupport, utilities, checktypes, transfor import explicitimports -// MW moved cIclModIndex :== 0 cPredefinedModuleIndex :== 1 convertIndex :: !Index !Index !(Optional ConversionTable) -> !Index @@ -38,9 +37,9 @@ where _ -> ({ ds_ident = symb_id, ds_index = NoIndex, ds_arity = arity }, { cs & cs_error = checkError symb_id "undefined" cs.cs_error }) -checkTypeClasses :: !Index !Index !Int !*{#ClassDef} !*{#MemberDef} !*{#CheckedTypeDef} !*{#DclModule} !*TypeHeaps !*CheckState +checkTypeClasses :: !Index !Index !*{#ClassDef} !*{#MemberDef} !*{#CheckedTypeDef} !*{#DclModule} !*TypeHeaps !*CheckState -> (!*{#ClassDef}, !*{#MemberDef}, !*{#CheckedTypeDef}, !*{#DclModule}, !*TypeHeaps, !*CheckState) -checkTypeClasses class_index module_index upper_limit class_defs member_defs type_defs modules type_heaps=:{th_vars} cs=:{cs_symbol_table,cs_error} +checkTypeClasses class_index module_index class_defs member_defs type_defs modules type_heaps=:{th_vars} cs=:{cs_symbol_table,cs_error} | class_index == size class_defs = (class_defs, member_defs, type_defs, modules, type_heaps, cs) #! class_def = class_defs.[class_index] @@ -55,8 +54,7 @@ checkTypeClasses class_index module_index upper_limit class_defs member_defs typ (class_args, cs_symbol_table) = retrieve_variables_from_symbol_table rev_class_args [] cs.cs_symbol_table class_defs = { class_defs & [class_index] = { class_def & class_context = class_context, class_args = class_args }} member_defs = set_classes_in_member_defs 0 class_members {glob_object = class_index, glob_module = module_index} member_defs -// MW was = checkTypeClasses (inc class_index) module_index class_defs member_defs type_defs modules type_heaps { cs & cs_symbol_table = cs_symbol_table } - = checkTypeClasses (inc class_index) module_index upper_limit class_defs member_defs type_defs modules type_heaps { cs & cs_symbol_table = cs_symbol_table } + = checkTypeClasses (inc class_index) module_index class_defs member_defs type_defs modules type_heaps { cs & cs_symbol_table = cs_symbol_table } where add_variables_to_symbol_table :: !Level ![TypeVar] ![TypeVar] !*SymbolTable !*TypeVarHeap !*ErrorAdmin -> (![TypeVar],!*SymbolTable,!*TypeVarHeap,!*ErrorAdmin) @@ -168,17 +166,11 @@ where checkSpecialsOfInstances mod_index first_mem_index [] next_inst_index all_class_instances all_specials inst_spec_defs all_spec_types heaps error = (next_inst_index, all_class_instances, all_specials, all_spec_types, heaps, error) -/* MW was checkMemberTypes :: !Index !*{#MemberDef} !*{#CheckedTypeDef} !*{#ClassDef} !*{#DclModule} !*TypeHeaps !*VarHeap !*CheckState -> (!*{#MemberDef}, !*{#CheckedTypeDef}, !*{#ClassDef}, !*{#DclModule}, !*TypeHeaps, !*VarHeap, !*CheckState) checkMemberTypes module_index member_defs type_defs class_defs modules type_heaps var_heap cs #! nr_of_members = size member_defs = iFoldSt (check_class_member module_index) 0 nr_of_members (member_defs, type_defs, class_defs, modules, type_heaps, var_heap, cs) -*/ -checkMemberTypes :: !Index !Int !*{#MemberDef} !*{#CheckedTypeDef} !*{#ClassDef} !*{#DclModule} !*TypeHeaps !*VarHeap !*CheckState - -> (!*{#MemberDef}, !*{#CheckedTypeDef}, !*{#ClassDef}, !*{#DclModule}, !*TypeHeaps, !*VarHeap, !*CheckState) -checkMemberTypes module_index nr_of_members member_defs type_defs class_defs modules type_heaps var_heap cs - = iFoldSt (check_class_member module_index) 0 nr_of_members (member_defs, type_defs, class_defs, modules, type_heaps, var_heap, cs) where check_class_member module_index member_index (member_defs, type_defs, class_defs, modules, type_heaps, var_heap, cs) # (member_def=:{me_symb,me_type,me_pos}, member_defs) = member_defs![member_index] @@ -2126,36 +2118,25 @@ where (<) fd1 fd2 = fd1.fun_symb.id_name < fd2.fun_symb.id_name -//createCommonDefinitions :: !(CollectedDefinitions ClassInstance) -> *CommonDefs -createCommonDefinitions {def_types,def_constructors,def_selectors,def_macros,def_classes,def_members,def_instances} var_heap - # (cons_defs, var_heap) = mapSt new_constructor def_constructors var_heap - (sel_defs, var_heap) = mapSt new_selector def_selectors var_heap - = ({ com_type_defs = { type \\ type <- def_types } - , com_cons_defs = { cons \\ cons <- cons_defs } - , com_selector_defs = { sel \\ sel <- sel_defs } -// , com_macro_defs = { macro \\ macro <- def_macros } +createCommonDefinitions {def_types,def_constructors,def_selectors,def_macros,def_classes,def_members,def_instances} + = { com_type_defs = { type \\ type <- def_types } + , com_cons_defs = { cons \\ cons <- def_constructors } + , com_selector_defs = { sel \\ sel <- def_selectors } , com_class_defs = { class_def \\ class_def <- def_classes } , com_member_defs = { member \\ member <- def_members } , com_instance_defs = { next_instance \\ next_instance <- def_instances } - }, var_heap) - where - new_constructor cons var_heap - # (new_type_ptr, var_heap) = newPtr VI_Empty var_heap - = (ParsedConstructorToConsDef cons new_type_ptr, var_heap) - - new_selector sel var_heap - # (new_type_ptr, var_heap) = newPtr VI_Empty var_heap - = (ParsedSelectorToSelectorDef sel new_type_ptr, var_heap) + } IsMainDclMod is_dcl module_index :== is_dcl && module_index == cIclModIndex -/* MW was + checkCommonDefinitions :: !Bool !Index !*CommonDefs !*{# DclModule} !*TypeHeaps !*VarHeap !*CheckState -> (!*CommonDefs, !*{# DclModule}, !*TypeHeaps, !*VarHeap, !*CheckState) checkCommonDefinitions is_dcl module_index common modules type_heaps var_heap cs - # (com_type_defs, com_cons_defs, com_selector_defs, modules, type_heaps, cs) - = checkTypeDefs (IsMainDclMod is_dcl module_index) common.com_type_defs module_index common.com_cons_defs common.com_selector_defs modules type_heaps cs + # (com_type_defs, com_cons_defs, com_selector_defs, modules, var_heap, type_heaps, cs) + = checkTypeDefs (IsMainDclMod is_dcl module_index) common.com_type_defs module_index + common.com_cons_defs common.com_selector_defs modules var_heap type_heaps cs (com_class_defs, com_member_defs, com_type_defs, modules, type_heaps, cs) = checkTypeClasses 0 module_index 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) @@ -2170,140 +2151,170 @@ checkCommonDefinitions is_dcl module_index common modules type_heaps var_heap cs com_cons_defs = { cons_def \\ cons_def <- [ cons_def \\ cons_def <-: com_cons_defs ] ++ new_cons_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 }, modules, { type_heaps & th_vars = th_vars }, var_heap, cs) -*/ -checkCommonDefinitions :: !Bool !Index !{#Int} !*CommonDefs !*{# DclModule} !*TypeHeaps !*VarHeap !*CheckState - -> (!*CommonDefs, !*{# DclModule}, !*TypeHeaps, !*VarHeap, !*CheckState) -checkCommonDefinitions is_dcl module_index upper_limits common modules type_heaps var_heap cs - # (com_type_defs, com_cons_defs, com_selector_defs, modules, type_heaps, cs) - = checkTypeDefs (IsMainDclMod is_dcl module_index) common.com_type_defs module_index upper_limits.[cTypeDefs] - common.com_cons_defs common.com_selector_defs modules type_heaps cs - (com_class_defs, com_member_defs, com_type_defs, modules, type_heaps, cs) - = checkTypeClasses 0 module_index upper_limits.[cClassDefs] 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 upper_limits.[cMemberDefs] com_member_defs com_type_defs com_class_defs modules type_heaps var_heap cs - (com_instance_defs, com_type_defs, com_class_defs, com_member_defs, modules, type_heaps, cs) - = checkInstanceDefs module_index common.com_instance_defs com_type_defs com_class_defs com_member_defs modules type_heaps cs - (com_class_defs, modules, new_type_defs, new_selector_defs, new_cons_defs, th_vars, var_heap, cs) - = createClassDictionaries module_index com_class_defs modules (size com_type_defs) (size com_selector_defs) - (size com_cons_defs) upper_limits.[cClassDefs] type_heaps.th_vars var_heap cs - com_type_defs = { type_def \\ type_def <- [ type_def \\ type_def <-: com_type_defs ] ++ new_type_defs } - com_selector_defs = { sel_def \\ sel_def <- [ sel_def \\ sel_def <-: com_selector_defs ] ++ new_selector_defs } - com_cons_defs = { cons_def \\ cons_def <- [ cons_def \\ cons_def <-: com_cons_defs ] ++ new_cons_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 }, modules, { type_heaps & th_vars = th_vars }, var_heap, cs) +collectCommonfinitions :: !(CollectedDefinitions ClassInstance a) -> (!*{# Int}, ![Declaration]) +collectCommonfinitions {def_types,def_constructors,def_selectors,def_macros,def_classes,def_members,def_instances} + # sizes = createArray cConversionTableSize 0 + (size, defs) = foldSt type_def_to_dcl def_types (0, []) + sizes = { sizes & [cTypeDefs] = size } + (size, defs) = foldSt cons_def_to_dcl def_constructors (0, defs) + sizes = { sizes & [cConstructorDefs] = size } + (size, defs) = foldSt selector_def_to_dcl def_selectors (0, defs) + sizes = { sizes & [cSelectorDefs] = size } + (size, defs) = foldSt class_def_to_dcl def_classes (0, defs) + sizes = { sizes & [cClassDefs] = size } + (size, defs) = foldSt member_def_to_dcl def_members (0, defs) + sizes = { sizes & [cMemberDefs] = size } + (size, defs) = foldSt instance_def_to_dcl def_instances (0, defs) + sizes = { sizes & [cInstanceDefs] = size } + = (sizes, defs) +where + type_def_to_dcl {td_name, td_pos} (dcl_index, decls) + = (inc dcl_index, [{ dcl_ident = td_name, dcl_pos = td_pos, dcl_kind = STE_Type, dcl_index = dcl_index } : decls]) + cons_def_to_dcl {cons_symb, cons_pos} (dcl_index, decls) + = (inc dcl_index, [{ dcl_ident = cons_symb, dcl_pos = cons_pos, dcl_kind = STE_Constructor, dcl_index = dcl_index } : decls]) + selector_def_to_dcl {sd_symb, sd_field, sd_pos} (dcl_index, decls) + = (inc dcl_index, [{ dcl_ident = sd_field, dcl_pos = sd_pos, dcl_kind = STE_Field sd_symb, dcl_index = dcl_index } : decls]) + class_def_to_dcl {class_name, class_pos} (dcl_index, decls) + = (inc dcl_index, [{ dcl_ident = class_name, dcl_pos = class_pos, dcl_kind = STE_Class, dcl_index = dcl_index } : decls]) + member_def_to_dcl {me_symb, me_pos} (dcl_index, decls) + = (inc dcl_index, [{ dcl_ident = me_symb, dcl_pos = me_pos, dcl_kind = STE_Member, dcl_index = dcl_index } : decls]) + instance_def_to_dcl {ins_ident, ins_pos} (dcl_index, decls) + = (inc dcl_index, [{ dcl_ident = ins_ident, dcl_pos = ins_pos, dcl_kind = STE_Instance, dcl_index = dcl_index } : decls]) + +collectMacros {ir_from,ir_to} macro_defs sizes_defs + = collectGlobalFunctions cMacroDefs ir_from ir_to macro_defs sizes_defs + +collectFunctionTypes fun_types (sizes, defs) + # (size, defs) = foldSt fun_type_to_dcl fun_types (0, defs) + = ({ sizes & [cFunctionDefs] = size }, defs) +where + fun_type_to_dcl {ft_symb, ft_pos} (dcl_index, decls) + = (inc dcl_index, [{ dcl_ident = ft_symb, dcl_pos = ft_pos, dcl_kind = STE_DclFunction, dcl_index = dcl_index } : decls]) -strictMapAppendi :: !(Index -> a -> b) !Index ![a] ![b] -> [b] -strictMapAppendi f i [] t = t -strictMapAppendi f i [x : xs] t - #! t = strictMapAppendi f (inc i) xs t - el = f i x - = [el : t] - -collectCommonfinitions :: !(CollectedDefinitions ClassInstance a) ![Declaration] -> [Declaration] -collectCommonfinitions {def_types,def_constructors,def_selectors,def_macros,def_classes,def_members,def_instances} defs - # defs = strictMapAppendi (\dcl_index {td_name} -> { dcl_ident = td_name, dcl_kind = STE_Type, dcl_index = dcl_index }) 0 def_types defs - defs = strictMapAppendi (\dcl_index {pc_cons_name} -> { dcl_ident = pc_cons_name, dcl_kind = STE_Constructor, dcl_index = dcl_index }) 0 def_constructors defs - defs = strictMapAppendi (\dcl_index {ps_selector_name,ps_field_name} -> { dcl_ident = ps_field_name, dcl_kind = STE_Field ps_selector_name, dcl_index = dcl_index }) 0 def_selectors defs - defs = strictMapAppendi (\dcl_index {class_name} -> { dcl_ident = class_name, dcl_kind = STE_Class, dcl_index = dcl_index }) 0 def_classes defs - defs = strictMapAppendi (\dcl_index {me_symb} -> { dcl_ident = me_symb, dcl_kind = STE_Member, dcl_index = dcl_index }) 0 def_members defs - defs = strictMapAppendi (\dcl_index {ins_ident} -> { dcl_ident = ins_ident, dcl_kind = STE_Instance, dcl_index = dcl_index }) 0 def_instances defs - = defs - -collectMacros {ir_from,ir_to} defs macro_defs - = collectGlobalFunctions ir_from ir_to defs macro_defs - -collectFunctionTypes fun_types defs - = strictMapAppendi (\dcl_index {ft_symb} -> { dcl_ident = ft_symb, dcl_kind = STE_DclFunction, dcl_index = dcl_index }) 0 fun_types defs - -collectGlobalFunctions from_index to_index defs fun_defs - | from_index == to_index - = (defs, fun_defs) - #! fun_def = fun_defs.[from_index] - (defs, fun_defs) = collectGlobalFunctions (inc from_index) to_index defs fun_defs - = ([{ dcl_ident = fun_def.fun_symb, dcl_kind = STE_FunctionOrMacro [], dcl_index = from_index } : defs], fun_defs) - -combineDclAndIclModule MK_Main modules icl_defs cs -// MW was = (modules, cs) - = (modules, createArray cConversionTableSize [], cs) -combineDclAndIclModule _ modules icl_defs cs -/* MW was - #! dcl_mod = modules.[cIclModIndex] - # {dcl_declared={dcls_local},dcl_macros} = dcl_mod - cs = addGlobalDefinitionsToSymbolTable icl_defs cs - conversion_table = { createArray size NoIndex \\ size <-: count_defs (createArray cConversionTableSize 0) dcls_local } - (conversion_table, cs) = build_conversion_table conversion_table dcls_local dcl_macros.ir_from cs - cs_symbol_table = removeDeclarationsFromSymbolTable icl_defs cGlobalScope cs.cs_symbol_table - = ( { modules & [cIclModIndex] = { dcl_mod & dcl_conversions = Yes conversion_table }}, { cs & cs_symbol_table = cs_symbol_table }) -*/ - #! dcl_mod = modules.[cIclModIndex] - # {dcl_declared={dcls_local},dcl_macros} = dcl_mod - cs = addGlobalDefinitionsToSymbolTable icl_defs cs - sizes = count_defs (createArray cConversionTableSize 0) dcls_local - conversion_table = { createArray size NoIndex \\ size <-: sizes } - defs_only_in_dcl = { (size, []) \\ size <-: sizes } - (conversion_table, defs_only_in_dcl_l, cs) - = build_conversion_table conversion_table dcls_local dcl_macros.ir_from defs_only_in_dcl cs - # cs_symbol_table = removeDeclarationsFromSymbolTable icl_defs cGlobalScope cs.cs_symbol_table - = ( { modules & [cIclModIndex] = { dcl_mod & dcl_conversions = Yes conversion_table }} - , defs_only_in_dcl_l - , { cs & cs_symbol_table = cs_symbol_table } - ) +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) + = (fun_defs, ({ sizes & [def_index] = to_index - from_index }, defs)) where -// MW was build_conversion_table conversion_table [{dcl_ident=ident=:{id_info},dcl_kind,dcl_index} : local_defs] first_macro_index cs=:{cs_symbol_table, cs_error} - build_conversion_table conversion_table [decl=:{dcl_ident=ident=:{id_info},dcl_kind,dcl_index} : local_defs] - first_macro_index defs_only_in_dcl cs=:{cs_symbol_table, cs_error} - #! entry = sreadPtr id_info cs_symbol_table - # {ste_kind,ste_index,ste_def_level} = entry -/* MW was + fun_def_to_dcl dcl_index (defs, fun_defs) + # ({fun_symb, fun_pos}, fun_defs) = fun_defs![dcl_index] + = ([{ dcl_ident = fun_symb, dcl_pos = fun_pos, dcl_kind = STE_FunctionOrMacro [], dcl_index = dcl_index } : defs], fun_defs) + +combineDclAndIclModule MK_Main modules icl_decl_symbols icl_definitions icl_sizes cs + = (modules, icl_decl_symbols, icl_definitions, icl_sizes, cs) +combineDclAndIclModule _ modules icl_decl_symbols icl_definitions icl_sizes cs + # (dcl_mod=:{dcl_declared={dcls_local},dcl_macros, dcl_sizes, dcl_common}, modules) = modules![cIclModIndex] + + cs = addGlobalDefinitionsToSymbolTable icl_decl_symbols cs + + (moved_dcl_defs, icl_sizes, icl_decl_symbols, cs) + = foldSt add_undefined_dcl_def dcls_local ([], icl_sizes, icl_decl_symbols, cs) + (conversion_table, cs) + = foldSt (add_to_conversion_table dcl_macros.ir_from) dcls_local ({ createArray size NoIndex \\ size <-: dcl_sizes }, cs) + (new_type_defs, new_class_defs, new_cons_defs, new_selector_defs, new_member_defs, cs) + = foldSt (add_dcl_definition dcl_common) moved_dcl_defs ([], [], [], [], [], cs) + + cs_symbol_table = removeDeclarationsFromSymbolTable icl_decl_symbols cGlobalScope cs.cs_symbol_table + + = ( { modules & [cIclModIndex] = { dcl_mod & dcl_conversions = Yes conversion_table }} + , icl_decl_symbols + , { icl_definitions + & def_types = rev_append icl_definitions.def_types new_type_defs + , def_constructors = rev_append icl_definitions.def_constructors new_cons_defs + , def_selectors = rev_append icl_definitions.def_selectors new_selector_defs + , def_classes = rev_append icl_definitions.def_classes new_class_defs + , def_members = rev_append icl_definitions.def_members new_member_defs + } + , icl_sizes + , { cs & cs_symbol_table = cs_symbol_table } + ) + +where + add_to_conversion_table first_macro_index decl=:{dcl_ident,dcl_kind,dcl_index,dcl_pos} (conversion_table, cs) + # ({ste_kind,ste_index,ste_def_level}, cs_symbol_table) = readPtr dcl_ident.id_info cs.cs_symbol_table | ste_def_level == cGlobalScope && ste_kind == dcl_kind # def_index = toInt dcl_kind dcl_index = if (def_index == cMacroDefs) (dcl_index - first_macro_index) dcl_index - # conversion_table = { conversion_table & [def_index].[dcl_index] = ste_index } - = build_conversion_table conversion_table local_defs first_macro_index cs - = build_conversion_table conversion_table local_defs first_macro_index { cs & cs_error = checkError ident "inconsistently defined" cs_error } - = build_conversion_table conversion_table local_defs first_macro_index { cs & cs_error = checkError ident "inconsistently defined" cs_error } - build_conversion_table conversion_table [] first_macro_index cs - = (conversion_table, cs) -*/ - def_index = toInt dcl_kind - dcl_index = if (def_index == cMacroDefs) (dcl_index - first_macro_index) dcl_index - | ste_kind == STE_Empty && can_be_only_in_dcl dcl_kind - # ((top,defs), defs_only_in_dcl) = defs_only_in_dcl![def_index] - defs_only_in_dcl = { defs_only_in_dcl & [def_index] = (inc top, [decl:defs])} - conversion_table = { conversion_table & [def_index].[dcl_index] = top } - = build_conversion_table conversion_table local_defs first_macro_index defs_only_in_dcl cs - | ste_def_level == cGlobalScope && ste_kind == dcl_kind - # conversion_table = { conversion_table & [def_index].[dcl_index] = ste_index } - = build_conversion_table conversion_table local_defs first_macro_index defs_only_in_dcl cs - = build_conversion_table conversion_table local_defs first_macro_index defs_only_in_dcl - { cs & cs_error = checkError ident "inconsistently defined" cs_error } - build_conversion_table conversion_table [] first_macro_index defs_only_in_dcl cs - = (conversion_table, {reverse decls \\ (_,decls) <-: defs_only_in_dcl}, cs) - -// MW.. - can_be_only_in_dcl STE_Type = True - can_be_only_in_dcl STE_Constructor = True - can_be_only_in_dcl (STE_Field _) = True - can_be_only_in_dcl STE_Class = True - can_be_only_in_dcl STE_Member = True - can_be_only_in_dcl (STE_FunctionOrMacro _) = True - can_be_only_in_dcl STE_DclFunction = False - can_be_only_in_dcl _ = False -// .. MW - - count_defs :: !*{# Int} ![Declaration] -> *{# Int} - count_defs def_counts [] - = def_counts - count_defs def_counts [{dcl_kind} : local_defs] - # def_index = toInt dcl_kind - #! count = def_counts.[def_index] - = count_defs { def_counts & [def_index] = inc count } local_defs + = ({ conversion_table & [def_index].[dcl_index] = ste_index }, { cs & cs_symbol_table = cs_symbol_table }) + # cs_error = checkError "definition module" "conflicting definition in implementation module" + (setErrorAdmin (newPosition dcl_ident dcl_pos) cs.cs_error) + = (conversion_table, { cs & cs_error = cs_error, cs_symbol_table = cs_symbol_table }) + + add_undefined_dcl_def dcl=:{dcl_ident={id_info}} (moved_dcl_defs, icl_sizes, icl_defs, cs) + # (entry, cs_symbol_table) = readPtr id_info cs.cs_symbol_table + | entry.ste_kind == STE_Empty + = check_and_add_dcl_def id_info entry dcl (moved_dcl_defs, icl_sizes, icl_defs, { cs & cs_symbol_table = cs_symbol_table }) + = (moved_dcl_defs, icl_sizes, icl_defs, { cs & cs_symbol_table = cs_symbol_table }) + where + check_and_add_dcl_def info_ptr entry dcl=:{dcl_kind = STE_Type} (moved_dcl_defs, icl_sizes, icl_defs, cs) + # (icl_sizes, icl_defs, cs_symbol_table) = add_dcl_declaration info_ptr entry dcl cTypeDefs (icl_sizes, icl_defs, cs.cs_symbol_table) + = ([ dcl : moved_dcl_defs ], icl_sizes, icl_defs, { cs & cs_symbol_table = cs_symbol_table }) + check_and_add_dcl_def info_ptr entry dcl=:{dcl_kind = STE_Constructor} (moved_dcl_defs, icl_sizes, icl_defs, cs) + # (icl_sizes, icl_defs, cs_symbol_table) = add_dcl_declaration info_ptr entry dcl cConstructorDefs (icl_sizes, icl_defs, cs.cs_symbol_table) + = ([ dcl : moved_dcl_defs ], icl_sizes, icl_defs, { cs & cs_symbol_table = cs_symbol_table }) + check_and_add_dcl_def info_ptr entry {dcl_ident, dcl_pos} (moved_dcl_defs, icl_sizes, icl_defs, cs) + # cs_error = checkError "definition module" "undefined in implementation module" (setErrorAdmin (newPosition dcl_ident dcl_pos) cs.cs_error) + = (moved_dcl_defs, icl_sizes, icl_defs, { cs & cs_error = cs_error }) + + add_dcl_declaration info_ptr entry dcl def_index (icl_sizes, icl_defs, symbol_table) + # (dcl_index, icl_sizes) = icl_sizes![def_index] + = ({ icl_sizes & [def_index] = inc dcl_index }, + [ { dcl & dcl_index = dcl_index } : icl_defs ], + NewEntry symbol_table info_ptr dcl.dcl_kind dcl_index cGlobalScope entry) -/* MW moved -cIsNotADclModule :== False -cIsADclModule :== True -*/ + add_dcl_definition {com_type_defs} dcl=:{dcl_kind = STE_Type, dcl_index} + (new_type_defs, new_class_defs, new_cons_defs, new_selector_defs, new_member_defs, cs) + # type_def = com_type_defs.[dcl_index] + (new_type_defs, cs) = add_type_def type_def new_type_defs cs + = (new_type_defs, new_class_defs, new_cons_defs, new_selector_defs, new_member_defs, cs) + where + add_type_def td=:{td_pos, td_rhs = AlgType conses} new_type_defs cs + # (conses, cs) = mapSt (redirect_defined_symbol STE_Constructor td_pos) conses cs + = ([ { td & td_rhs = AlgType conses} : new_type_defs ], cs) + add_type_def td=:{td_pos, td_rhs = RecordType rt=:{rt_constructor,rt_fields}} new_type_defs cs + # (rt_constructor, cs) = redirect_defined_symbol STE_Constructor td_pos rt_constructor cs + (rt_fields, cs) = redirect_field_symbols td_pos rt_fields cs + = ([ { td & td_rhs = RecordType { rt & rt_constructor = rt_constructor, rt_fields = rt_fields }} : new_type_defs ], cs) + add_type_def td=:{td_name, td_pos} new_type_defs cs + # cs_error = checkError "definition module" "abstract type not defined in implementation module" + (setErrorAdmin (newPosition td_name td_pos) cs.cs_error) + = (new_type_defs, { cs & cs_error = cs_error }) + add_type_def td new_type_defs cs + = ([td : new_type_defs], cs) + + redirect_defined_symbol req_kind pos ds=:{ds_ident} cs + # ({ste_kind,ste_index}, cs_symbol_table) = readPtr ds_ident.id_info cs.cs_symbol_table + | ste_kind == req_kind + = ({ ds & ds_index = ste_index }, { cs & cs_symbol_table = cs_symbol_table }) + # cs_error = checkError "definition module" "conflicting definition in implementation module" + (setErrorAdmin (newPosition ds_ident pos) cs.cs_error) + = ({ ds & ds_index = ste_index }, { cs & cs_error = cs_error, cs_symbol_table = cs_symbol_table }) + + redirect_field_symbols pos fields cs + # new_fields = { field \\ field <-: fields } + = iFoldSt (redirect_field_symbol pos fields) 0 (size fields) (new_fields, cs) + where + redirect_field_symbol pos fields field_nr (new_fields, cs) + # field = fields.[field_nr] + ({ste_kind,ste_index}, cs_symbol_table) = readPtr field.fs_name.id_info cs.cs_symbol_table + | is_field ste_kind + = ({ new_fields & [field_nr] = { field & fs_index = ste_index }}, { cs & cs_symbol_table = cs_symbol_table }) + # cs_error = checkError "definition module" "conflicting definition in implementation module" + (setErrorAdmin (newPosition field.fs_name pos) cs.cs_error) + = (new_fields, { cs & cs_error = cs_error, cs_symbol_table = cs_symbol_table }) + + is_field (STE_Field _) = True + is_field _ = False + + add_dcl_definition {com_cons_defs} dcl=:{dcl_kind = STE_Constructor, dcl_index} + (new_type_defs, new_class_defs, new_cons_defs, new_selector_defs, new_member_defs, cs) + = (new_type_defs, new_class_defs, [ com_cons_defs.[dcl_index] : new_cons_defs ], new_selector_defs, new_member_defs, cs) + + + rev_append front [] + = front + rev_append front back + = front ++ reverse back (<=<) infixl (<=<) state fun :== fun state @@ -2321,20 +2332,21 @@ checkModule {mod_type,mod_name,mod_imports,mod_imported_objects,mod_defs = cdefs cdefs = { cdefs & def_instances = def_instances } #! nr_of_functions = size icl_functions - # local_defs = collectCommonfinitions cdefs [] - (local_defs, icl_functions) = collectGlobalFunctions 0 nr_of_global_funs local_defs icl_functions - (local_defs, icl_functions) = collectMacros cdefs.def_macros local_defs icl_functions + # sizes_and_local_defs = collectCommonfinitions cdefs + (icl_functions, sizes_and_local_defs) = collectGlobalFunctions cFunctionDefs 0 nr_of_global_funs icl_functions sizes_and_local_defs + (icl_functions, (sizes, local_defs)) = collectMacros cdefs.def_macros icl_functions sizes_and_local_defs (scanned_modules, icl_functions, cs) = add_modules_to_symbol_table [ dcl_mod, pre_def_mod : scanned_modules ] 0 icl_functions { cs_symbol_table = symbol_table, cs_predef_symbols = predef_symbols, cs_error = error } - (init_dcl_modules, hp_var_heap) = mapSt initialDclModule scanned_modules newHeap -// MW was (dcl_modules, cs) - (dcl_modules, defs_only_in_main_dcl, cs) - = combineDclAndIclModule mod_type { dcl_module \\ dcl_module <- init_dcl_modules } local_defs cs + init_dcl_modules = [ initialDclModule scanned_module \\ scanned_module <- scanned_modules ] + (dcl_modules, local_defs, cdefs, sizes, cs) + = combineDclAndIclModule mod_type { dcl_module \\ dcl_module <- init_dcl_modules } local_defs cdefs sizes cs + + icl_common = createCommonDefinitions cdefs - heaps = { hp_var_heap = hp_var_heap, hp_expression_heap = newHeap, hp_type_heaps = { th_vars = newHeap, th_attrs = newHeap }} + heaps = { hp_var_heap = newHeap, hp_expression_heap = newHeap, hp_type_heaps = { th_vars = newHeap, th_attrs = newHeap }} (dcl_modules, icl_functions, heaps, cs) = check_predefined_module pre_def_mod.mod_name dcl_modules icl_functions heaps cs @@ -2348,12 +2360,8 @@ checkModule {mod_type,mod_name,mod_imports,mod_imported_objects,mod_defs = cdefs (nr_of_modules, (f_consequences, ii_modules, icl_functions, hp_expression_heap, cs)) = check_completeness_of_all_dcl_modules ii_modules icl_functions heaps.hp_expression_heap cs - all_defs_only_in_main_dcl = defs_only_in_main_dcl.[cTypeDefs]++defs_only_in_main_dcl.[cConstructorDefs] - ++defs_only_in_main_dcl.[cSelectorDefs]++defs_only_in_main_dcl.[cClassDefs] - ++defs_only_in_main_dcl.[cMemberDefs]++defs_only_in_main_dcl.[cMacroDefs] - - (dcls_explicit, dcl_modules, cs) = addImportsToSymbolTable mod_imports [] ii_modules cs - cs = addGlobalDefinitionsToSymbolTable (local_defs++all_defs_only_in_main_dcl) cs + (dcls_explicit, dcl_modules, cs) = addImportsToSymbolTable mod_imports [] ii_modules cs + cs = addGlobalDefinitionsToSymbolTable local_defs cs (_, dcl_modules, icl_functions, hp_expression_heap, cs) = check_completeness_of_module nr_of_modules dcls_explicit (mod_name.id_name+++".icl") @@ -2361,16 +2369,10 @@ checkModule {mod_type,mod_name,mod_imports,mod_imported_objects,mod_defs = cdefs heaps = { heaps & hp_expression_heap=hp_expression_heap } - (icl_common, hp_var_heap) = createCommonDefinitions cdefs heaps.hp_var_heap - (main_dcl_module, dcl_modules) = dcl_modules![cIclModIndex] - (upper_limits, icl_common) = get_upper_limits icl_common - - icl_common = add_defs_only_in_main_dcl defs_only_in_main_dcl main_dcl_module icl_common - (icl_common, dcl_modules, hp_type_heaps, hp_var_heap, cs) - = checkCommonDefinitions cIsNotADclModule cIclModIndex upper_limits icl_common dcl_modules heaps.hp_type_heaps hp_var_heap cs + = checkCommonDefinitions cIsNotADclModule cIclModIndex 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 cIclModIndex icl_common dcl_modules hp_var_heap hp_type_heaps cs @@ -2406,11 +2408,8 @@ checkModule {mod_type,mod_name,mod_imports,mod_imported_objects,mod_defs = cdefs 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_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, -// MW was icl_declared = {dcls_local = local_defs, dcls_import = icl_imported} } -// RWS ... - icl_imported_objects = mod_imported_objects, -// ... RWS - icl_declared = {dcls_local = local_defs, dcls_import = icl_imported, dcls_explicit=dcls_explicit} } + icl_imported_objects = mod_imported_objects, + icl_declared = {dcls_local = local_defs, dcls_import = icl_imported, dcls_explicit = dcls_explicit} } = (cs_error.ea_ok, icl_mod, dcl_modules, groups, dcl_icl_conversions, { heaps & hp_var_heap = var_heap, hp_expression_heap = expr_heap, hp_type_heaps = { hp_type_heaps & th_vars = th_vars }}, cs_predef_symbols, cs_symbol_table, cs_error.ea_file) @@ -2419,11 +2418,8 @@ checkModule {mod_type,mod_name,mod_imports,mod_imported_objects,mod_defs = cdefs icl_mod = { icl_name = mod_name, icl_functions = icl_functions, icl_common = icl_common, icl_instances = {ir_from = first_inst_index, ir_to = nr_of_functions}, icl_specials = {ir_from = nr_of_functions, ir_to = nr_of_functions}, -// MW was icl_declared = {dcls_local = local_defs, dcls_import = icl_imported} } -// RWS ... icl_imported_objects = mod_imported_objects, -// ... RWS - icl_declared = {dcls_local = local_defs, dcls_import = icl_imported, dcls_explicit=dcls_explicit} } + icl_declared = {dcls_local = local_defs, dcls_import = icl_imported, dcls_explicit = dcls_explicit} } = (False, icl_mod, dcl_modules, {}, No, heaps, cs_predef_symbols, cs_symbol_table, cs_error.ea_file) where convert_class_instances [pi=:{pi_members} : pins] next_fun_index @@ -2462,13 +2458,13 @@ checkModule {mod_type,mod_name,mod_imports,mod_imported_objects,mod_defs = cdefs add_modules_to_symbol_table [mod=:{mod_defs} : mods] mod_index macro_and_fun_defs 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 } - defs = collectFunctionTypes mod_defs.def_funtypes (collectCommonfinitions mod_defs []) - (defs, macro_and_fun_defs) = collectMacros mod_defs.def_macros defs macro_and_fun_defs + 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 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 (mods, macro_and_fun_defs, cs) = add_modules_to_symbol_table mods (inc mod_index) macro_and_fun_defs { cs & cs_symbol_table = cs_symbol_table, cs_error = cs_error } - = ([(mod, defs) : mods], macro_and_fun_defs, cs) + = ([(mod, sizes, defs) : mods], macro_and_fun_defs, cs) where convert_class_instances :: ![ParsedInstance a] -> [ClassInstance] convert_class_instances [pi : pins] @@ -2603,57 +2599,6 @@ checkModule {mod_type,mod_name,mod_imports,mod_imported_objects,mod_defs = cdefs (Yes symbol_type) = inst_def.fun_type = { instance_defs & [ds_index] = { inst_def & fun_type = Yes (makeElemTypeOfArrayFunctionStrict symbol_type ins_offset offset_table) } } -// MW.. -get_upper_limits icl_common=:{com_type_defs, com_cons_defs, com_selector_defs, com_class_defs - ,com_member_defs, com_instance_defs} - # (size_type_defs, com_type_defs) = usize com_type_defs - (size_cons_defs, com_cons_defs) = usize com_cons_defs - (size_selector_defs, com_selector_defs) = usize com_selector_defs - (size_class_defs, com_class_defs) = usize com_class_defs - (size_member_defs, com_member_defs) = usize com_member_defs - (size_instance_defs, com_instance_defs) = usize com_instance_defs - upper_limits = { createArray cConversionTableSize 0 - & [cTypeDefs]=size_type_defs - , [cConstructorDefs]=size_cons_defs - , [cSelectorDefs]=size_selector_defs - , [cClassDefs]=size_class_defs - , [cMemberDefs]=size_member_defs - , [cInstanceDefs]=size_instance_defs - } - = (upper_limits, { 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 - }) -// ..MW - -// MW.. -add_defs_only_in_main_dcl defs_only_in_main_dcl {dcl_common} icl_common - = { icl_common - & com_type_defs = append_array_and_list icl_common.com_type_defs - [ dcl_common.com_type_defs.[dcl_index] - \\ {dcl_index} <- defs_only_in_main_dcl.[cTypeDefs]] - , com_cons_defs = append_array_and_list icl_common.com_cons_defs - [ dcl_common.com_cons_defs.[dcl_index] - \\ {dcl_index} <- defs_only_in_main_dcl.[cConstructorDefs]] - , com_selector_defs = append_array_and_list icl_common.com_selector_defs - [ dcl_common.com_selector_defs.[dcl_index] - \\ {dcl_index} <- defs_only_in_main_dcl.[cSelectorDefs]] - , com_class_defs = append_array_and_list icl_common.com_class_defs - [ dcl_common.com_class_defs.[dcl_index] - \\ {dcl_index} <- defs_only_in_main_dcl.[cClassDefs]] - , com_member_defs = append_array_and_list icl_common.com_member_defs - [ dcl_common.com_member_defs.[dcl_index] - \\ {dcl_index} <- defs_only_in_main_dcl.[cMemberDefs]] - } - where - append_array_and_list a [] - = a - append_array_and_list a l - = { el \\ el <- [el \\ el<-:a]++l} -// ..MW arrayFunOffsetToPD_IndexTable member_defs predef_symbols # nr_of_array_functions = size member_defs @@ -2706,7 +2651,7 @@ checkImports [ {import_module = {id_info}}: mods ] iinfo heaps cs=:{cs_symbol_ta = (min min_mod_num1 min_mod_num2, iinfo, heaps, cs) -checkImport :: SymbolPtr SymbolTableEntry *ImportInfo *Heaps *CheckState -> *(Int,*ImportInfo,*Heaps,*CheckState); // MW++ +checkImport :: SymbolPtr SymbolTableEntry *ImportInfo *Heaps *CheckState -> *(Int,*ImportInfo,*Heaps,*CheckState) checkImport module_id_info entry=:{ste_kind = STE_OpenModule mod_num _} iinfo heaps cs = (mod_num, iinfo, heaps, cs) checkImport module_id_info entry=:{ste_kind = STE_ClosedModule} iinfo=:{ii_modules} heaps cs @@ -2733,52 +2678,48 @@ checkImport module_id_info entry=:{ste_kind = STE_Module mod, ste_index} iinfo=: cs = { cs & cs_symbol_table = cs.cs_symbol_table <:= (mod_info, { entry & ste_kind = STE_ClosedModule })} | lowest_mod_info == mod_info = (ds, modules, macro_and_fun_defs, heaps, cs) -// MW was = check_component mod_info ds modules macro_and_fun_defs heaps cs = check_component lowest_mod_info ds modules macro_and_fun_defs heaps cs -initialDclModule ({mod_name, mod_defs=mod_defs=:{def_funtypes,def_macros}, mod_type},all_defs) var_heap - # (dcl_common, var_heap) = createCommonDefinitions mod_defs var_heap - = ({ 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_class_specials = { ir_from = 0, ir_to = 0 } - , dcl_specials = { ir_from = 0, ir_to = 0 } - , dcl_common = dcl_common - , dcl_declared = - { dcls_import = [] - , dcls_local = all_defs - , dcls_explicit = [] // MW++ +initialDclModule ({mod_name, mod_defs=mod_defs=:{def_funtypes,def_macros}, mod_type}, sizes, all_defs) + # 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_class_specials = { ir_from = 0, ir_to = 0 } + , dcl_specials = { ir_from = 0, ir_to = 0 } + , dcl_common = dcl_common + , dcl_sizes = sizes + , dcl_declared = + { dcls_import = [] + , dcls_local = all_defs + , dcls_explicit = [] + } + , dcl_conversions = No + , dcl_is_system = case mod_type of + MK_System -> True + _ -> False } - , dcl_conversions = No - , dcl_is_system = case mod_type of - MK_System -> True - _ -> False - }, var_heap) -// MW moved retrieveAndRemoveImportsFromSymbolTable - checkDclModule {mod_name,mod_imports,mod_defs} mod_index modules icl_functions heaps=:{hp_var_heap, hp_type_heaps} cs #! dcl_mod = modules.[mod_index] # dcl_defined = dcl_mod.dcl_declared.dcls_local // createCommonDefinitions only converts lists into arrays - (dcl_common, hp_var_heap) = createCommonDefinitions mod_defs hp_var_heap - dcl_macros = mod_defs.def_macros - (imports, modules, cs) = collect_imported_symbols mod_imports [] modules cs + dcl_common = createCommonDefinitions mod_defs + dcl_macros = mod_defs.def_macros + (imports, modules, cs) = collect_imported_symbols mod_imports [] modules cs // imports :: [(Index,Declarations)] # cs = add_imported_symbols_to_symbol_table imports cs -// cs = addImportedSymbolsToSymbolTable imports cs cs = addGlobalDefinitionsToSymbolTable dcl_defined cs nr_of_dcl_functions = size dcl_mod.dcl_functions - (upper_limits, dcl_common) = get_upper_limits dcl_common // MW++ + (dcl_common, modules, hp_type_heaps, hp_var_heap, cs) -// MW was = checkCommonDefinitions cIsADclModule mod_index dcl_common modules hp_type_heaps hp_var_heap cs - = checkCommonDefinitions cIsADclModule mod_index upper_limits dcl_common modules hp_type_heaps hp_var_heap cs + = checkCommonDefinitions cIsADclModule mod_index dcl_common modules hp_type_heaps hp_var_heap cs (memb_inst_defs, nr_of_dcl_functions_and_instances, rev_spec_class_inst, dcl_common, modules, hp_type_heaps, hp_var_heap, cs) = determineTypesOfInstances nr_of_dcl_functions mod_index dcl_common modules hp_type_heaps hp_var_heap cs (nr_of_dcl_funs_insts_and_specs, rev_function_list, rev_special_defs, com_type_defs, com_class_defs, modules, heaps, cs) @@ -2816,14 +2757,8 @@ checkDclModule {mod_name,mod_imports,mod_defs} mod_index modules icl_functions h (dcl_imported, cs_symbol_table) = retrieveAndRemoveImportsFromSymbolTable imports [] cs.cs_symbol_table cs_symbol_table = removeDeclarationsFromSymbolTable dcl_defined cModuleScope cs_symbol_table - dcls_explicit = flatten [dcls_explicit \\ (_,{dcls_explicit})<-imports] //MW++ + dcls_explicit = flatten [dcls_explicit \\ (_,{dcls_explicit})<-imports] -/* MW was - dcl_mod = { dcl_mod & dcl_declared = { dcl_mod.dcl_declared & dcls_import = dcl_imported }, 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 = nr_of_dcl_functions_and_instances, ir_to = nr_of_dcl_funs_insts_and_specs }, - dcl_class_specials = { ir_from = first_special_class_index, ir_to = last_special_class_index }} -*/ dcl_mod = { dcl_mod & dcl_declared = { dcl_mod.dcl_declared & dcls_import = dcl_imported, dcls_explicit = dcls_explicit }, dcl_common = dcl_common, dcl_functions = dcl_functions, dcl_instances = { ir_from = nr_of_dcl_functions, ir_to = nr_of_dcl_functions_and_instances }, @@ -2831,12 +2766,6 @@ checkDclModule {mod_name,mod_imports,mod_defs} mod_index modules icl_functions h dcl_class_specials = { ir_from = first_special_class_index, ir_to = last_special_class_index }} = ({ e_info.ef_modules & [ mod_index ] = dcl_mod }, icl_functions, heaps, { cs & cs_symbol_table = cs_symbol_table }) where -/* MW was - collect_imported_symbols [{import_module={id_info}} : mods ] all_decls modules cs=:{cs_symbol_table} - #! entry = sreadPtr id_info cs_symbol_table - # (all_decls, modules, cs) = collect_declarations_of_module id_info entry all_decls modules cs - = collect_imported_symbols mods all_decls modules cs -*/ collect_imported_symbols [{import_module={id_info},import_symbols,import_file_position} : mods ] all_decls modules cs=:{cs_symbol_table} #! entry = sreadPtr id_info cs_symbol_table # (decls_of_imported_module, modules, cs) = collect_declarations_of_module id_info entry [] modules cs @@ -2852,7 +2781,6 @@ where (imported_decls, modules, cs) = collect_imported_symbols mod_imports [] modules cs #! dcl_mod = modules.[ste_index] # (declared, cs) = determine_declared_symbols ste_index dcl_mod.dcl_declared.dcls_local imported_decls cs -// MW was = ([(ste_index, declared) : all_decls], modules, { cs & cs_symbol_table = cs.cs_symbol_table <:= (module_id_info, { entry & ste_kind = old_kind })}) = ( [(ste_index, declared) : all_decls] , modules , { cs & cs_symbol_table = cs.cs_symbol_table <:= (module_id_info, { entry & ste_kind = old_kind })} @@ -2948,13 +2876,9 @@ where (Yes symbol_type) = inst_def.ft_type = { instance_defs & [ds_index] = { inst_def & ft_type = makeElemTypeOfArrayFunctionStrict inst_def.ft_type ins_offset offset_table } } -// MW moved functions - 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 }) -// MW moved function - addImportsToSymbolTable :: ![ParsedImport] ![(!Declaration, !LineNr)] !*{# DclModule} !*CheckState -> (![(!Declaration, !LineNr)], !*{# DclModule}, !*CheckState) addImportsToSymbolTable [{import_module={id_info},import_symbols, import_file_position} : mods ] @@ -2971,8 +2895,6 @@ addImportsToSymbolTable [{import_module={id_info},import_symbols, import_file_po addImportsToSymbolTable [] explicit_akku modules cs = (explicit_akku, modules, cs) -// MW moved functions - file_and_status {ea_file,ea_ok} = (ea_file, ea_ok) diff --git a/frontend/checksupport.dcl b/frontend/checksupport.dcl index 32db0be..e8cff49 100644 --- a/frontend/checksupport.dcl +++ b/frontend/checksupport.dcl @@ -3,7 +3,7 @@ definition module checksupport import StdEnv import syntax, predef -cIclModIndex :== 0 // MW++ +cIclModIndex :== 0 CS_NotChecked :== -1 NotFound :== -1 @@ -11,8 +11,8 @@ NotFound :== -1 cModuleScope :== 0 cGlobalScope :== 1 -cIsNotADclModule :== False // MW++ -cIsADclModule :== True // MW++ +cIsNotADclModule :== False +cIsADclModule :== True :: VarHeap :== Heap VarInfo @@ -55,6 +55,7 @@ cConversionTableSize :== 8 :: Declaration = { dcl_ident :: !Ident + , dcl_pos :: !Position , dcl_kind :: !STE_Kind , dcl_index :: !Index } @@ -62,7 +63,7 @@ cConversionTableSize :== 8 :: Declarations = { dcls_import ::![Declaration] , dcls_local ::![Declaration] - , dcls_explicit ::![(!Declaration, !LineNr)] // MW++ + , dcls_explicit ::![(!Declaration, !LineNr)] } :: IclModule = @@ -72,9 +73,7 @@ cConversionTableSize :== 8 , icl_specials :: !IndexRange , icl_common :: !.CommonDefs , icl_declared :: !Declarations -// RWS ... , icl_imported_objects :: ![ImportedObject] -// ... RWS } :: DclModule = @@ -85,6 +84,7 @@ cConversionTableSize :== 8 , dcl_class_specials :: !IndexRange , dcl_specials :: !IndexRange , dcl_common :: !CommonDefs + , dcl_sizes :: !{# Int} , dcl_declared :: !Declarations , dcl_conversions :: !Optional ConversionTable , dcl_is_system :: !Bool diff --git a/frontend/checksupport.icl b/frontend/checksupport.icl index 1bd4655..437ac46 100644 --- a/frontend/checksupport.icl +++ b/frontend/checksupport.icl @@ -64,6 +64,7 @@ where :: Declaration = { dcl_ident :: !Ident + , dcl_pos :: !Position , dcl_kind :: !STE_Kind , dcl_index :: !Index } @@ -94,6 +95,7 @@ where , dcl_class_specials :: !IndexRange , dcl_specials :: !IndexRange , dcl_common :: !CommonDefs + , dcl_sizes :: !{# Int} , dcl_declared :: !Declarations , dcl_conversions :: !Optional ConversionTable , dcl_is_system :: !Bool diff --git a/frontend/checktypes.dcl b/frontend/checktypes.dcl index efb8526..3695103 100644 --- a/frontend/checktypes.dcl +++ b/frontend/checktypes.dcl @@ -2,8 +2,8 @@ definition module checktypes import checksupport, typesupport -checkTypeDefs :: !Bool !*{# CheckedTypeDef} !Index !Int !*{# ConsDef} !*{# SelectorDef} !*{# DclModule} !*TypeHeaps !*CheckState - -> (!*{# CheckedTypeDef}, !*{# ConsDef}, !*{# SelectorDef}, !*{# DclModule}, !*TypeHeaps, !*CheckState) +checkTypeDefs :: !Bool !*{# CheckedTypeDef} !Index !*{# ConsDef} !*{# SelectorDef} !*{# DclModule} !*VarHeap !*TypeHeaps !*CheckState + -> (!*{# CheckedTypeDef}, !*{# ConsDef}, !*{# SelectorDef}, !*{# DclModule}, !*VarHeap, !*TypeHeaps, !*CheckState) checkSymbolType :: !Index !SymbolType !Specials !u:{# CheckedTypeDef} !v:{# ClassDef} !u:{# DclModule} !*TypeHeaps !*CheckState -> (!SymbolType, !Specials, !u:{# CheckedTypeDef}, !v:{# ClassDef}, !u:{# DclModule}, !*TypeHeaps, !*CheckState) @@ -17,7 +17,7 @@ checkInstanceType :: !Index !InstanceType !Specials !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 !Int !*TypeVarHeap !*VarHeap !*CheckState +createClassDictionaries :: !Index !*{#ClassDef} !u:{#.DclModule} !Index !Index !Index !*TypeVarHeap !*VarHeap !*CheckState -> (!*{#ClassDef}, !u:{#DclModule}, ![CheckedTypeDef], ![SelectorDef], ![ConsDef], !*TypeVarHeap, !*VarHeap, !*CheckState) isATopConsVar cv :== cv < 0 diff --git a/frontend/checktypes.icl b/frontend/checktypes.icl index b649de0..23604b2 100644 --- a/frontend/checktypes.icl +++ b/frontend/checktypes.icl @@ -12,7 +12,8 @@ import syntax, checksupport, check, typesupport, utilities, RWSDebug } :: TypeInfo = - { ti_heaps :: !.TypeHeaps + { ti_var_heap :: !.VarHeap + , ti_type_heaps :: !.TypeHeaps } :: CurrentTypeInfo = @@ -138,19 +139,20 @@ bindTypesOfCons :: !Index !Index ![TypeVar] ![AttributeVar] !AType ![DefinedSymb bindTypesOfConstructors _ _ _ _ _ [] ts_ti_cs = ts_ti_cs -bindTypesOfConstructors cti=:{cti_lhs_attribute} cons_index free_vars free_attrs type_lhs [{ds_index}:conses] (ts=:{ts_cons_defs}, ti=:{ti_heaps}, cs) +bindTypesOfConstructors cti=:{cti_lhs_attribute} cons_index free_vars free_attrs type_lhs [{ds_index}:conses] (ts=:{ts_cons_defs}, ti=:{ti_type_heaps}, cs) #! cons_def = ts_cons_defs.[ds_index] - # (exi_vars, (ti_heaps, cs)) - = addExistentionalTypeVariablesToSymbolTable cti_lhs_attribute cons_def.cons_exi_vars ti_heaps cs + # (exi_vars, (ti_type_heaps, cs)) + = addExistentionalTypeVariablesToSymbolTable cti_lhs_attribute cons_def.cons_exi_vars ti_type_heaps cs (st_args, cons_arg_vars, st_attr_env, (ts, ti, cs)) - = bind_types_of_cons cons_def.cons_type.st_args cti free_vars [] (ts, { ti & ti_heaps = ti_heaps }, cs) + = bind_types_of_cons cons_def.cons_type.st_args cti free_vars [] (ts, { ti & ti_type_heaps = ti_type_heaps }, cs) cs_symbol_table = removeAttributedTypeVarsFromSymbolTable cOuterMostLevel exi_vars cs.cs_symbol_table (ts, ti, cs) = bindTypesOfConstructors cti (inc cons_index) free_vars free_attrs type_lhs conses (ts, ti, { cs & cs_symbol_table = cs_symbol_table }) cons_type = { cons_def.cons_type & st_vars = free_vars, st_args = st_args, st_result = type_lhs, st_attr_vars = free_attrs, st_attr_env = st_attr_env } + (new_type_ptr, ti_var_heap) = newPtr VI_Empty ti.ti_var_heap = ({ ts & ts_cons_defs = { ts.ts_cons_defs & [ds_index] = { cons_def & cons_type = cons_type, cons_index = cons_index, cons_type_index = cti.cti_type_index, cons_exi_vars = exi_vars, - cons_arg_vars = cons_arg_vars }}}, ti, cs) + cons_type_ptr = new_type_ptr, cons_arg_vars = cons_arg_vars }}}, { ti & ti_var_heap = ti_var_heap }, cs) where /* check_types_of_cons :: ![AType] !Bool !Index !Level ![TypeVar] !TypeAttribute ![AttrInequality] !Conditions !*TypeSymbols !*TypeInfo !*CheckState @@ -175,10 +177,6 @@ where symbol_table <:= (id_info, { ste & ste_kind = STE_BoundTypeVariable { bv & stv_count = 0}})) -/* -checkRhsOfTypeDef :: !CheckedTypeDef ![AttributeVar] !Bool !Index !Level !TypeAttribute !Index !Conditions !*TypeSymbols !*TypeInfo !*CheckState - -> (!TypeRhs, !TypeProperties, !Conditions, !Int, !*TypeSymbols, !*TypeInfo, !*CheckState) -*/ checkRhsOfTypeDef {td_name,td_arity,td_args,td_rhs = td_rhs=:AlgType conses} attr_vars cti=:{cti_module_index,cti_type_index,cti_lhs_attribute} ts_ti_cs # type_lhs = { at_annotation = AN_None, at_attribute = cti_lhs_attribute, at_type = TA (MakeTypeSymbIdent { glob_object = cti_type_index, glob_module = cti_module_index } td_name td_arity) @@ -195,23 +193,25 @@ checkRhsOfTypeDef {td_name,td_arity,td_args,td_rhs = td_rhs=:RecordType {rt_cons attr_vars type_lhs [rec_cons] ts_ti_cs #! rec_cons_def = ts.ts_cons_defs.[ds_index] # {cons_type = { st_vars,st_args,st_result,st_attr_vars }, cons_exi_vars} = rec_cons_def - (ts_selector_defs, cs_error) = check_selectors 0 rt_fields cti_type_index st_args st_result st_vars st_attr_vars cons_exi_vars ts.ts_selector_defs cs.cs_error - = (td_rhs, ({ ts & ts_selector_defs = ts_selector_defs }, ti, { cs & cs_error = cs_error})) + (ts_selector_defs, ti_var_heap, cs_error) = check_selectors 0 rt_fields cti_type_index st_args st_result st_vars st_attr_vars cons_exi_vars + ts.ts_selector_defs ti.ti_var_heap cs.cs_error + = (td_rhs, ({ ts & ts_selector_defs = ts_selector_defs }, { ti & ti_var_heap = ti_var_heap }, { cs & cs_error = cs_error})) where - check_selectors :: !Index !{# FieldSymbol} !Index ![AType] !AType ![TypeVar] ![AttributeVar] ![ATypeVar] !*{#SelectorDef} !*ErrorAdmin - -> (!*{#SelectorDef},!*ErrorAdmin) - check_selectors field_nr fields rec_type_index sel_types rec_type st_vars st_attr_vars exi_vars selector_defs error + check_selectors :: !Index !{# FieldSymbol} !Index ![AType] !AType ![TypeVar] ![AttributeVar] ![ATypeVar] !*{#SelectorDef} !*VarHeap !*ErrorAdmin + -> (!*{#SelectorDef}, !*VarHeap, !*ErrorAdmin) + check_selectors field_nr fields rec_type_index sel_types rec_type st_vars st_attr_vars exi_vars selector_defs var_heap error | field_nr < size fields # {fs_index} = fields.[field_nr] #! sel_def = selector_defs.[fs_index] # [sel_type:sel_types] = sel_types # (st_attr_env, error) = addToAttributeEnviron sel_type.at_attribute rec_type.at_attribute [] error + # (new_type_ptr, var_heap) = newPtr VI_Empty var_heap sd_type = { sel_def.sd_type & st_arity = 1, st_args = [rec_type], st_result = sel_type, st_vars = st_vars, st_attr_vars = st_attr_vars, st_attr_env = st_attr_env } selector_defs = { selector_defs & [fs_index] = { sel_def & sd_type = sd_type, sd_field_nr = field_nr, sd_type_index = rec_type_index, - sd_exi_vars = exi_vars } } - = check_selectors (inc field_nr) fields rec_type_index sel_types rec_type st_vars st_attr_vars exi_vars selector_defs error - = (selector_defs, error) + sd_type_ptr = new_type_ptr, sd_exi_vars = exi_vars } } + = check_selectors (inc field_nr) fields rec_type_index sel_types rec_type st_vars st_attr_vars exi_vars selector_defs var_heap error + = (selector_defs, var_heap, error) checkRhsOfTypeDef {td_rhs = SynType type} _ cti ts_ti_cs # (type, type_attr, ts_ti_cs) = bindTypes cti type ts_ti_cs = (SynType type, ts_ti_cs) @@ -224,18 +224,17 @@ isATopConsVar cv :== cv < 0 encodeTopConsVar cv :== dec (~cv) decodeTopConsVar cv :== ~(inc cv) -// checkTypeDef :: !Bool !Index !Index !*TypeSymbols !*TypeInfo !*CheckState -> (!Int, !Conditions, !*TypeSymbols, !*TypeInfo, !*CheckState); -checkTypeDef type_index module_index ts=:{ts_type_defs} ti=:{ti_heaps} cs=:{cs_error} +checkTypeDef type_index module_index ts=:{ts_type_defs} ti=:{ti_type_heaps} cs=:{cs_error} #! type_def = ts_type_defs.[type_index] # {td_name,td_pos,td_args,td_attribute,td_properties} = type_def position = newPosition td_name td_pos cs_error = pushErrorAdmin position cs_error - (td_attribute, attr_vars, th_attrs) = determine_root_attribute td_attribute td_name.id_name ti_heaps.th_attrs - (type_vars, (attr_vars, ti_heaps, cs)) - = addTypeVariablesToSymbolTable td_args attr_vars { ti_heaps & th_attrs = th_attrs } { cs & cs_error = cs_error } + (td_attribute, attr_vars, th_attrs) = determine_root_attribute td_attribute td_name.id_name ti_type_heaps.th_attrs + (type_vars, (attr_vars, ti_type_heaps, cs)) + = addTypeVariablesToSymbolTable td_args attr_vars { ti_type_heaps & th_attrs = th_attrs } { cs & cs_error = cs_error } type_def = { type_def & td_args = type_vars, td_index = type_index, td_attrs = attr_vars, td_attribute = td_attribute } (td_rhs, (ts, ti, cs)) = checkRhsOfTypeDef type_def attr_vars - { cti_module_index = module_index, cti_type_index = type_index, cti_lhs_attribute = td_attribute } (ts,{ ti & ti_heaps = ti_heaps}, cs) + { cti_module_index = module_index, cti_type_index = type_index, cti_lhs_attribute = td_attribute } (ts,{ ti & ti_type_heaps = ti_type_heaps}, cs) = ({ ts & ts_type_defs = { ts.ts_type_defs & [type_index] = { type_def & td_rhs = td_rhs }}}, ti, { cs & cs_error = popErrorAdmin cs.cs_error, cs_symbol_table = removeAttributedTypeVarsFromSymbolTable cOuterMostLevel type_vars cs.cs_symbol_table }) @@ -406,21 +405,23 @@ where kind_list_to_string [] = "" kind_list_to_string [k:ks] = " -> " +++ toString k +++ kind_list_to_string ks */ -checkTypeDefs :: !Bool !*{# CheckedTypeDef} !Index !Int !*{# ConsDef} !*{# SelectorDef} !*{# DclModule} !*TypeHeaps !*CheckState - -> (!*{# CheckedTypeDef}, !*{# ConsDef}, !*{# SelectorDef}, !*{# DclModule}, !*TypeHeaps, !*CheckState) -checkTypeDefs is_main_dcl type_defs module_index nr_of_types cons_defs selector_defs modules heaps cs + +checkTypeDefs :: !Bool !*{# CheckedTypeDef} !Index !*{# ConsDef} !*{# SelectorDef} !*{# DclModule} !*VarHeap !*TypeHeaps !*CheckState + -> (!*{# CheckedTypeDef}, !*{# ConsDef}, !*{# SelectorDef}, !*{# DclModule}, !*VarHeap, !*TypeHeaps, !*CheckState) +checkTypeDefs is_main_dcl type_defs module_index cons_defs selector_defs modules var_heap type_heaps cs + #! nr_of_types = size type_defs # ts = { ts_type_defs = type_defs, ts_cons_defs = cons_defs, ts_selector_defs = selector_defs, ts_modules = modules } - ti = { ti_heaps = heaps } + ti = { ti_type_heaps = type_heaps, ti_var_heap = var_heap } = check_type_defs is_main_dcl 0 nr_of_types module_index ts ti cs where - check_type_defs is_main_dcl type_index nr_of_types module_index ts ti=:{ti_heaps} cs + check_type_defs is_main_dcl type_index nr_of_types module_index ts ti=:{ti_type_heaps,ti_var_heap} cs | type_index == nr_of_types | cs.cs_error.ea_ok && not is_main_dcl # marks = createArray nr_of_types CS_NotChecked (type_defs, modules, cs) = expand_syn_types module_index 0 nr_of_types { sti_type_defs = ts.ts_type_defs, sti_modules = ts.ts_modules, sti_marks = marks } cs - = (type_defs, ts.ts_cons_defs, ts.ts_selector_defs, modules, ti_heaps, cs) - = (ts.ts_type_defs, ts.ts_cons_defs, ts.ts_selector_defs, ts.ts_modules, ti_heaps, cs) + = (type_defs, ts.ts_cons_defs, ts.ts_selector_defs, modules, ti_var_heap, ti_type_heaps, cs) + = (ts.ts_type_defs, ts.ts_cons_defs, ts.ts_selector_defs, ts.ts_modules, ti_var_heap, ti_type_heaps, cs) # (ts, ti, cs) = checkTypeDef type_index module_index ts ti cs = check_type_defs is_main_dcl (inc type_index) nr_of_types module_index ts ti cs @@ -1047,9 +1048,9 @@ 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 !Int !*TypeVarHeap !*VarHeap !*CheckState +createClassDictionaries :: !Index !*{#ClassDef} !u:{#.DclModule} !Index !Index !Index !*TypeVarHeap !*VarHeap !*CheckState -> (!*{#ClassDef}, !u:{#DclModule}, ![CheckedTypeDef], ![SelectorDef], ![ConsDef], !*TypeVarHeap, !*VarHeap, !*CheckState) -createClassDictionaries mod_index class_defs modules first_type_index first_selector_index first_cons_index upper_limit type_var_heap var_heap cs +createClassDictionaries mod_index class_defs modules first_type_index first_selector_index first_cons_index type_var_heap var_heap cs # (class_defs, modules, rev_dictionary_list, indexes, type_var_heap, var_heap, cs) = 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 cs (type_defs, sel_defs, cons_defs, cs_symbol_table) = foldSt collect_type_def rev_dictionary_list ([], [], [], cs.cs_symbol_table) @@ -1070,8 +1071,7 @@ where = ( sel_defs, symbol_table) create_class_dictionaries mod_index class_index class_defs modules rev_dictionary_list indexes type_var_heap var_heap cs -// MW was | class_index < size class_defs - | class_index < upper_limit + | 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 = create_class_dictionaries mod_index (inc class_index) class_defs modules rev_dictionary_list indexes type_var_heap var_heap cs diff --git a/frontend/postparse.icl b/frontend/postparse.icl index 31d295f..7a64f49 100644 --- a/frontend/postparse.icl +++ b/frontend/postparse.icl @@ -617,7 +617,9 @@ reorganizeDefinitions icl_module [PD_Type type_def=:{td_rhs = ConsList cons_defs # (cons_symbs, cons_count) = determine_symbols_of_conses cons_defs cons_count (fun_defs, c_defs, imports, imported_objects, ca) = reorganizeDefinitions icl_module defs cons_count sel_count mem_count ca type_def = { type_def & td_rhs = AlgType cons_symbs } - c_defs = { c_defs & def_types = [type_def : c_defs.def_types], def_constructors = cons_defs ++ c_defs.def_constructors } +/* Sjaak ... */ + c_defs = { c_defs & def_types = [type_def : c_defs.def_types], def_constructors = mapAppend ParsedConstructorToConsDef cons_defs c_defs.def_constructors } +/* ... Sjaak */ = (fun_defs, c_defs, imports, imported_objects, ca) where determine_symbols_of_conses [{pc_cons_name,pc_cons_arity} : conses] next_cons_index @@ -634,8 +636,10 @@ reorganizeDefinitions icl_module [PD_Type type_def=:{td_name, td_rhs = SelectorL pc_arg_types = [ ps_field_type \\ {ps_field_type} <- sel_defs ], pc_exi_vars = exivars } type_def = { type_def & td_rhs = RecordType {rt_constructor = { ds_ident = td_name, ds_arity = cons_arity, ds_index = cons_count }, rt_fields = { sel \\ sel <- sel_syms }}} - c_defs = { c_defs & def_types = [type_def : c_defs.def_types], def_constructors = [cons_def : c_defs.def_constructors], - def_selectors = sel_defs ++ c_defs.def_selectors } +/* Sjaak ... */ + c_defs = { c_defs & def_types = [type_def : c_defs.def_types], def_constructors = [ParsedConstructorToConsDef cons_def : c_defs.def_constructors], + def_selectors = mapAppend ParsedSelectorToSelectorDef sel_defs c_defs.def_selectors } +/* ... Sjaak */ = (fun_defs, c_defs, imports, imported_objects, ca) where determine_symbols_of_selectors [{ps_field_name,ps_field_var} : sels] next_selector_index @@ -671,7 +675,7 @@ where check_symbols_of_class_members [PD_TypeSpec pos name prio opt_type=:(Yes type=:{st_context,st_arity}) specials : defs] type_context ca # (bodies, fun_kind, defs, ca) = collectFunctionBodies name st_arity prio FK_Unknown defs ca | isEmpty bodies - # mem_def = { me_symb = name, me_type = { type & st_context = [type_context : st_context ]}, me_pos = pos, me_priority = prio, + # mem_def = { me_symb = name, me_type = { type & st_context = [type_context : st_context ]}, me_pos = pos, me_priority = prio, 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) diff --git a/frontend/predef.icl b/frontend/predef.icl index 403233e..a2c43b7 100644 --- a/frontend/predef.icl +++ b/frontend/predef.icl @@ -214,7 +214,8 @@ buildPredefinedModule pre_def_symbols (class_def, member_def, pre_def_symbols) = make_TC_class_def pre_def_symbols = ({ mod_name = pre_mod_id, mod_type = MK_System, mod_imports = [], mod_imported_objects = [], mod_defs = { - def_types = [string_def, list_def : type_defs], def_constructors = [cons_def, nil_def : cons_defs], def_selectors = [], def_classes = [class_def], + def_types = [string_def, list_def : type_defs], def_constructors + = [ParsedConstructorToConsDef cons_def, ParsedConstructorToConsDef nil_def : cons_defs], def_selectors = [], def_classes = [class_def], def_macros = { ir_from = 0, ir_to = 0 }, def_members = [member_def], def_funtypes = [], def_instances = [] }}, pre_def_symbols) where add_tuple_defs pre_mod_id tup_arity type_defs cons_defs pre_def_symbols @@ -226,7 +227,7 @@ where (tuple_type_def, pre_def_symbols) = make_type_def (GetTupleTypeIndex tup_arity) type_vars (AlgType [tuple_cons_symb]) pre_def_symbols tuple_cons_def = { pc_cons_name = tuple_id.pds_ident, pc_cons_arity = tup_arity, pc_cons_pos = PreDefPos pre_mod_id, pc_arg_types = [ MakeAttributedType (TV tv) \\ tv <- type_vars], pc_cons_prio = NoPrio, pc_exi_vars = []} - = add_tuple_defs pre_mod_id (dec tup_arity) [tuple_type_def : type_defs] [tuple_cons_def : cons_defs] pre_def_symbols + = add_tuple_defs pre_mod_id (dec tup_arity) [tuple_type_def : type_defs] [ParsedConstructorToConsDef tuple_cons_def : cons_defs] pre_def_symbols = (type_defs, cons_defs, pre_def_symbols) where make_type_vars nr_of_vars type_vars pre_def_symbols diff --git a/frontend/syntax.dcl b/frontend/syntax.dcl index 3ebde9b..d441a6d 100644 --- a/frontend/syntax.dcl +++ b/frontend/syntax.dcl @@ -84,8 +84,8 @@ instance toString Ident :: CollectedDefinitions instance_kind macro_defs = { def_types :: ![TypeDef TypeRhs] - , def_constructors :: ![ParsedConstructor] - , def_selectors :: ![ParsedSelector] + , def_constructors :: ![ConsDef] + , def_selectors :: ![SelectorDef] , def_macros :: !macro_defs , def_classes :: ![ClassDef] , def_members :: ![MemberDef] @@ -1185,17 +1185,18 @@ MakeTypeSymbIdent type_index name arity MakeSymbIdent name arity :== { symb_name = name, symb_kind = SK_Unknown, symb_arity = arity } MakeConstant name :== MakeSymbIdent name 0 -ParsedSelectorToSelectorDef ps var_ptr :== +ParsedSelectorToSelectorDef ps :== { sd_symb = ps.ps_selector_name, sd_field_nr = NoIndex, sd_pos = ps.ps_field_pos, sd_type_index = NoIndex, - sd_exi_vars = [], /* sd_exi_attrs = [], */ sd_type_ptr = var_ptr, sd_field = ps.ps_field_name, + sd_exi_vars = [], sd_type_ptr = nilPtr, sd_field = ps.ps_field_name, sd_type = { st_vars = [], st_args = [], st_result = ps.ps_field_type, st_arity = 0, st_context = [], st_attr_env = [], st_attr_vars = [] }} -ParsedConstructorToConsDef pc var_ptr :== +ParsedConstructorToConsDef pc :== { cons_symb = pc.pc_cons_name, cons_pos = pc.pc_cons_pos, cons_priority = pc.pc_cons_prio, cons_index = NoIndex, cons_type_index = NoIndex, cons_type = { st_vars = [], st_args = pc.pc_arg_types, st_result = MakeAttributedType TE, st_arity = pc.pc_cons_arity, st_context = [], st_attr_env = [], st_attr_vars = []}, - cons_exi_vars = pc.pc_exi_vars, /* cons_exi_attrs = [], */ cons_type_ptr = var_ptr, cons_arg_vars = [] } + cons_exi_vars = pc.pc_exi_vars, cons_type_ptr = nilPtr, cons_arg_vars = [] } + ParsedInstanceToClassInstance pi members :== { ins_class = {glob_object = MakeDefinedSymbol pi.pi_class NoIndex (length pi.pi_types), glob_module = NoIndex}, ins_ident = pi.pi_ident, diff --git a/frontend/syntax.icl b/frontend/syntax.icl index e4fb607..444c3b0 100644 --- a/frontend/syntax.icl +++ b/frontend/syntax.icl @@ -88,8 +88,8 @@ where toString {import_module} = toString import_module :: CollectedDefinitions instance_kind macro_defs = { def_types :: ![TypeDef TypeRhs] - , def_constructors :: ![ParsedConstructor] - , def_selectors :: ![ParsedSelector] + , def_constructors :: ![ConsDef] + , def_selectors :: ![SelectorDef] , def_macros :: !macro_defs , def_classes :: ![ClassDef] , def_members :: ![MemberDef] @@ -1772,17 +1772,17 @@ MakeTypeSymbIdent type_index name arity MakeSymbIdent name arity :== { symb_name = name, symb_kind = SK_Unknown, symb_arity = arity } MakeConstant name :== MakeSymbIdent name 0 -ParsedSelectorToSelectorDef ps var_ptr :== +ParsedSelectorToSelectorDef ps :== { sd_symb = ps.ps_selector_name, sd_field_nr = NoIndex, sd_pos = ps.ps_field_pos, sd_type_index = NoIndex, - sd_exi_vars = [], /* sd_exi_attrs = [], */ sd_type_ptr = var_ptr, sd_field = ps.ps_field_name, + sd_exi_vars = [], sd_type_ptr = nilPtr, sd_field = ps.ps_field_name, sd_type = { st_vars = [], st_args = [], st_result = ps.ps_field_type, st_arity = 0, st_context = [], st_attr_env = [], st_attr_vars = [] }} -ParsedConstructorToConsDef pc var_ptr :== +ParsedConstructorToConsDef pc :== { cons_symb = pc.pc_cons_name, cons_pos = pc.pc_cons_pos, cons_priority = pc.pc_cons_prio, cons_index = NoIndex, cons_type_index = NoIndex, cons_type = { st_vars = [], st_args = pc.pc_arg_types, st_result = MakeAttributedType TE, st_arity = pc.pc_cons_arity, st_context = [], st_attr_env = [], st_attr_vars = []}, - cons_exi_vars = pc.pc_exi_vars, /* cons_exi_attrs = [], */ cons_type_ptr = var_ptr, cons_arg_vars = [] } + cons_exi_vars = pc.pc_exi_vars, cons_type_ptr = nilPtr, cons_arg_vars = [] } ParsedInstanceToClassInstance pi members :== { ins_class = {glob_object = MakeDefinedSymbol pi.pi_class NoIndex (length pi.pi_types), glob_module = NoIndex}, ins_ident = pi.pi_ident, diff --git a/frontend/utilities.icl b/frontend/utilities.icl index c74b2e0..4c54d13 100644 --- a/frontend/utilities.icl +++ b/frontend/utilities.icl @@ -158,6 +158,7 @@ foldSt op r l :== fold_st r l fold_st [] st = st fold_st [a:x] st = fold_st x (op a st) +// iFoldSt :: (Int -> .(.b -> .b)) !Int !Int .b -> .b iFoldSt op fr to st :== i_fold_st fr to st where i_fold_st fr to st |