aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--frontend/check.icl504
-rw-r--r--frontend/checksupport.dcl12
-rw-r--r--frontend/checksupport.icl2
-rw-r--r--frontend/checktypes.dcl6
-rw-r--r--frontend/checktypes.icl70
-rw-r--r--frontend/postparse.icl12
-rw-r--r--frontend/predef.icl5
-rw-r--r--frontend/syntax.dcl13
-rw-r--r--frontend/syntax.icl12
-rw-r--r--frontend/utilities.icl1
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