diff options
| -rw-r--r-- | frontend/check.dcl | 2 | ||||
| -rw-r--r-- | frontend/check.icl | 364 |
2 files changed, 178 insertions, 188 deletions
diff --git a/frontend/check.dcl b/frontend/check.dcl index ce4afe8..1f5129a 100644 --- a/frontend/check.dcl +++ b/frontend/check.dcl @@ -2,8 +2,6 @@ definition module check import syntax, transform, checksupport, typesupport, predef -cPredefinedModuleIndex :== 1 - checkModule :: !ScannedModule !IndexRange ![FunDef] !Int !Int !(Optional ScannedModule) ![ScannedModule] !{#DclModule} !{#FunDef} !*PredefinedSymbols !*SymbolTable !*File !*Heaps -> (!Bool, *IclModule, *{# DclModule}, *{! Group}, !(Optional {# Index}), !.{#FunDef},!Int, !*Heaps, !*PredefinedSymbols, !*SymbolTable, *File /* TD */, [String]) diff --git a/frontend/check.icl b/frontend/check.icl index e507264..d0c4911 100644 --- a/frontend/check.icl +++ b/frontend/check.icl @@ -5,7 +5,6 @@ import StdEnv import syntax, typesupport, parse, checksupport, utilities, checktypes, transform, predef import explicitimports, comparedefimp, checkFunctionBodies, containers, portToNewSyntax, compilerSwitches -cPredefinedModuleIndex :== 1 cUndef :== (-1) cDummyArray :== {} @@ -95,16 +94,16 @@ where # (member_def, member_defs) = member_defs![ds_index] = set_classes_in_member_defs (inc mem_offset) class_members glob_class_index { member_defs & [ds_index] = { member_def & me_class = glob_class_index }} -checkSpecial :: !Index !FunType !Index !SpecialSubstitution (!Index, ![FunType], !*Heaps, !*ErrorAdmin) - -> (!Special, (!Index, ![FunType], !*Heaps, !*ErrorAdmin)) -checkSpecial mod_index fun_type=:{ft_type} fun_index subst (next_inst_index, special_types, heaps, error) +checkSpecial :: !Index !FunType !Index !SpecialSubstitution !(!Index, ![FunType], !*Heaps,!*PredefinedSymbols,!*ErrorAdmin) + -> (!Special, !(!Index, ![FunType], !*Heaps,!*PredefinedSymbols, !*ErrorAdmin)) +checkSpecial mod_index fun_type=:{ft_type} fun_index subst (next_inst_index, special_types, heaps, predef_symbols,error) # (special_type, hp_type_heaps, error) = substitute_type ft_type subst heaps.hp_type_heaps error - (spec_types, error) = checkAndCollectTypesOfContexts special_type.st_context error + (spec_types, predef_symbols, error) = checkAndCollectTypesOfContextsOfSpecials special_type.st_context predef_symbols error ft_type = { special_type & st_context = [] } (new_info_ptr, hp_var_heap) = newPtr VI_Empty heaps.hp_var_heap = ( { spec_index = { glob_module = mod_index, glob_object = next_inst_index }, spec_types = spec_types, spec_vars = subst.ss_vars, spec_attrs = subst.ss_attrs }, ((inc next_inst_index), [{ fun_type & ft_type = ft_type, ft_specials = SP_FunIndex fun_index, ft_type_ptr = new_info_ptr} : special_types ], - { heaps & hp_type_heaps = hp_type_heaps, hp_var_heap = hp_var_heap }, error)) + { heaps & hp_type_heaps = hp_type_heaps, hp_var_heap = hp_var_heap }, predef_symbols, error)) where substitute_type st=:{st_vars,st_attr_vars,st_args,st_result,st_context,st_attr_env} environment type_heaps error # (st_vars, st_attr_vars, [st_result : st_args], st_context, st_attr_env, _, type_heaps, Yes error) @@ -127,42 +126,42 @@ where cs = { cs & cs_error = setErrorAdmin position cs.cs_error } (ft_type, ft_specials, type_defs, class_defs, modules, hp_type_heaps, cs) = checkFunctionType module_index ft_type ft_specials type_defs class_defs modules heaps.hp_type_heaps cs - (spec_types, next_inst_index, collected_instances, heaps, cs_error) + (spec_types, next_inst_index, collected_instances, heaps, cs_predef_symbols,cs_error) = check_specials module_index { fun_type & ft_type = ft_type } fun_index ft_specials next_inst_index collected_instances - { heaps & hp_type_heaps = hp_type_heaps } cs.cs_error + { heaps & hp_type_heaps = hp_type_heaps } cs.cs_predef_symbols cs.cs_error (new_info_ptr, hp_var_heap) = newPtr VI_Empty heaps.hp_var_heap = check_dcl_functions module_index fun_types (inc fun_index) next_inst_index [ { fun_type & ft_type = ft_type, ft_specials = spec_types, ft_type_ptr = new_info_ptr } : collected_funtypes] - collected_instances type_defs class_defs modules { heaps & hp_var_heap = hp_var_heap } { cs & cs_error = cs_error } - - check_specials :: !Index !FunType !Index !Specials !Index ![FunType] !*Heaps !*ErrorAdmin - -> (!Specials, !Index, ![FunType], !*Heaps, !*ErrorAdmin) - check_specials mod_index fun_type fun_index (SP_Substitutions substs) next_inst_index all_instances heaps error - # (list_of_specials, (next_inst_index, all_instances, heaps, cs_error)) - = mapSt (checkSpecial mod_index fun_type fun_index) substs (next_inst_index, all_instances, heaps, error) - = (SP_ContextTypes list_of_specials, next_inst_index, all_instances, heaps, cs_error) - check_specials mod_index fun_type fun_index SP_None next_inst_index all_instances heaps error - = (SP_None, next_inst_index, all_instances, heaps, error) - -checkSpecialsOfInstances :: !Index !Index ![ClassInstance] !Index ![ClassInstance] ![FunType] {# FunType} *{! [Special] } !*Heaps !*ErrorAdmin - -> (!Index, ![ClassInstance], ![FunType], !*{! [Special]}, !*Heaps, !*ErrorAdmin) + collected_instances type_defs class_defs modules { heaps & hp_var_heap = hp_var_heap } { cs & cs_predef_symbols=cs_predef_symbols,cs_error = cs_error } + + check_specials :: !Index !FunType !Index !Specials !Index ![FunType] !*Heaps !*PredefinedSymbols !*ErrorAdmin + -> (!Specials, !Index, ![FunType], !*Heaps, !*PredefinedSymbols, !*ErrorAdmin) + check_specials mod_index fun_type fun_index (SP_Substitutions substs) next_inst_index all_instances heaps predef_symbols error + # (list_of_specials, (next_inst_index, all_instances, heaps, cs_predef_symbols,cs_error)) + = mapSt (checkSpecial mod_index fun_type fun_index) substs (next_inst_index, all_instances, heaps, predef_symbols,error) + = (SP_ContextTypes list_of_specials, next_inst_index, all_instances, heaps, cs_predef_symbols,cs_error) + check_specials mod_index fun_type fun_index SP_None next_inst_index all_instances heaps predef_symbols error + = (SP_None, next_inst_index, all_instances, heaps, predef_symbols,error) + +checkSpecialsOfInstances :: !Index !Index ![ClassInstance] !Index ![ClassInstance] ![FunType] {# FunType} *{! [Special] } !*Heaps !*PredefinedSymbols !*ErrorAdmin + -> (!Index, ![ClassInstance], ![FunType], !*{! [Special]}, !*Heaps, !*PredefinedSymbols,!*ErrorAdmin) checkSpecialsOfInstances mod_index first_mem_index [class_inst=:{ins_members,ins_specials} : class_insts] next_inst_index all_class_instances all_specials - new_inst_defs all_spec_types heaps error + new_inst_defs all_spec_types heaps predef_symbols error = case ins_specials of SP_TypeOffset type_offset - # (next_inst_index, rev_mem_specials, all_specials, all_spec_types, heaps, error) - = check_and_build_members mod_index first_mem_index 0 ins_members type_offset next_inst_index [] all_specials new_inst_defs all_spec_types heaps error + # (next_inst_index, rev_mem_specials, all_specials, all_spec_types, heaps,predef_symbols, error) + = check_and_build_members mod_index first_mem_index 0 ins_members type_offset next_inst_index [] all_specials new_inst_defs all_spec_types heaps predef_symbols error class_inst = { class_inst & ins_members = { mem \\ mem <- reverse rev_mem_specials } } -> checkSpecialsOfInstances mod_index first_mem_index class_insts next_inst_index [class_inst : all_class_instances] - all_specials new_inst_defs all_spec_types heaps error + all_specials new_inst_defs all_spec_types heaps predef_symbols error SP_None -> checkSpecialsOfInstances mod_index first_mem_index class_insts next_inst_index [class_inst : all_class_instances] - all_specials new_inst_defs all_spec_types heaps error + all_specials new_inst_defs all_spec_types heaps predef_symbols error where - check_and_build_members :: !Index !Index !Int {# DefinedSymbol} !Int !Index ![DefinedSymbol] ![FunType] !{#FunType} !*{! [Special]} !*Heaps !*ErrorAdmin - -> (!Index, ![DefinedSymbol], ![FunType], !*{! [Special]}, !*Heaps, !*ErrorAdmin) + check_and_build_members :: !Index !Index !Int {# DefinedSymbol} !Int !Index ![DefinedSymbol] ![FunType] !{#FunType} !*{! [Special]} !*Heaps !*PredefinedSymbols !*ErrorAdmin + -> (!Index, ![DefinedSymbol], ![FunType], !*{! [Special]}, !*Heaps, !*PredefinedSymbols,!*ErrorAdmin) check_and_build_members mod_index first_mem_index member_offset ins_members type_offset next_inst_index rev_mem_specials all_specials inst_spec_defs - all_spec_types heaps error + all_spec_types heaps predef_symbols error | member_offset < size ins_members # member = ins_members.[member_offset] member_index = member.ds_index @@ -172,15 +171,14 @@ where (SP_Substitutions specials) = mem_inst.ft_specials env = specials !! type_offset member = { member & ds_index = next_inst_index } - (spec_type, (next_inst_index, all_specials, heaps, error)) - = checkSpecial mod_index mem_inst member_index env (next_inst_index, all_specials, heaps, error) + (spec_type, (next_inst_index, all_specials, heaps, predef_symbols,error)) + = checkSpecial mod_index mem_inst member_index env (next_inst_index, all_specials, heaps, predef_symbols,error) all_spec_types = { all_spec_types & [spec_member_index] = [ spec_type : spec_types] } = check_and_build_members mod_index first_mem_index (inc member_offset) ins_members type_offset next_inst_index [ member : rev_mem_specials ] - all_specials inst_spec_defs all_spec_types heaps error - = (next_inst_index, rev_mem_specials, all_specials, all_spec_types, heaps, error) - -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) + all_specials inst_spec_defs all_spec_types heaps predef_symbols error + = (next_inst_index, rev_mem_specials, all_specials, all_spec_types, heaps, predef_symbols,error) +checkSpecialsOfInstances mod_index first_mem_index [] next_inst_index all_class_instances all_specials inst_spec_defs all_spec_types heaps predef_symbols error + = (next_inst_index, all_class_instances, all_specials, all_spec_types, heaps, predef_symbols,error) checkMemberTypes :: !Index !*{#MemberDef} !*{#CheckedTypeDef} !*{#ClassDef} !*{#DclModule} !*TypeHeaps !*VarHeap !*CheckState -> (!*{#MemberDef}, !*{#CheckedTypeDef}, !*{#ClassDef}, !*{#DclModule}, !*TypeHeaps, !*VarHeap, !*CheckState) @@ -515,13 +513,6 @@ substituteInstanceType it=:{it_vars,it_attr_vars,it_types,it_context} environmen = instantiateTypes it_vars it_attr_vars it_types it_context [] environment [] type_heaps (Yes cs_error) = ({it & it_vars = it_vars, it_types = it_types, it_attr_vars = it_attr_vars, it_context = it_context }, type_heaps, cs_error) -hasTypeVariables [] - = False -hasTypeVariables [TV tvar : types] - = True -hasTypeVariables [ _ : types] - = hasTypeVariables types - determineTypeOfMemberInstance :: !SymbolType ![TypeVar] !InstanceType !Specials !*TypeHeaps !u:(Optional (v:{#DclModule}, w:{#CheckedTypeDef}, Index)) !(Optional *ErrorAdmin) -> (!SymbolType, !Specials, !*TypeHeaps, !u:Optional (v:{#DclModule}, w:{#CheckedTypeDef}), !Optional *ErrorAdmin) determineTypeOfMemberInstance mem_st class_vars {it_types,it_vars,it_attr_vars,it_context} specials type_heaps opt_modules opt_error @@ -605,22 +596,21 @@ determineTypesOfInstances :: !Index !Index !*{#ClassInstance} !*{# ClassDef} !*{ !*{#DclModule} !*TypeHeaps !*VarHeap !*CheckState -> (![FunType], !Index, ![ClassInstance], !*{#ClassInstance}, !*{# ClassDef}, !*{# MemberDef}, !*{#GenericDef}, !*{#DclModule}, !*TypeHeaps, !*VarHeap, !*CheckState) determineTypesOfInstances first_memb_inst_index mod_index com_instance_defs com_class_defs com_member_defs com_generic_defs - modules type_heaps var_heap cs=:{cs_error, cs_x={x_main_dcl_module_n}} + modules type_heaps var_heap cs=:{cs_error,cs_predef_symbols,cs_x={x_main_dcl_module_n}} | cs_error.ea_ok #! nr_of_class_instances = size com_instance_defs - # (memb_inst_defs, next_mem_inst_index, all_class_specials, com_class_defs, com_member_defs, com_generic_defs, modules, com_instance_defs, type_heaps, var_heap, cs_error) + # (memb_inst_defs, next_mem_inst_index, all_class_specials, com_class_defs, com_member_defs, com_generic_defs, modules, com_instance_defs, type_heaps, var_heap, cs_predef_symbols,cs_error) = determine_types_of_instances x_main_dcl_module_n 0 nr_of_class_instances first_memb_inst_index mod_index [] com_class_defs com_member_defs com_generic_defs - modules com_instance_defs type_heaps var_heap cs_error + modules com_instance_defs type_heaps var_heap cs_predef_symbols cs_error = (memb_inst_defs, next_mem_inst_index, all_class_specials, com_instance_defs, com_class_defs, - com_member_defs, com_generic_defs, modules, type_heaps, var_heap, { cs & cs_error = cs_error }) + com_member_defs, com_generic_defs, modules, type_heaps, var_heap, { cs & cs_predef_symbols=cs_predef_symbols,cs_error = cs_error }) = ([], first_memb_inst_index, [], com_instance_defs, com_class_defs, com_member_defs, com_generic_defs, modules, type_heaps, var_heap, cs) where - determine_types_of_instances :: !Index !Index !Index !Index !Index ![ClassInstance] !v:{#ClassDef} !w:{#MemberDef} !y:{#GenericDef} - !x:{#DclModule} !*{#ClassInstance} !*TypeHeaps !*VarHeap !*ErrorAdmin - -> (![FunType], !Index, ![ClassInstance], !v:{#ClassDef}, !w:{#MemberDef}, !y:{#GenericDef}, !x:{#DclModule}, !*{#ClassInstance}, !*TypeHeaps, !*VarHeap, !*ErrorAdmin) + !x:{#DclModule} !*{#ClassInstance} !*TypeHeaps !*VarHeap !*PredefinedSymbols !*ErrorAdmin + -> (![FunType], !Index, ![ClassInstance], !v:{#ClassDef}, !w:{#MemberDef}, !y:{#GenericDef}, !x:{#DclModule}, !*{#ClassInstance}, !*TypeHeaps, !*VarHeap, !*PredefinedSymbols,!*ErrorAdmin) determine_types_of_instances x_main_dcl_module_n inst_index next_class_inst_index next_mem_inst_index mod_index all_class_specials - class_defs member_defs generic_defs modules instance_defs type_heaps var_heap error + class_defs member_defs generic_defs modules instance_defs type_heaps var_heap predef_symbols error | inst_index < size instance_defs # (instance_def, instance_defs) = instance_defs![inst_index] # {ins_class,ins_pos,ins_type,ins_specials, ins_is_generic} = instance_def @@ -641,34 +631,11 @@ where } # memb_inst_def = MakeNewFunctionType gen_member_name 0 NoPrio empty_st ins_pos SP_None new_info_ptr # memb_inst_defs1 = [memb_inst_def] - # (memb_inst_defs2, next_mem_inst_index, all_class_specials, class_defs, member_defs, generic_defs, modules, instance_defs, type_heaps, var_heap, error) - = determine_types_of_instances - x_main_dcl_module_n - (inc inst_index) - next_class_inst_index - (next_mem_inst_index + class_size) - mod_index - all_class_specials - class_defs - member_defs - generic_defs - modules - { instance_defs & [inst_index] = { instance_def & ins_specials = ins_specials }} - type_heaps - var_heap - error - = ( memb_inst_defs1 ++ memb_inst_defs2 - , next_mem_inst_index - , all_class_specials - , class_defs - , member_defs - , generic_defs - , modules - , instance_defs - , type_heaps - , var_heap - , error - ) + # (memb_inst_defs2, next_mem_inst_index, all_class_specials, class_defs, member_defs, generic_defs, modules, instance_defs, type_heaps, var_heap, predef_symbols,error) + = determine_types_of_instances x_main_dcl_module_n (inc inst_index) next_class_inst_index + (next_mem_inst_index + class_size) mod_index all_class_specials class_defs member_defs generic_defs modules + { instance_defs & [inst_index] = { instance_def & ins_specials = ins_specials }} type_heaps var_heap predef_symbols error + = (memb_inst_defs1 ++ memb_inst_defs2, next_mem_inst_index, all_class_specials, class_defs, member_defs, generic_defs, modules, instance_defs, type_heaps, var_heap ,predef_symbols,error) //---> ("determine_types_of_instances: generic ", gen_name, mod_index, inst_index, x_main_dcl_module_n) // = abort "exporting generics is not yet supported\n" # ({class_name, class_members}, class_defs, modules) = getClassDef ins_class mod_index class_defs modules @@ -677,14 +644,14 @@ where = determine_instance_symbols_and_types x_main_dcl_module_n next_mem_inst_index 0 mod_index ins_class.glob_module class_size class_members ins_type ins_specials class_name ins_pos member_defs modules type_heaps var_heap error instance_def = { instance_def & ins_members = { member \\ member <- ins_members }} - (ins_specials, next_class_inst_index, all_class_specials, type_heaps, error) - = check_instance_specials mod_index instance_def inst_index ins_specials next_class_inst_index all_class_specials type_heaps error - (memb_inst_defs2, next_mem_inst_index, all_class_specials, class_defs, member_defs, generic_defs, modules, instance_defs, type_heaps, var_heap, error) + (ins_specials, next_class_inst_index, all_class_specials, type_heaps, predef_symbols,error) + = check_instance_specials mod_index instance_def inst_index ins_specials next_class_inst_index all_class_specials type_heaps predef_symbols error + (memb_inst_defs2, next_mem_inst_index, all_class_specials, class_defs, member_defs, generic_defs, modules, instance_defs, type_heaps, var_heap, predef_symbols,error) = determine_types_of_instances x_main_dcl_module_n (inc inst_index) next_class_inst_index (next_mem_inst_index + class_size) mod_index all_class_specials - class_defs member_defs generic_defs modules { instance_defs & [inst_index] = { instance_def & ins_specials = ins_specials }} type_heaps var_heap error + class_defs member_defs generic_defs modules { instance_defs & [inst_index] = { instance_def & ins_specials = ins_specials }} type_heaps var_heap predef_symbols error - = (memb_inst_defs1 ++ memb_inst_defs2, next_mem_inst_index, all_class_specials, class_defs, member_defs, generic_defs, modules, instance_defs, type_heaps, var_heap, error) - = ([], next_mem_inst_index, all_class_specials, class_defs, member_defs, generic_defs, modules, instance_defs, type_heaps, var_heap, error) + = (memb_inst_defs1 ++ memb_inst_defs2, next_mem_inst_index, all_class_specials, class_defs, member_defs, generic_defs, modules, instance_defs, type_heaps, var_heap, predef_symbols,error) + = ([], next_mem_inst_index, all_class_specials, class_defs, member_defs, generic_defs, modules, instance_defs, type_heaps, var_heap, predef_symbols,error) determine_instance_symbols_and_types :: !Index !Index !Index !Index !Index !Int !{#DefinedSymbol} !InstanceType !Specials Ident !Position !w:{#MemberDef} !u:{#DclModule} !*TypeHeaps !*VarHeap !*ErrorAdmin @@ -708,33 +675,81 @@ where class_size class_members ins_type ins_specials class_name ins_pos member_defs modules type_heaps var_heap cs_error = ([{ class_member & ds_index = first_inst_index + mem_offset } : inst_symbols], [inst_def : memb_inst_defs], member_defs, modules, type_heaps, var_heap, cs_error) - check_instance_specials :: !Index !ClassInstance !Index !Specials !Index ![ClassInstance] !*TypeHeaps !*ErrorAdmin - -> (!Specials, !Index, ![ClassInstance], !*TypeHeaps, !*ErrorAdmin) - check_instance_specials mod_index inst_type inst_index (SP_Substitutions substs) next_inst_index all_instances type_heaps error - # (list_of_specials, next_inst_index, all_instances, type_heaps, error) - = check_specials mod_index inst_type 0 substs [] next_inst_index all_instances type_heaps error - = (SP_ContextTypes list_of_specials, next_inst_index, all_instances, type_heaps, error) + check_instance_specials :: !Index !ClassInstance !Index !Specials !Index ![ClassInstance] !*TypeHeaps !*PredefinedSymbols !*ErrorAdmin + -> (!Specials, !Index, ![ClassInstance], !*TypeHeaps, !*PredefinedSymbols,!*ErrorAdmin) + check_instance_specials mod_index inst_type inst_index (SP_Substitutions substs) next_inst_index all_instances type_heaps predef_symbols error + # (list_of_specials, next_inst_index, all_instances, type_heaps, predef_symbols,error) + = check_specials mod_index inst_type 0 substs [] next_inst_index all_instances type_heaps predef_symbols error + = (SP_ContextTypes list_of_specials, next_inst_index, all_instances, type_heaps, predef_symbols, error) where - check_specials mod_index inst=:{ins_type} type_offset [ subst : substs ] list_of_specials next_inst_index all_instances type_heaps error + check_specials mod_index inst=:{ins_type} type_offset [ subst : substs ] list_of_specials next_inst_index all_instances type_heaps predef_symbols error # (special_type, type_heaps, error) = substituteInstanceType ins_type subst type_heaps error - (spec_types, error) = checkAndCollectTypesOfContexts special_type.it_context error + (spec_types, predef_symbols,error) = checkAndCollectTypesOfContextsOfSpecials special_type.it_context predef_symbols error special = { spec_index = { glob_module = mod_index, glob_object = next_inst_index }, spec_types = spec_types, spec_vars = subst.ss_vars, spec_attrs = subst.ss_attrs } = check_specials mod_index inst (inc type_offset) substs [ special : list_of_specials ] (inc next_inst_index) - [{ inst & ins_type = { special_type & it_context = [] }, ins_specials = SP_TypeOffset type_offset} : all_instances ] type_heaps error - check_specials mod_index inst=:{ins_type} type_offset [] list_of_specials next_inst_index all_instances type_heaps error - = (list_of_specials, next_inst_index, all_instances, type_heaps, error) - - check_instance_specials mod_index fun_type fun_index SP_None next_inst_index all_instances type_heaps error - = (SP_None, next_inst_index, all_instances, type_heaps, error) + [{ inst & ins_type = { special_type & it_context = [] }, ins_specials = SP_TypeOffset type_offset} : all_instances ] type_heaps predef_symbols error + check_specials mod_index inst=:{ins_type} type_offset [] list_of_specials next_inst_index all_instances type_heaps predef_symbols error + = (list_of_specials, next_inst_index, all_instances, type_heaps, predef_symbols, error) + check_instance_specials mod_index fun_type fun_index SP_None next_inst_index all_instances type_heaps predef_symbols error + = (SP_None, next_inst_index, all_instances, type_heaps, predef_symbols,error) -checkAndCollectTypesOfContexts type_contexts error - = mapSt check_and_collect_context_types type_contexts error +mapSt2 f l s1 s2 :== map_st2 l s1 s2 +where + map_st2 [x : xs] s1 s2 + # (x, s1,s2) = f x s1 s2 + (xs, s1,s2) = map_st2 xs s1 s2 + #! s1 = s1 + #! s2 = s2 + = ([x : xs], s1,s2) + map_st2 [] s1 s2 + = ([], s1,s2) + +checkAndCollectTypesOfContextsOfSpecials :: [TypeContext] *PredefinedSymbols *ErrorAdmin -> (![[Type]],!*PredefinedSymbols,!*ErrorAdmin); +checkAndCollectTypesOfContextsOfSpecials type_contexts predef_symbols error + = mapSt2 check_and_collect_context_types_of_special type_contexts predef_symbols error where - check_and_collect_context_types {tc_class={glob_object={ds_ident}},tc_types} error - | hasTypeVariables tc_types - = (tc_types, checkError ds_ident.id_name "illegal specialization" error) - = (tc_types, error) + check_and_collect_context_types_of_special {tc_class={glob_object={ds_ident,ds_index},glob_module},tc_types} predef_symbols error + | hasNoTypeVariables tc_types + = (tc_types, predef_symbols,error) + # {pds_def,pds_module} = predef_symbols.[PD_ArrayClass] + | glob_module==pds_module && ds_index==pds_def && is_lazy_or_strict_array tc_types predef_symbols + = (tc_types, predef_symbols,error) + # {pds_def,pds_module} = predef_symbols.[PD_ListClass] + | glob_module==pds_module && ds_index==pds_def && is_lazy_or_strict_list tc_types predef_symbols + = (tc_types, predef_symbols,error) + = (tc_types, predef_symbols,checkError ds_ident.id_name "illegal specialization" error) + + hasNoTypeVariables [] + = True + hasNoTypeVariables [TV tvar : types] + = False + hasNoTypeVariables [ _ : types] + = hasNoTypeVariables types + + is_lazy_or_strict_array [TA {type_index={glob_module,glob_object}} [],TV var] predef_symbols + # {pds_def,pds_module} = predef_symbols.[PD_LazyArrayType] + | glob_module==pds_module && glob_object==pds_def + = True + # {pds_def,pds_module} = predef_symbols.[PD_StrictArrayType] + | glob_module==pds_module && glob_object==pds_def + = True + = False + + is_lazy_or_strict_list [TA {type_index={glob_module,glob_object}} [],TV var] predef_symbols + # {pds_def,pds_module} = predef_symbols.[PD_ListType] + | glob_module==pds_module && glob_object==pds_def + = True + # {pds_def,pds_module} = predef_symbols.[PD_StrictListType] + | glob_module==pds_module && glob_object==pds_def + = True + # {pds_def,pds_module} = predef_symbols.[PD_TailStrictListType] + | glob_module==pds_module && glob_object==pds_def + = True + # {pds_def,pds_module} = predef_symbols.[PD_StrictTailStrictListType] + | glob_module==pds_module && glob_object==pds_def + = True + = False initializeContextVariables :: ![TypeContext] !*VarHeap -> (![TypeContext], !*VarHeap) initializeContextVariables contexts var_heap @@ -1615,6 +1630,7 @@ check_module1 {mod_type,mod_name,mod_imports,mod_imported_objects,mod_defs = cde <=< adjust_predefined_module_symbol PD_StdArray <=< adjust_predefined_module_symbol PD_StdEnum <=< adjust_predefined_module_symbol PD_StdBool + <=< adjust_predefined_module_symbol PD_StdStrictLists <=< adjust_predefined_module_symbol PD_StdDynamic <=< adjust_predefined_module_symbol PD_StdGeneric // AA <=< adjust_predefined_module_symbol PD_StdMisc // AA @@ -1799,13 +1815,12 @@ check_module2 mod_name mod_imported_objects mod_imports mod_type icl_global_func (dcls_import_list, dcl_modules, cs) = addImportedSymbolsToSymbolTable nr_of_modules (Yes dcl_macros) modules_in_component_set imports_ikh dcl_modules cs - // MV ... (x_main_dcl_module,cs) = cs!cs_x.x_main_dcl_module_n cs = cs -// <=< adjust_predef_symbol PD_ModuleType x_main_dcl_module STE_Type - <=< adjust_predef_symbol PD_ModuleConsSymbol x_main_dcl_module STE_Constructor +// <=< adjustPredefSymbol PD_ModuleType x_main_dcl_module STE_Type + <=< adjustPredefSymbol PD_ModuleConsSymbol x_main_dcl_module STE_Constructor // .. MV (dcl_modules, icl_functions, hp_expression_heap, cs) @@ -2491,17 +2506,7 @@ doSomeThingsThatHaveToBeDoneAfterTheWholeComponentHasBeenChecked mod_index #! main_dcl_module_n = cs.cs_x.x_main_dcl_module_n # (dcl_modules, hp_type_heaps, cs_error) - = -/* case mod_index==main_dcl_module_n of - True - - # (type_defs, dcl_modules) = dcl_modules![mod_index].dcl_common.com_type_defs - # dcl_modules = { dcl_modules & [mod_index].dcl_common.com_unexpanded_type_defs = { el \\ el <-:type_defs } } - - -> (dcl_modules, hp_type_heaps, cs_error) - False - -> -*/ expand_syn_types_of_dcl_mod mod_index (dcl_modules, hp_type_heaps, cs_error) + = expand_syn_types_of_dcl_mod mod_index (dcl_modules, hp_type_heaps, cs_error) (dcl_mod=:{dcl_functions, dcl_common}, dcl_modules) = dcl_modules![mod_index] nr_of_dcl_functions @@ -2516,9 +2521,9 @@ doSomeThingsThatHaveToBeDoneAfterTheWholeComponentHasBeenChecked mod_index dcl_modules hp_type_heaps hp_var_heap { cs & cs_error = cs_error } heaps = { heaps & hp_type_heaps = hp_type_heaps, hp_var_heap = hp_var_heap } - (nr_of_dcl_funs_insts_and_specs, new_class_instances, rev_special_defs, all_spec_types, heaps, cs_error) + (nr_of_dcl_funs_insts_and_specs, new_class_instances, rev_special_defs, all_spec_types, heaps, cs_predef_symbols,cs_error) = checkSpecialsOfInstances mod_index nr_of_dcl_functions rev_spec_class_inst nr_of_dcl_funs_insts_and_specs [] - rev_special_defs { mem \\ mem <- memb_inst_defs } { [] \\ mem <- memb_inst_defs } heaps cs.cs_error + rev_special_defs { mem \\ mem <- memb_inst_defs } { [] \\ mem <- memb_inst_defs } heaps cs.cs_predef_symbols cs.cs_error dcl_functions = arrayPlusList dcl_functions ( [ { mem_inst & ft_specials = if (isEmpty spec_types) SP_None (SP_ContextTypes spec_types) } @@ -2526,8 +2531,7 @@ doSomeThingsThatHaveToBeDoneAfterTheWholeComponentHasBeenChecked mod_index ] ++ reverse rev_special_defs ) - cs - = { cs & cs_error = cs_error } + cs = { cs & cs_predef_symbols=cs_predef_symbols,cs_error = cs_error} #! mod_index_of_std_array = cs.cs_predef_symbols.[PD_StdArray].pds_def # (com_member_defs, com_instance_defs, dcl_functions, cs) = case mod_index_of_std_array==mod_index of @@ -2552,13 +2556,10 @@ doSomeThingsThatHaveToBeDoneAfterTheWholeComponentHasBeenChecked mod_index expand_syn_types_of_dcl_mod mod_index (dcl_modules, hp_type_heaps, cs_error) # (type_defs, dcl_modules) = dcl_modules![mod_index].dcl_common.com_type_defs - dcl_modules = { dcl_modules & [mod_index].dcl_common.com_unexpanded_type_defs = type_defs } - unique_type_defs = { el \\ el <-:type_defs } - (expanded_type_defs, dcl_modules, hp_type_heaps, cs_error) = expandSynonymTypes mod_index unique_type_defs dcl_modules hp_type_heaps cs_error dcl_modules @@ -2680,71 +2681,77 @@ where | pre_mod.pds_def == mod_index # cs = { cs & cs_predef_symbols = cs_predef_symbols} <=< adjust_predef_symbols PD_CreateArrayFun PD_UnqArraySizeFun mod_index STE_Member - <=< adjust_predef_symbol PD_ArrayClass mod_index STE_Class + <=< adjustPredefSymbol PD_ArrayClass mod_index STE_Class = (class_members, class_instances, fun_types, cs) # (pre_mod, cs_predef_symbols) = cs_predef_symbols![PD_PredefinedModule] | pre_mod.pds_def == mod_index = (class_members, class_instances, fun_types, { cs & cs_predef_symbols = cs_predef_symbols} - <=< adjust_predef_symbol PD_StringType mod_index STE_Type + <=< adjustPredefSymbol PD_StringType mod_index STE_Type <=< adjust_predef_symbols PD_ListType PD_UnboxedArrayType mod_index STE_Type <=< adjust_predef_symbols PD_ConsSymbol PD_Arity32TupleSymbol mod_index STE_Constructor - <=< adjust_predef_symbol PD_TypeCodeClass mod_index STE_Class - <=< adjust_predef_symbol PD_TypeCodeMember mod_index STE_Member - <=< adjust_predef_symbol PD_DummyForStrictAliasFun mod_index STE_DclFunction) + <=< adjustPredefSymbol PD_TypeCodeClass mod_index STE_Class + <=< adjustPredefSymbol PD_TypeCodeMember mod_index STE_Member + <=< adjustPredefSymbol PD_DummyForStrictAliasFun mod_index STE_DclFunction) # (pre_mod, cs_predef_symbols) = cs_predef_symbols![PD_StdBool] | pre_mod.pds_def == mod_index = (class_members, class_instances, fun_types, { cs & cs_predef_symbols = cs_predef_symbols} - <=< adjust_predef_symbol PD_AndOp mod_index STE_DclFunction - <=< adjust_predef_symbol PD_OrOp mod_index STE_DclFunction) + <=< adjustPredefSymbol PD_AndOp mod_index STE_DclFunction + <=< adjustPredefSymbol PD_OrOp mod_index STE_DclFunction) + # (pre_mod, cs_predef_symbols) = cs_predef_symbols![PD_StdStrictLists] + | pre_mod.pds_def == mod_index + = (class_members, class_instances, fun_types, { cs & cs_predef_symbols = cs_predef_symbols} + <=< adjust_predef_symbols PD_cons PD_decons_uts mod_index STE_Member + <=< adjust_predef_symbols PD_nil PD_nil_uts mod_index STE_DclFunction + <=< adjust_predef_symbols PD_ListClass PD_UTSListClass mod_index STE_Class) # (pre_mod, cs_predef_symbols) = cs_predef_symbols![PD_StdDynamic] | pre_mod.pds_def == mod_index = (class_members, class_instances, fun_types, { cs & cs_predef_symbols = cs_predef_symbols} - <=< adjust_predef_symbol PD_TypeObjectType mod_index STE_Type - <=< adjust_predef_symbol PD_TypeConsSymbol mod_index STE_Constructor - <=< adjust_predef_symbol PD_variablePlaceholder mod_index STE_Constructor - <=< adjust_predef_symbol PD_unify mod_index STE_DclFunction - <=< adjust_predef_symbol PD_coerce mod_index STE_DclFunction - <=< adjust_predef_symbol PD_undo_indirections mod_index STE_DclFunction + <=< adjustPredefSymbol PD_TypeObjectType mod_index STE_Type + <=< adjustPredefSymbol PD_TypeConsSymbol mod_index STE_Constructor + <=< adjustPredefSymbol PD_variablePlaceholder mod_index STE_Constructor + <=< adjustPredefSymbol PD_unify mod_index STE_DclFunction + <=< adjustPredefSymbol PD_coerce mod_index STE_DclFunction + <=< adjustPredefSymbol PD_undo_indirections mod_index STE_DclFunction // MV ... - <=< adjust_predef_symbol PD_DynamicTemp mod_index STE_Type - <=< adjust_predef_symbol PD_DynamicType mod_index (STE_Field unused) - <=< adjust_predef_symbol PD_DynamicValue mod_index (STE_Field unused) + <=< adjustPredefSymbol PD_DynamicTemp mod_index STE_Type + <=< adjustPredefSymbol PD_DynamicType mod_index (STE_Field unused) + <=< adjustPredefSymbol PD_DynamicValue mod_index (STE_Field unused) - <=< adjust_predef_symbol PD_TypeID mod_index STE_Type - <=< adjust_predef_symbol PD_ModuleID mod_index STE_Constructor) + <=< adjustPredefSymbol PD_TypeID mod_index STE_Type + <=< adjustPredefSymbol PD_ModuleID mod_index STE_Constructor) // ... MV // AA.. # (pre_mod, cs_predef_symbols) = cs_predef_symbols![PD_StdGeneric] # (pd_type_iso, cs_predef_symbols) = cs_predef_symbols![PD_TypeISO] | pre_mod.pds_def == mod_index = (class_members, class_instances, fun_types, { cs & cs_predef_symbols = cs_predef_symbols} - <=< adjust_predef_symbol PD_TypeISO mod_index STE_Type - <=< adjust_predef_symbol PD_ConsISO mod_index STE_Constructor - <=< adjust_predef_symbol PD_iso_from mod_index (STE_Field pd_type_iso.pds_ident) - <=< adjust_predef_symbol PD_iso_to mod_index (STE_Field pd_type_iso.pds_ident) - <=< adjust_predef_symbol PD_TypeUNIT mod_index STE_Type - <=< adjust_predef_symbol PD_ConsUNIT mod_index STE_Constructor - <=< adjust_predef_symbol PD_TypePAIR mod_index STE_Type - <=< adjust_predef_symbol PD_ConsPAIR mod_index STE_Constructor - <=< adjust_predef_symbol PD_TypeEITHER mod_index STE_Type - <=< adjust_predef_symbol PD_ConsLEFT mod_index STE_Constructor - <=< adjust_predef_symbol PD_ConsRIGHT mod_index STE_Constructor - <=< adjust_predef_symbol PD_TypeARROW mod_index STE_Type - <=< adjust_predef_symbol PD_ConsARROW mod_index STE_Constructor - <=< adjust_predef_symbol PD_isomap_ARROW_ mod_index STE_DclFunction - <=< adjust_predef_symbol PD_isomap_ID mod_index STE_DclFunction - <=< adjust_predef_symbol PD_TypeConsDefInfo mod_index STE_Type - <=< adjust_predef_symbol PD_ConsConsDefInfo mod_index STE_Constructor - <=< adjust_predef_symbol PD_TypeTypeDefInfo mod_index STE_Type - <=< adjust_predef_symbol PD_ConsTypeDefInfo mod_index STE_Constructor - <=< adjust_predef_symbol PD_TypeCONS mod_index STE_Type - <=< adjust_predef_symbol PD_ConsCONS mod_index STE_Constructor - <=< adjust_predef_symbol PD_cons_info mod_index STE_DclFunction) + <=< adjustPredefSymbol PD_TypeISO mod_index STE_Type + <=< adjustPredefSymbol PD_ConsISO mod_index STE_Constructor + <=< adjustPredefSymbol PD_iso_from mod_index (STE_Field pd_type_iso.pds_ident) + <=< adjustPredefSymbol PD_iso_to mod_index (STE_Field pd_type_iso.pds_ident) + <=< adjustPredefSymbol PD_TypeUNIT mod_index STE_Type + <=< adjustPredefSymbol PD_ConsUNIT mod_index STE_Constructor + <=< adjustPredefSymbol PD_TypePAIR mod_index STE_Type + <=< adjustPredefSymbol PD_ConsPAIR mod_index STE_Constructor + <=< adjustPredefSymbol PD_TypeEITHER mod_index STE_Type + <=< adjustPredefSymbol PD_ConsLEFT mod_index STE_Constructor + <=< adjustPredefSymbol PD_ConsRIGHT mod_index STE_Constructor + <=< adjustPredefSymbol PD_TypeARROW mod_index STE_Type + <=< adjustPredefSymbol PD_ConsARROW mod_index STE_Constructor + <=< adjustPredefSymbol PD_isomap_ARROW_ mod_index STE_DclFunction + <=< adjustPredefSymbol PD_isomap_ID mod_index STE_DclFunction + <=< adjustPredefSymbol PD_TypeConsDefInfo mod_index STE_Type + <=< adjustPredefSymbol PD_ConsConsDefInfo mod_index STE_Constructor + <=< adjustPredefSymbol PD_TypeTypeDefInfo mod_index STE_Type + <=< adjustPredefSymbol PD_ConsTypeDefInfo mod_index STE_Constructor + <=< adjustPredefSymbol PD_TypeCONS mod_index STE_Type + <=< adjustPredefSymbol PD_ConsCONS mod_index STE_Constructor + <=< adjustPredefSymbol PD_cons_info mod_index STE_DclFunction) # (pre_mod, cs_predef_symbols) = cs_predef_symbols![PD_StdMisc] | pre_mod.pds_def == mod_index = (class_members, class_instances, fun_types, { cs & cs_predef_symbols = cs_predef_symbols} - <=< adjust_predef_symbol PD_abort mod_index STE_DclFunction - <=< adjust_predef_symbol PD_undef mod_index STE_DclFunction) + <=< adjustPredefSymbol PD_abort mod_index STE_DclFunction + <=< adjustPredefSymbol PD_undef mod_index STE_DclFunction) // ..AA = (class_members, class_instances, fun_types, { cs & cs_predef_symbols = cs_predef_symbols}) @@ -2758,22 +2765,9 @@ where | next_symb > last_symb = cs = cs - <=< adjust_predef_symbol next_symb mod_index symb_kind + <=< adjustPredefSymbol next_symb mod_index symb_kind <=< adjust_predef_symbols (inc next_symb) last_symb mod_index symb_kind - - adjust_predef_symbol predef_index mod_index symb_kind cs=:{cs_predef_symbols,cs_symbol_table,cs_error} - # (pre_symb, cs_predef_symbols) = cs_predef_symbols![predef_index] - # pre_id = pre_symb.pds_ident - #! pre_index = determine_index_of_symbol (sreadPtr pre_id.id_info cs_symbol_table) symb_kind - | pre_index <> NoIndex - = { cs & cs_predef_symbols = {cs_predef_symbols & [predef_index] = { pre_symb & pds_def = pre_index, pds_module = mod_index }}} - = { cs & cs_predef_symbols = cs_predef_symbols, cs_error = checkError pre_id " function not defined" cs_error } - where - determine_index_of_symbol {ste_kind, ste_index} symb_kind - | ste_kind == symb_kind - = ste_index - = NoIndex - + count_members :: !Index !{# ClassInstance} !{# ClassDef} !{# DclModule} -> Int count_members mod_index com_instance_defs com_class_defs modules # (sum, _, _) @@ -2790,8 +2784,7 @@ where = getClassDef ins_class mod_index com_class_defs modules = (size class_members + sum, com_class_defs, modules) -// MV... -adjust_predef_symbol predef_index mod_index symb_kind cs=:{cs_predef_symbols,cs_symbol_table,cs_error} +adjustPredefSymbol predef_index mod_index symb_kind cs=:{cs_predef_symbols,cs_symbol_table,cs_error} # (pre_symb, cs_predef_symbols) = cs_predef_symbols![predef_index] # pre_id = pre_symb.pds_ident #! pre_index = determine_index_of_symbol (sreadPtr pre_id.id_info cs_symbol_table) symb_kind @@ -2803,7 +2796,6 @@ where | ste_kind == symb_kind = ste_index = NoIndex -// ... MV 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 }) |