aboutsummaryrefslogtreecommitdiff
path: root/frontend
diff options
context:
space:
mode:
Diffstat (limited to 'frontend')
-rw-r--r--frontend/check.icl71
1 files changed, 15 insertions, 56 deletions
diff --git a/frontend/check.icl b/frontend/check.icl
index 3f6b59c..cb9fbed 100644
--- a/frontend/check.icl
+++ b/frontend/check.icl
@@ -7,14 +7,9 @@ import explicitimports, comparedefimp, checkFunctionBodies, containers, compiler
import genericsupport
import typereify
from checkgenerics import checkGenericDefs,checkGenericCaseDefs,convert_generic_instances,create_gencase_funtypes
-// import RWSDebug
cUndef :== (-1)
cDummyArray :== {}
-
-isMainModule :: ModuleKind -> Bool
-isMainModule MK_Main = True
-isMainModule _ = False
checkTypeClasses :: !Index !(Optional (CopiedDefinitions, Int)) !*{#ClassDef} !*{#MemberDef} !*{#CheckedTypeDef} !*{#DclModule} !*Heaps !*CheckState
-> (!*{#ClassDef}, !*{#MemberDef}, !*{#CheckedTypeDef}, !*{#DclModule}, !*Heaps, !*CheckState)
@@ -169,7 +164,7 @@ where
}
checkInstanceDefs :: !Index !*{#ClassInstance} !u:{#CheckedTypeDef} !u:{#ClassDef} !u:{#MemberDef} !u:{#DclModule} !*Heaps !*CheckState
- -> (!.{#ClassInstance},!u:{#CheckedTypeDef},!u:{#ClassDef},!u:{#MemberDef}, !u:{#DclModule},!.Heaps,!.CheckState)
+ -> (!.{#ClassInstance},!u:{#CheckedTypeDef},!u:{#ClassDef},!u:{#MemberDef},!u:{#DclModule},!.Heaps,!.CheckState)
checkInstanceDefs mod_index instance_defs type_defs class_defs member_defs modules heaps=:{hp_type_heaps} cs
# is = { is_type_defs = type_defs, is_class_defs = class_defs, is_member_defs = member_defs, is_modules = modules }
(instance_defs, is, hp_type_heaps, cs) = check_instance_defs 0 mod_index instance_defs is hp_type_heaps cs
@@ -191,24 +186,15 @@ where
# (entry, cs_symbol_table) = readPtr id_info cs_symbol_table
# cs = pushErrorAdmin (newPosition ins_ident ins_pos) { cs & cs_symbol_table = cs_symbol_table }
# (ins, is, type_heaps, cs) = case entry.ste_kind of
- STE_Class
- # (class_def, is) = class_by_index entry.ste_index is
+ STE_Class
+ # (class_def, is) = is!is_class_defs.[entry.ste_index]
-> check_class_instance class_def module_index entry.ste_index module_index ins is type_heaps cs
STE_Imported STE_Class decl_index
- # (class_def, is) = class_by_module_index decl_index entry.ste_index is
+ # (class_def, is) = is!is_modules.[decl_index].dcl_common.com_class_defs.[entry.ste_index]
-> check_class_instance class_def module_index entry.ste_index decl_index ins is type_heaps cs
ste -> (ins, is, type_heaps, { cs & cs_error = checkError id_name "class undefined" cs.cs_error })
= (ins, is, type_heaps, popErrorAdmin cs)
- where
- class_by_index class_index is=:{is_class_defs}
- # (class_def, is_class_defs) = is_class_defs![class_index]
- = (class_def, {is & is_class_defs = is_class_defs})
- class_by_module_index decl_index class_index is=:{is_modules}
- # (dcl_mod, is_modules) = is_modules![decl_index]
- class_def = dcl_mod.dcl_common.com_class_defs.[class_index]
- = (class_def, {is & is_modules = is_modules })
-
check_class_instance :: ClassDef !Index !Index !Index !ClassInstance !u:InstanceSymbols !*TypeHeaps !*CheckState
-> (!ClassInstance, !u:InstanceSymbols, !*TypeHeaps, !*CheckState)
check_class_instance class_def module_index class_index class_mod_index
@@ -232,7 +218,7 @@ checkIclInstances mod_index icl_common=:{com_instance_defs,com_class_defs,com_me
| cs_error.ea_ok
# (instance_types, com_instance_defs, com_class_defs, com_member_defs, com_generic_defs, com_type_defs, modules, var_heap, type_heaps, cs)
= check_icl_instances 0 mod_index [] com_instance_defs com_class_defs com_member_defs /*AA*/com_generic_defs com_type_defs modules var_heap type_heaps cs
- = (instance_types, { icl_common & com_instance_defs = com_instance_defs,com_class_defs = com_class_defs,com_member_defs = com_member_defs, /*AA*/com_generic_defs = com_generic_defs, com_type_defs = com_type_defs },
+ = (instance_types, { icl_common & com_instance_defs = com_instance_defs,com_class_defs = com_class_defs,com_member_defs = com_member_defs, com_generic_defs = com_generic_defs, com_type_defs = com_type_defs },
modules, var_heap, type_heaps, cs)
= ([], icl_common, modules, var_heap, type_heaps, cs)
where
@@ -260,21 +246,6 @@ where
# cs = { cs & cs_error = checkErrorWithIdentPos (newPosition class_ident ins_pos) "different number of members specified" cs.cs_error }
= (instance_types, class_defs, member_defs, generic_defs, type_defs, modules, var_heap, type_heaps, cs)
-/*
- check_generic_instance {ins_class, ins_members, ins_generate} mod_index instance_types class_defs member_defs generic_defs type_defs modules var_heap type_heaps cs
- # ({gen_ident, gen_member_ident}, generic_defs, modules) = getGenericDef ins_class mod_index generic_defs modules
- //| ins_generate
- // = (instance_types, class_defs, member_defs, generic_defs, type_defs, modules, var_heap, type_heaps, cs)
- | size ins_members <> 1
- # cs = { cs & cs_error = checkError gen_ident "generic instance must have one member" cs.cs_error }
- = (instance_types, class_defs, member_defs, generic_defs, type_defs, modules, var_heap, type_heaps, cs)
- # member_name = ins_members.[0].ds_ident
- | member_name <> gen_member_ident
- # cs = { cs & cs_error = checkError member_name "wrong member name" cs.cs_error }
- = (instance_types, class_defs, member_defs, generic_defs, type_defs, modules, var_heap, type_heaps, cs)
- // otherwise
- = (instance_types, class_defs, member_defs, generic_defs, type_defs, modules, var_heap, type_heaps, cs)
-*/
check_icl_instance_members :: !Index !Index !Int !Int !{#ClassInstanceMember} !{#DefinedSymbol} Ident !Position !InstanceType ![(Index,SymbolType)]
!v:{# MemberDef} !blah:{# CheckedTypeDef} !u:{# DclModule} !*VarHeap !*TypeHeaps !*CheckState
-> (![(Index,SymbolType)], !v:{# MemberDef}, !blah:{# CheckedTypeDef}, !u:{# DclModule},!*VarHeap, !*TypeHeaps, !*CheckState)
@@ -318,16 +289,6 @@ getMemberDef mem_mod mem_index mod_index member_defs modules
# (dcl_mod,modules) = modules![mem_mod]
= (dcl_mod.dcl_common.com_member_defs.[mem_index], member_defs, modules)
-/*
-getGenericDef :: !(Global DefinedSymbol) !Int !u:{#GenericDef} !v:{#DclModule} -> (!GenericDef,!u:{#GenericDef},!v:{#DclModule})
-getGenericDef {glob_module, glob_object={ds_ident, ds_index}} mod_index generic_defs modules
- | glob_module == mod_index
- # (generic_def, generic_defs) = generic_defs![ds_index]
- = (generic_def, generic_defs, modules)
- # (dcl_mod, modules) = modules![glob_module]
- = (dcl_mod.dcl_common.com_generic_defs.[ds_index], generic_defs, modules)
-*/
-
instantiateTypes :: ![TypeVar] ![AttributeVar] ![AType] ![TypeContext] ![AttrInequality] !SpecialSubstitution ![SpecialSubstitution] !*TypeHeaps !*ErrorAdmin
-> (![TypeVar], ![AttributeVar], ![AType], ![TypeContext], ![AttrInequality], ![SpecialSubstitution], !*TypeHeaps, !*ErrorAdmin)
instantiateTypes old_type_vars old_attr_vars types type_contexts attr_env {ss_environ, ss_vars, ss_attrs, ss_context} special_subst_list type_heaps=:{th_vars, th_attrs} error
@@ -619,7 +580,7 @@ where
= (tc_types, predef_symbols,error)
= (tc_types, predef_symbols,checkError ds_ident.id_name "illegal specialization" error)
check_and_collect_context_types_of_special {tc_class=TCGeneric {gtc_generic},tc_types} predef_symbols error
- = (tc_types, predef_symbols,checkError gtc_generic.glob_object.ds_ident.id_name "genenric specials are illegal" error)
+ = (tc_types, predef_symbols,checkError gtc_generic.glob_object.ds_ident.id_name "generic specials are illegal" error)
hasNoTypeVariables []
= True
@@ -802,10 +763,9 @@ checkFunction fun_def=:{fun_ident,fun_pos,fun_body,fun_type,fun_kind} mod_index
fun_def = { fun_def & fun_body = fun_body, fun_info = fun_info, fun_type = fun_type}
(fun_defs,macro_defs,cs_symbol_table) = remove_calls_from_symbol_table fun_index def_level es_calls e_state.es_fun_defs e_info.ef_macro_defs cs.cs_symbol_table
= (fun_def,fun_defs,
- { e_info & ef_type_defs = ef_type_defs, ef_modules = ef_modules,ef_macro_defs=macro_defs },
- { heaps & hp_var_heap = es_var_heap, hp_expression_heap = es_expr_heap, hp_type_heaps = es_type_heaps,hp_generic_heap=es_generic_heap },
- { cs & cs_symbol_table = cs_symbol_table })
-
+ {e_info & ef_type_defs = ef_type_defs, ef_modules = ef_modules,ef_macro_defs=macro_defs},
+ {heaps & hp_var_heap = es_var_heap, hp_expression_heap = es_expr_heap, hp_type_heaps = es_type_heaps,hp_generic_heap=es_generic_heap},
+ {cs & cs_symbol_table = cs_symbol_table})
where
has_type (Yes _) = FI_HasTypeSpec
has_type no = 0
@@ -928,9 +888,8 @@ instance < FunDef
where
(<) fd1 fd2 = fd1.fun_ident.id_name < fd2.fun_ident.id_name
-
collectCommonfinitions :: !(CollectedDefinitions ClassInstance) -> (!*{# Int}, ![Declaration])
-collectCommonfinitions {def_types,def_constructors,def_selectors,def_classes,def_members,def_instances, def_generic_cases, def_generics}
+collectCommonfinitions {def_types,def_constructors,def_selectors,def_classes,def_members,def_instances, def_generic_cases, def_generics}
// MW: the order in which the declarations appear in the returned list is essential (explicit imports)
# sizes = createArray cConversionTableSize 0
(size, defs) = foldSt cons_def_to_dcl def_constructors (0, [])
@@ -963,7 +922,7 @@ where
= (inc decl_index, [Declaration { decl_ident = me_ident, decl_pos = me_pos, decl_kind = STE_Member, decl_index = decl_index } : decls])
instance_def_to_dcl {ins_ident, ins_pos} (decl_index, decls)
= (inc decl_index, [Declaration { decl_ident = ins_ident, decl_pos = ins_pos, decl_kind = STE_Instance, decl_index = decl_index } : decls])
- generic_def_to_dcl {gen_ident, gen_member_ident, gen_type, gen_pos} (decl_index, decls)
+ generic_def_to_dcl {gen_ident, gen_member_ident, gen_pos} (decl_index, decls)
# generic_decl = Declaration { decl_ident = gen_ident, decl_pos = gen_pos, decl_kind = STE_Generic, decl_index = decl_index }
# member_decl = Declaration { decl_ident = gen_member_ident, decl_pos = gen_pos, decl_kind = STE_Generic, decl_index = decl_index }
= (inc decl_index, [generic_decl, member_decl : decls])
@@ -979,7 +938,7 @@ createCommonDefinitions {def_types,def_constructors,def_selectors,def_classes,de
, com_member_defs = { member \\ member <- def_members }
, com_instance_defs = { next_instance \\ next_instance <- def_instances }
, com_generic_defs = { gen \\ gen <- def_generics }
- , com_gencase_defs = { gi \\ gi <- def_generic_cases}
+ , com_gencase_defs = { gi \\ gi <- def_generic_cases}
}
array_plus_list a [] = a
@@ -1772,8 +1731,8 @@ createCommonDefinitionsWithinComponent :: Bool Int *(!*{#.DclModule},*CheckState
createCommonDefinitionsWithinComponent is_on_cycle mod_index (dcl_modules, cs=:{cs_symbol_table})
# (dcl_mod=:{dcl_name}, dcl_modules) = dcl_modules![mod_index]
(mod_entry, cs_symbol_table) = readPtr dcl_name.id_info cs_symbol_table
- ({ ste_kind = STE_Module mod, ste_index }) = mod_entry
- cs = { cs & cs_symbol_table = cs_symbol_table}
+ ({ste_kind = STE_Module mod, ste_index}) = mod_entry
+ cs = {cs & cs_symbol_table = cs_symbol_table}
# dcl_common = createCommonDefinitions mod.mod_defs
#! first_type_index = size dcl_common.com_type_defs
# dcl_common = {dcl_common & com_class_defs = number_class_dictionaries 0 dcl_common.com_class_defs first_type_index}
@@ -2078,7 +2037,7 @@ check_module1 cdefs icl_global_function_range fun_defs optional_dcl_mod optional
main_dcl_module_n = if (dcl_module_n_in_cache<>NoIndex) dcl_module_n_in_cache nr_of_cached_modules
cs_x = {x_needed_modules = 0,x_main_dcl_module_n=main_dcl_module_n, x_check_dynamic_types = False}
- cs = { cs_symbol_table = symbol_table, cs_predef_symbols = predef_symbols, cs_error = error, cs_x = cs_x}
+ cs = {cs_symbol_table = symbol_table, cs_predef_symbols = predef_symbols, cs_error = error, cs_x = cs_x}
(scanned_modules,macro_defs,cs) = add_dcl_module_predef_module_and_modules_to_symbol_table optional_dcl_mod optional_pre_def_mod scanned_modules nr_of_cached_modules cs
macro_defs = make_macro_def_array cached_dcl_macros macro_defs