diff options
| -rw-r--r-- | frontend/check.dcl | 2 | ||||
| -rw-r--r-- | frontend/check.icl | 411 | ||||
| -rw-r--r-- | frontend/checktypes.icl | 10 | ||||
| -rw-r--r-- | frontend/generics.icl | 20 | ||||
| -rw-r--r-- | frontend/overloading.icl | 8 | ||||
| -rw-r--r-- | frontend/syntax.dcl | 11 | ||||
| -rw-r--r-- | frontend/syntax.icl | 1 | ||||
| -rw-r--r-- | frontend/trans.icl | 68 | ||||
| -rw-r--r-- | frontend/transform.icl | 8 | ||||
| -rw-r--r-- | frontend/type.icl | 4 | ||||
| -rw-r--r-- | frontend/typesupport.dcl | 2 | ||||
| -rw-r--r-- | frontend/typesupport.icl | 98 |
12 files changed, 263 insertions, 380 deletions
diff --git a/frontend/check.dcl b/frontend/check.dcl index 77fb153..8bd8196 100644 --- a/frontend/check.dcl +++ b/frontend/check.dcl @@ -9,7 +9,7 @@ checkModule :: !ScannedModule !IndexRange ![FunDef] !Int !Int !(Optional Scanned checkFunctions :: !Index !Level !Index !Index !*{#FunDef} !*ExpressionInfo !*Heaps !*CheckState -> (!*{#FunDef}, !*ExpressionInfo, !*Heaps, !*CheckState) -determineTypeOfMemberInstance :: !SymbolType ![TypeVar] !InstanceType !Specials !*TypeHeaps -> (!SymbolType, !Specials, !*TypeHeaps) +determineTypeOfMemberInstance :: !SymbolType ![TypeVar] !InstanceType !Specials !*TypeHeaps !(Optional *ErrorAdmin) -> (!SymbolType, !Specials, !*TypeHeaps, !Optional *ErrorAdmin) arrayFunOffsetToPD_IndexTable :: !w:{# MemberDef} !v:{# PredefinedSymbol} -> (!{# Index}, !x:{#MemberDef}, !v:{#PredefinedSymbol}) , [w<=x] diff --git a/frontend/check.icl b/frontend/check.icl index bdbb68b..0b2ce97 100644 --- a/frontend/check.icl +++ b/frontend/check.icl @@ -79,7 +79,7 @@ where 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) - # (special_type, hp_type_heaps) = substitute_type ft_type subst heaps.hp_type_heaps + # (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 ft_type = { special_type & st_context = [] } (new_info_ptr, hp_var_heap) = newPtr VI_Empty heaps.hp_var_heap @@ -87,11 +87,11 @@ checkSpecial mod_index fun_type=:{ft_type} fun_index subst (next_inst_index, spe ((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)) where - substitute_type st=:{st_vars,st_attr_vars,st_args,st_result,st_context,st_attr_env} environment type_heaps - # (st_vars, st_attr_vars, [st_result : st_args], st_context, st_attr_env, _, type_heaps) - = instantiateTypes st_vars st_attr_vars [ st_result : st_args ] st_context st_attr_env environment [] type_heaps + 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) + = instantiateTypes st_vars st_attr_vars [ st_result : st_args ] st_context st_attr_env environment [] type_heaps (Yes error) = ({st & st_vars = st_vars, st_args = st_args, st_result = st_result, st_attr_vars = st_attr_vars, - st_context = st_context, st_attr_env = st_attr_env }, type_heaps) + st_context = st_context, st_attr_env = st_attr_env }, type_heaps, error) checkDclFunctions :: !Index !Index ![FunType] !v:{#CheckedTypeDef} !x:{#ClassDef} !v:{#.DclModule} !*Heaps !*CheckState -> (!Index, ![FunType], ![FunType], !v:{#CheckedTypeDef}, !x:{#ClassDef}, !v:{#DclModule}, !*Heaps, !*CheckState) @@ -356,18 +356,18 @@ where checkInstances :: !Index !*CommonDefs !u:{# DclModule} !*VarHeap !*TypeHeaps !*CheckState -> (![(Index,SymbolType)], !*CommonDefs, !u:{# DclModule}, !*VarHeap , !*TypeHeaps, !*CheckState) -checkInstances mod_index icl_common=:{com_instance_defs,com_class_defs,com_member_defs,/*AA*/com_generic_defs} modules var_heap type_heaps cs=:{cs_error} +checkInstances mod_index icl_common=:{com_instance_defs,com_class_defs,com_member_defs,com_generic_defs,com_type_defs} modules var_heap type_heaps cs=:{cs_error} | cs_error.ea_ok - # (instance_types, com_instance_defs, com_class_defs, com_member_defs, com_generic_defs, modules, var_heap, type_heaps, cs) - = check_instances 0 mod_index [] com_instance_defs com_class_defs com_member_defs /*AA*/com_generic_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 }, + # (instance_types, com_instance_defs, com_class_defs, com_member_defs, com_generic_defs, com_type_defs, modules, var_heap, type_heaps, cs) + = check_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 }, modules, var_heap, type_heaps, cs) = ([], icl_common, modules, var_heap, type_heaps, cs) where - check_instances :: !Index !Index ![(Index,SymbolType)] !x:{# ClassInstance} !w:{# ClassDef} !v:{# MemberDef} /*AA*/!w:{# GenericDef} !u:{# DclModule} + check_instances :: !Index !Index ![(Index,SymbolType)] !x:{# ClassInstance} !w:{# ClassDef} !v:{# MemberDef} /*AA*/!w:{# GenericDef} !nerd:{# CheckedTypeDef} !u:{# DclModule} !*VarHeap !*TypeHeaps !*CheckState - -> (![(Index,SymbolType)], !x:{# ClassInstance}, !w:{# ClassDef}, !v:{# MemberDef}, /*AA*/!w:{# GenericDef}, !u:{# DclModule}, !*VarHeap, !*TypeHeaps, !*CheckState) - check_instances inst_index mod_index instance_types instance_defs class_defs member_defs generic_defs modules var_heap type_heaps cs + -> (![(Index,SymbolType)], !x:{# ClassInstance}, !w:{# ClassDef}, !v:{# MemberDef}, /*AA*/!w:{# GenericDef}, !nerd:{# CheckedTypeDef}, !u:{# DclModule}, !*VarHeap, !*TypeHeaps, !*CheckState) + check_instances inst_index mod_index instance_types instance_defs class_defs member_defs generic_defs type_defs modules var_heap type_heaps cs /* | inst_index < size instance_defs # ({ins_class,ins_members,ins_type, /*AA*/ins_generic}, instance_defs) = instance_defs![inst_index] @@ -383,63 +383,65 @@ where */ // AA.. | inst_index < size instance_defs - # (instance_def=:{ins_is_generic}, instance_defs) = instance_defs![inst_index] - # (instance_types, class_defs, member_defs, generic_defs, modules, var_heap, type_heaps, cs) = + # (instance_def=:{ins_ident,ins_is_generic, ins_pos}, instance_defs) = instance_defs![inst_index] + # (instance_types, class_defs, member_defs, generic_defs, type_defs, modules, var_heap, type_heaps, cs) = (if ins_is_generic check_generic_instance check_class_instance) - instance_def mod_index instance_types class_defs member_defs generic_defs modules var_heap type_heaps cs - = check_instances (inc inst_index) mod_index instance_types instance_defs class_defs member_defs generic_defs modules var_heap type_heaps cs + instance_def mod_index instance_types class_defs member_defs generic_defs type_defs modules var_heap type_heaps cs + = check_instances (inc inst_index) mod_index instance_types instance_defs class_defs member_defs generic_defs type_defs modules var_heap type_heaps cs // otherwise - = (instance_types, instance_defs, class_defs, member_defs, generic_defs, modules, var_heap, type_heaps, cs) + = (instance_types, instance_defs, class_defs, member_defs, generic_defs, type_defs, modules, var_heap, type_heaps, cs) - check_class_instance {ins_class,ins_members,ins_type} mod_index instance_types class_defs member_defs generic_defs modules var_heap type_heaps cs + check_class_instance {ins_pos,ins_class,ins_members,ins_type} mod_index instance_types class_defs member_defs generic_defs type_defs modules var_heap type_heaps cs # ({class_members,class_name}, class_defs, modules) = getClassDef ins_class mod_index class_defs modules class_size = size class_members | class_size == size ins_members - # (instance_types, member_defs, modules, var_heap, type_heaps, cs) = check_member_instances mod_index ins_class.glob_module - 0 class_size ins_members class_members ins_type instance_types member_defs modules var_heap type_heaps cs - = (instance_types, class_defs, member_defs, generic_defs, modules, var_heap, type_heaps, cs) + # (instance_types, member_defs, type_defs, modules, var_heap, type_heaps, cs) + = check_member_instances mod_index ins_class.glob_module + 0 class_size ins_members class_members class_name ins_pos ins_type instance_types member_defs type_defs modules var_heap type_heaps cs + = (instance_types, class_defs, member_defs, generic_defs, type_defs, modules, var_heap, type_heaps, cs) // otherwise # cs = { cs & cs_error = checkError class_name "different number of members specified" cs.cs_error } - = (instance_types, class_defs, member_defs, generic_defs, modules, var_heap, type_heaps, cs) + = (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 modules var_heap type_heaps cs + check_generic_instance {ins_class, ins_members, ins_generate} mod_index instance_types class_defs member_defs generic_defs type_defs modules var_heap type_heaps cs # ({gen_name, gen_member_name}, generic_defs, modules) = getGenericDef ins_class mod_index generic_defs modules | ins_generate - = (instance_types, class_defs, member_defs, generic_defs, modules, var_heap, type_heaps, cs) + = (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_name "generic instance must have one memeber" cs.cs_error } - = (instance_types, class_defs, member_defs, generic_defs, modules, var_heap, type_heaps, cs) + = (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_name # cs = { cs & cs_error = checkError member_name "wrong member name" cs.cs_error } - = (instance_types, class_defs, member_defs, generic_defs, modules, var_heap, type_heaps, cs) + = (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, modules, var_heap, type_heaps, cs) + = (instance_types, class_defs, member_defs, generic_defs, type_defs, modules, var_heap, type_heaps, cs) // ..AA - check_member_instances :: !Index !Index !Int !Int !{#DefinedSymbol} !{#DefinedSymbol} !InstanceType ![(Index,SymbolType)] - !v:{# MemberDef} !u:{# DclModule} !*VarHeap !*TypeHeaps !*CheckState - -> (![(Index,SymbolType)], !v:{# MemberDef}, !u:{# DclModule},!*VarHeap, !*TypeHeaps, !*CheckState) + check_member_instances :: !Index !Index !Int !Int !{#DefinedSymbol} !{#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) check_member_instances module_index member_mod_index mem_offset class_size ins_members class_members - ins_type instance_types member_defs modules var_heap type_heaps cs + class_name ins_pos ins_type instance_types member_defs type_defs modules var_heap type_heaps cs=:{cs_x={x_main_dcl_module_n}} | mem_offset == class_size - = (instance_types, member_defs, modules, var_heap, type_heaps, cs) + = (instance_types, member_defs, type_defs, modules, var_heap, type_heaps, cs) # ins_member = ins_members.[mem_offset] class_member = class_members.[mem_offset] | ins_member.ds_ident <> class_member.ds_ident - = check_member_instances module_index member_mod_index (inc mem_offset) class_size ins_members class_members ins_type - instance_types member_defs modules var_heap type_heaps + = check_member_instances module_index member_mod_index (inc mem_offset) class_size ins_members class_members class_name ins_pos ins_type + instance_types member_defs type_defs modules var_heap type_heaps { cs & cs_error = checkError class_member.ds_ident "instance of class member expected" cs.cs_error} | ins_member.ds_arity <> class_member.ds_arity - = check_member_instances module_index member_mod_index (inc mem_offset) class_size ins_members class_members ins_type - instance_types member_defs modules var_heap type_heaps + = check_member_instances module_index member_mod_index (inc mem_offset) class_size ins_members class_members class_name ins_pos ins_type + instance_types member_defs type_defs modules var_heap type_heaps { cs & cs_error = checkError class_member.ds_ident "used with wrong arity" cs.cs_error} # ({me_type,me_class_vars}, member_defs, modules) = getMemberDef member_mod_index class_member.ds_index module_index member_defs modules - (instance_type, _, type_heaps) = determineTypeOfMemberInstance me_type me_class_vars ins_type SP_None type_heaps + (instance_type, _, type_heaps, Yes cs_error) = determineTypeOfMemberInstance me_type me_class_vars ins_type SP_None type_heaps (Yes cs.cs_error) + (type_defs, modules, cs_error) = checkTopLevelKinds x_main_dcl_module_n True ins_pos class_name instance_type type_defs modules cs_error (st_context, var_heap) = initializeContextVariables instance_type.st_context var_heap - = check_member_instances module_index member_mod_index (inc mem_offset) class_size ins_members class_members ins_type - [ (ins_member.ds_index, { instance_type & st_context = st_context }) : instance_types ] member_defs modules var_heap type_heaps cs + = check_member_instances module_index member_mod_index (inc mem_offset) class_size ins_members class_members class_name ins_pos ins_type + [ (ins_member.ds_index, { instance_type & st_context = st_context }) : instance_types ] member_defs type_defs modules var_heap type_heaps { cs & cs_error = cs_error } getClassDef :: !(Global DefinedSymbol) !Int !u:{#ClassDef} !v:{#DclModule} -> (!ClassDef,!u:{#ClassDef},!v:{#DclModule}) @@ -468,27 +470,34 @@ getGenericDef {glob_module, glob_object={ds_ident, ds_index}} mod_index generic_ = (dcl_mod.dcl_common.com_generic_defs.[ds_index], generic_defs, modules) // ..AA -instantiateTypes :: ![TypeVar] ![AttributeVar] !types ![TypeContext] ![AttrInequality] !SpecialSubstitution ![SpecialSubstitution] !*TypeHeaps - -> (![TypeVar], ![AttributeVar], !types , ![TypeContext], ![AttrInequality], ![SpecialSubstitution], !*TypeHeaps) | substitute types -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} +instantiateTypes :: ![TypeVar] ![AttributeVar] !types ![TypeContext] ![AttrInequality] !SpecialSubstitution ![SpecialSubstitution] !*TypeHeaps !(Optional *ErrorAdmin) + -> (![TypeVar], ![AttributeVar], !types , ![TypeContext], ![AttrInequality], ![SpecialSubstitution], !*TypeHeaps, !(Optional *ErrorAdmin)) | substitute types +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} opt_error # th_vars = clear_vars old_type_vars th_vars (new_type_vars, th_vars) = foldSt build_var_subst ss_vars ([], th_vars) (new_attr_vars, th_attrs) = foldSt build_attr_subst ss_attrs ([], th_attrs) type_heaps = foldSt build_type_subst ss_environ { type_heaps & th_vars = th_vars, th_attrs = th_attrs } - (new_ss_context, type_heaps) = substitute ss_context type_heaps + (ok1, new_ss_context, type_heaps) = substitute ss_context type_heaps (inst_vars, th_vars) = foldSt determine_free_var old_type_vars (new_type_vars, type_heaps.th_vars) (inst_attr_vars, th_attrs) = foldSt build_attr_subst old_attr_vars (new_attr_vars, type_heaps.th_attrs) - (inst_types, type_heaps) = substitute types { type_heaps & th_vars = th_vars, th_attrs = th_attrs } - (inst_contexts, type_heaps) = substitute type_contexts type_heaps - (inst_attr_env, type_heaps) = substitute attr_env type_heaps - + (ok2, inst_types, type_heaps) = substitute types { type_heaps & th_vars = th_vars, th_attrs = th_attrs } + (ok3, inst_contexts, type_heaps) = substitute type_contexts type_heaps + (ok4, inst_attr_env, type_heaps) = substitute attr_env type_heaps (special_subst_list, th_vars) = mapSt adjust_special_subst special_subst_list type_heaps.th_vars - - = (inst_vars, inst_attr_vars, inst_types, inst_contexts ++ new_ss_context, inst_attr_env, special_subst_list, { type_heaps & th_vars = th_vars }) + + opt_error = case ok1 && ok2 && ok3 && ok4 of + True -> opt_error + _ -> case opt_error of + No -> No + Yes error_admin + -> Yes (checkError "" "instance type incompatible with class type" + error_admin) + // e.g.:class c a :: (a Int); instance c Real + = (inst_vars, inst_attr_vars, inst_types, inst_contexts ++ new_ss_context, inst_attr_env, special_subst_list, { type_heaps & th_vars = th_vars }, opt_error) where clear_vars type_vars type_var_heap = foldSt (\tv -> writePtr tv.tv_info_ptr TVI_Empty) type_vars type_var_heap @@ -501,7 +510,7 @@ where -> (free_vars, type_var_heap) build_type_subst {bind_src,bind_dst} type_heaps - # (bind_src, type_heaps) = substitute bind_src type_heaps + # (_, bind_src, type_heaps) = substitute bind_src type_heaps = { type_heaps & th_vars = writePtr bind_dst.tv_info_ptr (TVI_Type bind_src) type_heaps.th_vars} build_var_subst var (free_vars, type_var_heap) @@ -522,11 +531,11 @@ where # (TVI_Type (TV new_tv), type_var_heap) = readPtr tv_info_ptr type_var_heap = ({ bind & bind_dst = new_tv }, type_var_heap) -substituteInstanceType :: !InstanceType !SpecialSubstitution !*TypeHeaps -> (!InstanceType,!*TypeHeaps) -substituteInstanceType it=:{it_vars,it_attr_vars,it_types,it_context} environment type_heaps - # (it_vars, it_attr_vars, it_types, it_context, _, _, type_heaps) - = instantiateTypes it_vars it_attr_vars it_types it_context [] environment [] type_heaps - = ({it & it_vars = it_vars, it_types = it_types, it_attr_vars = it_attr_vars, it_context = it_context }, type_heaps) +substituteInstanceType :: !InstanceType !SpecialSubstitution !*TypeHeaps !*ErrorAdmin -> (!InstanceType,!*TypeHeaps,!.ErrorAdmin) +substituteInstanceType it=:{it_vars,it_attr_vars,it_types,it_context} environment type_heaps cs_error + # (it_vars, it_attr_vars, it_types, it_context, _, _, type_heaps, Yes cs_error) + = 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 @@ -535,79 +544,85 @@ hasTypeVariables [TV tvar : types] hasTypeVariables [ _ : types] = hasTypeVariables types -determineTypeOfMemberInstance :: !SymbolType ![TypeVar] !InstanceType !Specials !*TypeHeaps -> (!SymbolType, !Specials, !*TypeHeaps) -determineTypeOfMemberInstance mem_st class_vars {it_types,it_vars,it_attr_vars,it_context} specials type_heaps +determineTypeOfMemberInstance :: !SymbolType ![TypeVar] !InstanceType !Specials !*TypeHeaps !(Optional *ErrorAdmin) + -> (!SymbolType, !Specials, !*TypeHeaps, !Optional *ErrorAdmin) +determineTypeOfMemberInstance mem_st class_vars {it_types,it_vars,it_attr_vars,it_context} specials type_heaps opt_error # env = { ss_environ = foldl2 (\binds var type -> [ {bind_src = type, bind_dst = var} : binds]) [] class_vars it_types, ss_context = it_context, ss_vars = it_vars, ss_attrs = it_attr_vars} - = determine_type_of_member_instance mem_st env specials type_heaps + (st, specials, type_heaps, opt_error) + = determine_type_of_member_instance mem_st env specials type_heaps opt_error + = (st, specials, type_heaps, opt_error) where - determine_type_of_member_instance mem_st=:{st_context} env (SP_Substitutions substs) type_heaps - # (mem_st, substs, type_heaps) = substitute_symbol_type { mem_st & st_context = tl st_context } env substs type_heaps - = (mem_st, SP_Substitutions substs, type_heaps) - determine_type_of_member_instance mem_st=:{st_context} env SP_None type_heaps - # (mem_st, _, type_heaps) = substitute_symbol_type { mem_st & st_context = tl st_context } env [] type_heaps - = (mem_st, SP_None, type_heaps) - - substitute_symbol_type st=:{st_vars,st_attr_vars,st_args,st_result,st_context,st_attr_env} environment specials type_heaps - # (st_vars, st_attr_vars, [st_result : st_args], st_context, st_attr_env, specials, type_heaps) - = instantiateTypes st_vars st_attr_vars [ st_result : st_args ] st_context st_attr_env environment specials type_heaps + determine_type_of_member_instance mem_st=:{st_context} env (SP_Substitutions substs) type_heaps opt_error + # (mem_st, substs, type_heaps, opt_error) + = substitute_symbol_type { mem_st & st_context = tl st_context } env substs type_heaps opt_error + = (mem_st, SP_Substitutions substs, type_heaps, opt_error) + determine_type_of_member_instance mem_st=:{st_context} env SP_None type_heaps opt_error + # (mem_st, _, type_heaps, opt_error) + = substitute_symbol_type { mem_st & st_context = tl st_context } env [] type_heaps opt_error + = (mem_st, SP_None, type_heaps, opt_error) + + substitute_symbol_type st=:{st_vars,st_attr_vars,st_args,st_result,st_context,st_attr_env} environment specials type_heaps opt_error + # (st_vars, st_attr_vars, [st_result : st_args], st_context, st_attr_env, specials, type_heaps, opt_error) + = instantiateTypes st_vars st_attr_vars [ st_result : st_args ] st_context st_attr_env environment specials type_heaps opt_error = ({st & st_vars = st_vars, st_args = st_args, st_result = st_result, st_attr_vars = st_attr_vars, - st_context = st_context, st_attr_env = st_attr_env }, specials, type_heaps) + st_context = st_context, st_attr_env = st_attr_env }, specials, type_heaps, opt_error) determineTypesOfInstances :: !Index !Index !*{#ClassInstance} !*{# ClassDef} !*{# MemberDef} !*{#DclModule} !*TypeHeaps !*VarHeap !*CheckState -> (![FunType], !Index, ![ClassInstance], !*{#ClassInstance}, !*{# ClassDef}, !*{# MemberDef}, !*{#DclModule}, !*TypeHeaps, !*VarHeap, !*CheckState) determineTypesOfInstances first_memb_inst_index mod_index com_instance_defs com_class_defs com_member_defs - modules type_heaps var_heap cs=:{cs_error} + modules type_heaps var_heap cs=:{cs_error, 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, modules, com_instance_defs, type_heaps, var_heap, cs_error) - = determine_types_of_instances 0 nr_of_class_instances first_memb_inst_index mod_index [] com_class_defs com_member_defs + = 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 modules com_instance_defs type_heaps var_heap cs_error = (memb_inst_defs, next_mem_inst_index, all_class_specials, com_instance_defs, com_class_defs, com_member_defs, modules, type_heaps, var_heap, { cs & cs_error = cs_error }) = ([], first_memb_inst_index, [], com_instance_defs, com_class_defs, com_member_defs, modules, type_heaps, var_heap, cs) where - determine_types_of_instances :: !Index !Index !Index !Index ![ClassInstance] !v:{#ClassDef} !w:{#MemberDef} + determine_types_of_instances :: !Index !Index !Index !Index !Index ![ClassInstance] !v:{#ClassDef} !w:{#MemberDef} !x:{#DclModule} !*{#ClassInstance} !*TypeHeaps !*VarHeap !*ErrorAdmin -> (![FunType], !Index, ![ClassInstance], !v:{#ClassDef}, !w:{#MemberDef}, !x:{#DclModule}, !*{#ClassInstance}, !*TypeHeaps, !*VarHeap, !*ErrorAdmin) - determine_types_of_instances inst_index next_class_inst_index next_mem_inst_index mod_index all_class_specials + 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 modules instance_defs type_heaps var_heap error | inst_index < size instance_defs # (instance_def, instance_defs) = instance_defs![inst_index] # {ins_class,ins_pos,ins_type,ins_specials} = instance_def - ({class_members}, class_defs, modules) = getClassDef ins_class mod_index class_defs modules + ({class_name, class_members}, class_defs, modules) = getClassDef ins_class mod_index class_defs modules class_size = size class_members - (ins_members, memb_inst_defs1, member_defs, modules, type_heaps, var_heap) - = determine_instance_symbols_and_types next_mem_inst_index 0 mod_index ins_class.glob_module class_size class_members - ins_type ins_specials ins_pos member_defs modules type_heaps var_heap + (ins_members, memb_inst_defs1, member_defs, modules, type_heaps, var_heap, error) + = 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, modules, instance_defs, type_heaps, var_heap, error) - = determine_types_of_instances (inc inst_index) next_class_inst_index (next_mem_inst_index + class_size) mod_index all_class_specials + = 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 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, modules, instance_defs, type_heaps, var_heap, error) = ([], next_mem_inst_index, all_class_specials, class_defs, member_defs, modules, instance_defs, type_heaps, var_heap, error) - determine_instance_symbols_and_types :: !Index !Index !Index !Index !Int !{#DefinedSymbol} !InstanceType !Specials !Position - !w:{#MemberDef} !u:{#DclModule} !*TypeHeaps !*VarHeap - -> (![DefinedSymbol], ![FunType], !w:{#MemberDef}, !u:{#DclModule}, !*TypeHeaps, !*VarHeap) - determine_instance_symbols_and_types first_inst_index mem_offset module_index member_mod_index class_size class_members - ins_type ins_specials ins_pos member_defs modules type_heaps var_heap + determine_instance_symbols_and_types :: !Index !Index !Index !Index !Index !Int !{#DefinedSymbol} !InstanceType !Specials Ident !Position + !w:{#MemberDef} !u:{#DclModule} !*TypeHeaps !*VarHeap !*ErrorAdmin + -> (![DefinedSymbol], ![FunType], !w:{#MemberDef}, !u:{#DclModule}, !*TypeHeaps, !*VarHeap, !.ErrorAdmin) + determine_instance_symbols_and_types x_main_dcl_module_n first_inst_index mem_offset module_index member_mod_index class_size class_members + ins_type ins_specials class_name ins_pos member_defs modules type_heaps var_heap cs_error | mem_offset == class_size - = ([], [], member_defs, modules, type_heaps, var_heap) + = ([], [], member_defs, modules, type_heaps, var_heap, cs_error) # class_member = class_members.[mem_offset] ({me_symb,me_type,me_priority,me_class_vars}, member_defs, modules) = getMemberDef member_mod_index class_member.ds_index module_index member_defs modules - (instance_type, new_ins_specials, type_heaps) = determineTypeOfMemberInstance me_type me_class_vars ins_type ins_specials type_heaps + (instance_type, new_ins_specials, type_heaps, Yes cs_error) = determineTypeOfMemberInstance me_type me_class_vars ins_type ins_specials type_heaps (Yes cs_error) + (_, modules, cs_error) = checkTopLevelKinds x_main_dcl_module_n False ins_pos class_name instance_type cDummyArray modules cs_error (new_info_ptr, var_heap) = newPtr VI_Empty var_heap inst_def = MakeNewFunctionType me_symb me_type.st_arity me_priority instance_type ins_pos new_ins_specials new_info_ptr - (inst_symbols, memb_inst_defs, member_defs, modules, type_heaps, var_heap) - = determine_instance_symbols_and_types first_inst_index (inc mem_offset) module_index member_mod_index - class_size class_members ins_type ins_specials ins_pos member_defs modules type_heaps var_heap - = ([{ class_member & ds_index = first_inst_index + mem_offset } : inst_symbols], [inst_def : memb_inst_defs], member_defs, modules, type_heaps, var_heap) + (inst_symbols, memb_inst_defs, member_defs, modules, type_heaps, var_heap, cs_error) + = determine_instance_symbols_and_types x_main_dcl_module_n first_inst_index (inc mem_offset) module_index member_mod_index + 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) @@ -617,7 +632,7 @@ where = (SP_ContextTypes list_of_specials, next_inst_index, all_instances, type_heaps, error) where check_specials mod_index inst=:{ins_type} type_offset [ subst : substs ] list_of_specials next_inst_index all_instances type_heaps error - # (special_type, type_heaps) = substituteInstanceType ins_type subst type_heaps + # (special_type, type_heaps, error) = substituteInstanceType ins_type subst type_heaps error (spec_types, error) = checkAndCollectTypesOfContexts special_type.it_context 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 } @@ -638,6 +653,43 @@ where = (tc_types, error) +checkTopLevelKinds :: !Index !Bool !Position Ident !SymbolType n:{# CheckedTypeDef} !r:{# DclModule} !*ErrorAdmin + -> (!n:{# CheckedTypeDef}, !r:{# DclModule}, !*ErrorAdmin) +checkTopLevelKinds x_main_dcl_module_n is_icl_module ins_pos class_ident st=:{st_args, st_result} type_defs modules cs_error + #! ok = all (\{at_type} -> kind_is_ok x_main_dcl_module_n is_icl_module type_defs modules 0 at_type) [st_result:st_args] + # cs_error + = case ok of + True + -> cs_error + _ + # cs_error + = pushErrorAdmin (newPosition class_ident ins_pos) cs_error + cs_error + = checkError "" "instance types have wrong kind" cs_error + -> popErrorAdmin cs_error + = (type_defs, modules, cs_error) + where + kind_is_ok x_main_dcl_module_n is_icl_module type_defs modules demanded_kind type=:(TA {type_index={glob_object,glob_module}} args) + # {td_arity} + = if (glob_module==x_main_dcl_module_n && is_icl_module) type_defs.[glob_object] + modules.[glob_module].dcl_common.com_type_defs.[glob_object] + = demanded_kind == td_arity-length args + kind_is_ok _ _ _ modules 0 (_ --> _) + = True + kind_is_ok _ _ _ modules _ (_ :@: _) + = True + kind_is_ok _ _ _ _ 0 (TB _) + = True + kind_is_ok _ _ _ _ _ (GTV _) + = True + kind_is_ok _ _ _ _ _ (TV _) + = True + kind_is_ok _ _ _ _ _ (TQV _) + = True + kind_is_ok _ _ _ _ _ _ + = False + + consOptional (Yes thing) things = [ thing : things] @@ -2676,182 +2728,3 @@ possibly_write_expl_imports_of_main_dcl_mod_to_file imports_ikh dcl_modules cs Yes {si_explicit} -> writeExplImportsToFile "dcl.txt" si_explicit dcl_modules cs -write_expl_imports_to_file file_name si_explicit dcl_modules cs - | switch_port_to_new_syntax False True - = abort "write_expl_imports_to_file is only used for portToNewSyntax" - # (file, cs) - = openFile file_name cs - (dcl_modules, file) - = foldSt (write_expl_import (flatten (map fst si_explicit))) (reverse si_explicit) (dcl_modules, file) - = (dcl_modules, closeFile file cs) - -write_expl_import all_expl_imp_decls (declarations, _) (dcl_modules, file) - # (declaration_strings, dcl_modules) - = mapFilterYesSt (decl_to_opt_string all_expl_imp_decls) (reverse declarations) dcl_modules - = (dcl_modules, fwriteNewSyntax declaration_strings file) - -// only for portToNewSyntax -decl_to_opt_string all_expl_imp_decls decl=:{dcl_ident, dcl_index, dcl_kind=STE_Imported ste_kind def_mod_index} - dcl_modules - = imported_decl_to_opt_string all_expl_imp_decls dcl_ident dcl_index ste_kind def_mod_index - dcl_modules -decl_to_opt_string _ {dcl_ident, dcl_kind=STE_FunctionOrMacro _} dcl_modules - = (Yes dcl_ident.id_name, dcl_modules) -decl_to_opt_string all_expl_imp_decls decl dcl_modules - = abort ("decl_to_opt_string failed"--->decl) - -// only for portToNewSyntax -imported_decl_to_opt_string all_expl_imp_decls dcl_ident dcl_index STE_Constructor def_mod_index - dcl_modules - = (No, dcl_modules) -imported_decl_to_opt_string all_expl_imp_decls dcl_ident dcl_index STE_Member def_mod_index - dcl_modules - = (No, dcl_modules) -imported_decl_to_opt_string all_expl_imp_decls dcl_ident dcl_index STE_DclFunction def_mod_index - dcl_modules - = (Yes dcl_ident.id_name, dcl_modules) -imported_decl_to_opt_string all_expl_imp_decls dcl_ident dcl_index STE_Class def_mod_index - dcl_modules - = (Yes ("class "+++dcl_ident.id_name+++"(..)"), dcl_modules) -// AA.. -imported_decl_to_opt_string all_expl_imp_decls dcl_ident dcl_index STE_Generic def_mod_index - dcl_modules - = (Yes ("generic "+++dcl_ident.id_name+++"(..)"), dcl_modules) -// ..AA -imported_decl_to_opt_string all_expl_imp_decls dcl_ident dcl_index (STE_Instance _) def_mod_index - dcl_modules - # ({ins_type}, dcl_modules) - = dcl_modules![def_mod_index].dcl_common.com_instance_defs.[dcl_index] - = (Yes ("instance "+++dcl_ident.id_name+++" "+++ - separated " " (map type_to_string ins_type.it_types)), dcl_modules) -imported_decl_to_opt_string all_expl_imp_decls dcl_ident dcl_index STE_Type def_mod_index - dcl_modules - # ({td_rhs}, dcl_modules) - = dcl_modules![def_mod_index].dcl_common.com_type_defs.[dcl_index] - dcl_string - = ":: "+++(case td_rhs of - AlgType constructors - -> dcl_ident.id_name+++constructor_bracket def_mod_index all_expl_imp_decls constructors - RecordType _ - -> dcl_ident.id_name+++"{..}" - _ - -> dcl_ident.id_name) - = (Yes dcl_string, dcl_modules) - -// only for portToNewSyntax -type_to_string (TA {type_name} _) = possibly_replace_predef_symbols type_name.id_name -type_to_string (TB type) = toString type -type_to_string (TV {tv_name}) = tv_name.id_name -type_to_string x = abort ("bug nr 945 in module check"--->x) - -possibly_replace_predef_symbols s - | s=="_list" - = "[]" - | s % (0,5) == "_tuple" - = (toString ['(':repeatn ((toInt (s%(6, (size s) - 1))) - 1) ','])+++")" - | s=="_array" - = "{}" - | s=="_!array" - = "{!}" - | s=="_#array" - = "{#}" - = s - -instance toString BasicType - where - toString BT_Int = "Int" - toString BT_Char = "Char" - toString BT_Real = "Real" - toString BT_Bool = "Bool" - toString BT_Dynamic = "Dynamic" - toString BT_File = "File" - toString BT_World = "World" - toString _ = abort "bug nr 346 in module check" - -// only for portToNewSyntax -separated _ [] - = "" -separated separator [h:t] - = foldl (\l r->l+++separator+++r) h t - -constructor_bracket def_mod_index all_expl_imp_decls constructors - # expl_imp_constructor_strings - = [ ds_ident.id_name \\ {ds_ident} <- constructors - | is_expl_imported_constructor def_mod_index ds_ident all_expl_imp_decls ] - | isEmpty expl_imp_constructor_strings - = "" - = "("+++separated "," expl_imp_constructor_strings+++")" - -// only for portToNewSyntax -is_expl_imported_constructor def_mod_index ds_ident [] - = False -is_expl_imported_constructor def_mod_index ds_ident [{dcl_ident, dcl_kind=STE_Imported STE_Constructor def_mod_index2}:_] - | dcl_ident==ds_ident && def_mod_index==def_mod_index2 - = True - // GOTO next alternative -is_expl_imported_constructor def_mod_index ds_ident [h:t] - = is_expl_imported_constructor def_mod_index ds_ident t - -fwriteNewSyntax importStrings file - | isEmpty importStrings - = fwrites "import @#$@@!!" file - # with_commas = (map (\s->s+++", ") (butLast importStrings))++[last importStrings+++";"] - lines = split_in_lines 12 with_commas [] [] - lines = [hd lines:[["\t":line]\\ line<-tl lines]] - line_strings = [ foldl (+++) " " (line++["\n"]) \\ line<-lines ] - = fwrites (foldl (+++) "import" line_strings) file - where - max_line_length = 80 - split_in_lines i [] inner_accu outer_accu - # accu = if (isEmpty inner_accu) outer_accu [reverse inner_accu:outer_accu] - = reverse accu - split_in_lines i [h:t] inner_accu outer_accu - # s = size h - | s+i>max_line_length - | isEmpty inner_accu - = split_in_lines (s+i) t [h] outer_accu - = split_in_lines (s+cTabWidth) t [h] [inner_accu:outer_accu] - = split_in_lines (s+i) t [h:inner_accu] outer_accu -// only for portToNewSyntax - -butLast [] = [] -butLast [x] = [] -butLast [h:t] = [h: butLast t] - -// MW: fake.. -openFile file_name cs - # world = bigBang - (ok, newFile, world) = fopen file_name FWriteText world - cs = forget world cs - cs = case ok of - True -> cs - _ # cs_error = checkError "" ("can't open file \""+++file_name+++" in current directory.") cs.cs_error - -> { cs & cs_error=cs_error } - = (newFile, cs) - -closeFile file cs - # world = bigBang - (ok, world) = fclose file world - = forget world cs - -bigBang :: .World -bigBang = cast 1 -// creates a world from scratch - -forget :: !.x !.y -> .y -forget x y = y - -cast :: !.a -> .b -cast a - = code - { - pop_a 0 - } -// ..fake -// END only for portToNewSyntax -// END only for portToNewSyntax -// END only for portToNewSyntax -// END only for portToNewSyntax -// END only for portToNewSyntax -// END only for portToNewSyntax -// END only for portToNewSyntax diff --git a/frontend/checktypes.icl b/frontend/checktypes.icl index cfa64cf..844a04a 100644 --- a/frontend/checktypes.icl +++ b/frontend/checktypes.icl @@ -29,7 +29,8 @@ instance bindTypes AType where bindTypes cti atype=:{at_attribute,at_type} ts_ti_cs # (at_type, type_attr, (ts, ti, cs)) = bindTypes cti at_type ts_ti_cs - (combined_attribute, cs_error) = check_type_attribute at_attribute type_attr cti.cti_lhs_attribute cs.cs_error + cs_error = check_attr_of_type_var at_attribute at_type cs.cs_error + (combined_attribute, cs_error) = check_type_attribute at_attribute type_attr cti.cti_lhs_attribute cs_error = ({ atype & at_attribute = combined_attribute, at_type = at_type }, combined_attribute, (ts, ti, { cs & cs_error = cs_error })) where check_type_attribute :: !TypeAttribute !TypeAttribute !TypeAttribute !*ErrorAdmin -> (!TypeAttribute,!*ErrorAdmin) @@ -60,6 +61,13 @@ where try_to_combine_attributes _ _ = False + check_attr_of_type_var :: !TypeAttribute !Type !*ErrorAdmin -> .ErrorAdmin + check_attr_of_type_var TA_Unique (TV var) error + // the case "TA_Var" is catched by check_type_attribute + = checkError var "uniqueness attribute not allowed" error + check_attr_of_type_var attr _ error + = error + instance bindTypes TypeVar where bindTypes cti tv=:{tv_name=var_id=:{id_info}} (ts, ti, cs=:{cs_symbol_table /* TD ... */, cs_x={x_type_var_position,x_is_dcl_module} /* ... TD */ }) diff --git a/frontend/generics.icl b/frontend/generics.icl index 4e3fb21..ad7b2c0 100644 --- a/frontend/generics.icl +++ b/frontend/generics.icl @@ -802,8 +802,8 @@ determineMemberTypes module_index ins_index // determine type of the member instance - # (symbol_type, _, hp_type_heaps) = - determineTypeOfMemberInstance me_type me_class_vars ins_type SP_None hp_type_heaps + # (symbol_type, _, hp_type_heaps, _) = + determineTypeOfMemberInstance me_type me_class_vars ins_type SP_None hp_type_heaps No # (st_context, hp_var_heap) = initializeContextVariables symbol_type.st_context hp_var_heap # symbol_type = {symbol_type & st_context = st_context} @@ -946,8 +946,8 @@ buildMemberType generic_def=:{gen_name,gen_type,gen_args} kind class_var type_he #! (gen_type, type_heaps) = generate_member_type gen_type gen_args kind class_vars type_heaps // run the real susbstitution - #! (fresh_st_args, type_heaps) = substitute gen_type.st_args type_heaps - #! (fresh_st_result, type_heaps) = substitute gen_type.st_result type_heaps + #! (_, fresh_st_args, type_heaps) = substitute gen_type.st_args type_heaps + #! (_, fresh_st_result, type_heaps) = substitute gen_type.st_result type_heaps #! member_type = {gen_type & st_vars = gen_type.st_vars ++ fresh_st_vars, @@ -963,8 +963,8 @@ where gen_type gen_args kind class_vars type_heaps #! (gen_type_varss, type_heaps) = subst_generic_vars gen_args class_vars kind type_heaps - #! (fresh_st_args, type_heaps) = substitute gen_type.st_args type_heaps - #! (fresh_st_result, type_heaps) = substitute gen_type.st_result type_heaps + #! (_, fresh_st_args, type_heaps) = substitute gen_type.st_args type_heaps + #! (_, fresh_st_result, type_heaps) = substitute gen_type.st_result type_heaps #! gen_type_varss = transpose gen_type_varss #! (arg_types, type_heaps) = generate_args gen_type gen_args kind gen_type_varss type_heaps @@ -1738,10 +1738,10 @@ freshSymbolType postfix st type_heaps # (new_st_vars, type_heaps) = subst_type_vars postfix st_vars type_heaps # (new_st_attr_vars, type_heaps) = subst_attr_vars postfix st_attr_vars type_heaps - # (new_st_args, type_heaps) = substitute st_args type_heaps - # (new_st_result, type_heaps) = substitute st_result type_heaps - # (new_st_context, type_heaps) = substitute st_context type_heaps - # (new_st_attr_env, type_heaps) = substitute st_attr_env type_heaps + # (_, new_st_args, type_heaps) = substitute st_args type_heaps + # (_, new_st_result, type_heaps) = substitute st_result type_heaps + # (_, new_st_context, type_heaps) = substitute st_context type_heaps + # (_, new_st_attr_env, type_heaps) = substitute st_attr_env type_heaps # new_st = { st & st_vars = new_st_vars diff --git a/frontend/overloading.icl b/frontend/overloading.icl index 7f673b9..a81c1b9 100644 --- a/frontend/overloading.icl +++ b/frontend/overloading.icl @@ -339,7 +339,7 @@ where = mapSt fresh_context contexts heaps where fresh_context tc=:{tc_types} (var_heap, type_heaps) - # (tc_types, type_heaps) = substitute tc_types type_heaps + # (_, tc_types, type_heaps) = substitute tc_types type_heaps // (tc_var, var_heap) = newPtr VI_Empty var_heap // = ({ tc & tc_types = tc_types, tc_var = tc_var }, (var_heap, type_heaps)) = ({ tc & tc_types = tc_types }, (var_heap, type_heaps)) @@ -491,7 +491,7 @@ tryToExpandTypeSyn defs cons_id=:{type_name,type_index={glob_object,glob_module} expandTypeSyn td_attribute td_args type_args td_rhs type_heaps # type_heaps = bindTypeVarsAndAttributes td_attribute TA_Multi td_args type_args type_heaps - (expanded_type, type_heaps) = substitute td_rhs type_heaps + (_, expanded_type, type_heaps) = substitute td_rhs type_heaps = (expanded_type, clearBindingsOfTypeVarsAndAttributes td_attribute td_args type_heaps) class match type :: !{# CommonDefs} !type !type !*TypeHeaps -> (!Bool, !*TypeHeaps) @@ -647,7 +647,7 @@ where = type_var_heap <:= (tv_info_ptr, TVI_Type type) subst_context_and_generate_super_classes class_context (super_classes, type_heaps) - # (super_class, type_heaps) = substitute class_context type_heaps + # (_, super_class, type_heaps) = substitute class_context type_heaps | containsContext super_class super_classes = (super_classes, type_heaps) = generate_super_classes super_class ([super_class : super_classes], type_heaps) @@ -854,7 +854,7 @@ where # {tc_class={glob_object={ds_index},glob_module}} = tc2 {class_args,class_members,class_context,class_dictionary} = defs.[glob_module].com_class_defs.[ds_index] th_vars = foldr2 (\{tv_info_ptr} type -> writePtr tv_info_ptr (TVI_Type type)) th_vars class_args tc2.tc_types - (super_instances, type_heaps) = substitute class_context { type_heaps & th_vars = th_vars } + (_, super_instances, type_heaps) = substitute class_context { type_heaps & th_vars = th_vars } = find_super_instance tc1 super_instances (size class_members) address glob_module class_dictionary.ds_index defs type_heaps where find_super_instance :: !TypeContext ![TypeContext] !Index ![(Int, Global DefinedSymbol)] !Index !Index !{#CommonDefs} !*TypeHeaps diff --git a/frontend/syntax.dcl b/frontend/syntax.dcl index c9427dc..f186ef8 100644 --- a/frontend/syntax.dcl +++ b/frontend/syntax.dcl @@ -58,19 +58,10 @@ instance toString Ident | STE_DictCons !ConsDef | STE_DictField !SelectorDef | STE_Called ![Index] /* used during macro expansion to indicate that this function is called */ - | STE_ExplImp !Bool !(Optional ImportDeclaration) !STE_Kind !Bool /* auxiliary used in module explicitimports. */ - /* 1st arg: initialized with False and set to True when the searched symbol has been found to indicate. - 2nd arg: Yes: the ImportDeclaration with which it was intended to import the symbol. - No: for symbols within a bracket (fields, constructors, members) - 3rd arg: for error messages: the expected namespace of the intended imported symbol - 4th arg: at first the idents for _all_ fields, constructors & members are added to the symbol table. In - case of a selective import like "... import :: R {f1}" this bit is used to remove all - fields different from "f1" from the symbol table again. - */ | STE_ExplImpSymbol !Int | STE_ExplImpComponentNrs ![ComponentNrAndIndex] ![Declaration] /* stores the numbers of all module components that import the symbol from - the "actual" dcl module. Further for each class the all encountered + the "actual" dcl module. Further for each class all encountered instances are accumulated. */ | STE_BelongingSymbol !Int diff --git a/frontend/syntax.icl b/frontend/syntax.icl index 42f11f5..ad5d362 100644 --- a/frontend/syntax.icl +++ b/frontend/syntax.icl @@ -58,7 +58,6 @@ where toString {import_module} = toString import_module | STE_DictCons !ConsDef | STE_DictField !SelectorDef | STE_Called ![Index] /* used during macro expansion to indicate that this function is called */ - | STE_ExplImp !Bool !(Optional ImportDeclaration) !STE_Kind !Bool /* auxiliary used in module explicitimports. */ | STE_ExplImpSymbol !Int | STE_ExplImpComponentNrs ![ComponentNrAndIndex] ![Declaration] | STE_BelongingSymbol !Int diff --git a/frontend/trans.icl b/frontend/trans.icl index d683e36..d73e620 100644 --- a/frontend/trans.icl +++ b/frontend/trans.icl @@ -987,8 +987,8 @@ possibly_generate_case_function kees=:{case_info_ptr} aci=:{aci_free_vars} ro ti {th_vars,th_attrs} = ti.ti_type_heaps (type_variables, th_vars) = getTypeVars [ct_result_type:arg_types] th_vars (fresh_type_vars, th_vars) = mapSt bind_to_fresh_type_variable type_variables th_vars - (fresh_arg_types, ti_type_heaps) = substitute arg_types { th_vars = th_vars, th_attrs = th_attrs } - (fresh_result_type, ti_type_heaps) = substitute ct_result_type ti_type_heaps + (_, fresh_arg_types, ti_type_heaps) = substitute arg_types { th_vars = th_vars, th_attrs = th_attrs } + (_, fresh_result_type, ti_type_heaps) = substitute ct_result_type ti_type_heaps us = { us_var_heap = ti_var_heap, us_symbol_heap = ti_symbol_heap, us_opt_type_heaps = Yes ti_type_heaps, us_cleanup_info=ti.ti_cleanup_info } ui = {ui_handle_aci_free_vars = SubstituteThem, ui_convert_module_n= -1,ui_conversion_table=No } @@ -1315,7 +1315,7 @@ generateFunction fd=:{fun_body = TransformedBody {tb_args,tb_rhs},fun_info = {fi = foldSt bind_to_temp_attr_var st_attr_vars (FirstAttrVar, ti_type_heaps.th_attrs) ti_type_heaps = { ti_type_heaps & th_attrs = th_attrs, th_vars = th_vars } - ((st_args,st_result), ti_type_heaps) + (_, (st_args,st_result), ti_type_heaps) = substitute (st_args,st_result) ti_type_heaps (new_fun_args, new_arg_types_array, next_attr_nr, new_linear_bits, new_cons_args, uniqueness_requirements, subst, ti_type_heaps=:{th_vars, th_attrs}, @@ -1507,7 +1507,7 @@ where uniqueness_requirements, subst, type_heaps, symbol_heap, fun_defs, fun_heap, var_heap) # (arg_type, arg_types) = arg_types![prod_index] - (int_class_type, type_heaps) + (_, int_class_type, type_heaps) = substitute class_type type_heaps type_input = { ti_common_defs = ro.ro_common_defs @@ -1568,7 +1568,7 @@ where (next_attr_nr, th_attrs) = foldSt bind_to_temp_attr_var st_attr_vars (next_attr_nr, th_attrs) // prepare for substitute calls - ((st_args, st_result), type_heaps) + (_, (st_args, st_result), type_heaps) = substitute (st_args, st_result) { type_heaps & th_vars = th_vars, th_attrs = th_attrs } nr_of_applied_args = symbol.symb_arity @@ -1726,9 +1726,9 @@ where = mapSt bind_to_fresh_type_variable st_vars th_vars (fresh_st_attr_vars, th_attrs) = mapSt bind_to_fresh_attr_variable st_attr_vars th_attrs - ([fresh_st_result:fresh_st_args], ti_type_heaps) + (_, [fresh_st_result:fresh_st_args], ti_type_heaps) = substitute [st_result:st_args] { ti_type_heaps & th_vars = th_vars, th_attrs = th_attrs } - (fresh_st_attr_env, ti_type_heaps) + (_, fresh_st_attr_env, ti_type_heaps) = substitute st_attr_env ti_type_heaps = (Yes { symbol_type & st_vars = fresh_st_vars, st_attr_vars = fresh_st_attr_vars, st_args = fresh_st_args, st_result = fresh_st_result, st_attr_env = fresh_st_attr_env}, ti_type_heaps) @@ -1873,7 +1873,7 @@ where max_group_index_of_producer PR_Empty current_max fun_defs fun_heap cons_args = current_max max_group_index_of_producer (PR_Class {app_args} _ _) current_max fun_defs fun_heap cons_args - = max_group_index_of_members app_args current_max fun_defs fun_heap cons_args + = foldSt (foldrExprSt (max_group_index_of_member fun_defs fun_heap cons_args)) app_args current_max max_group_index_of_producer (PR_Curried {symb_kind=SK_Function {glob_object=fun_index, glob_module}}) current_max fun_defs fun_heap cons_args | glob_module<>ro_main_dcl_module_n = current_max @@ -1890,32 +1890,31 @@ where max_group_index_of_producer prod current_max fun_defs fun_heap cons_args = abort ("trans.icl: max_group_index_of_producer" ---> prod) ro_main_dcl_module_n = ro.ro_main_dcl_module_n - - max_group_index_of_member fun_defs fun_heap cons_args current_max + + max_group_index_of_member fun_defs fun_heap cons_args (App {app_symb = {symb_name, symb_kind = SK_Function { glob_object = fun_index, glob_module = mod_index}}}) + current_max | mod_index == ro_main_dcl_module_n | fun_index < size cons_args # {fun_info = {fi_group_index}} = fun_defs.[fun_index] = max fi_group_index current_max = current_max = current_max - max_group_index_of_member fun_defs fun_heap cons_args current_max - (App {app_symb = {symb_name, symb_kind = SK_LocalMacroFunction fun_index}}) + max_group_index_of_member fun_defs fun_heap cons_args + (App {app_symb = {symb_name, symb_kind = SK_LocalMacroFunction fun_index}}) + current_max | fun_index < size cons_args # {fun_info = {fi_group_index}} = fun_defs.[fun_index] = max fi_group_index current_max = current_max - max_group_index_of_member fun_defs fun_heap cons_args current_max + max_group_index_of_member fun_defs fun_heap cons_args (App {app_symb = {symb_kind = SK_GeneratedFunction fun_ptr _ }}) + current_max # (FI_Function {gf_fun_def={fun_info = {fi_group_index}}}) = sreadPtr fun_ptr fun_heap = max fi_group_index current_max - max_group_index_of_member fun_defs fun_heap cons_args current_max - (App {app_symb = {symb_kind = SK_Constructor _}, app_args}) - = max_group_index_of_members app_args current_max fun_defs fun_heap cons_args + max_group_index_of_member fun_defs fun_heap cons_args _ current_max + = current_max - max_group_index_of_members members current_max fun_defs fun_heap cons_args - = foldl (max_group_index_of_member fun_defs fun_heap cons_args) current_max members - max_group_index_of_fun_with_fun_index fun_index current_max fun_defs # fun_def = fun_defs.[fun_index] = max fun_def.fun_info.fi_group_index current_max @@ -2446,7 +2445,7 @@ expand_syn_types_in_TA rem_annots common_defs type_symb=:{type_index={glob_objec SynType rhs_type # ets_type_heaps = bind_attr td_attribute attribute ets.ets_type_heaps ets_type_heaps = (fold2St bind_var_and_attr td_args types ets_type_heaps) - (type, ets_type_heaps) = substitute_rhs rem_annots rhs_type.at_type ets_type_heaps + (_, type, ets_type_heaps) = substitute_rhs rem_annots rhs_type.at_type ets_type_heaps -> expandSynTypes rem_annots common_defs type { ets & ets_type_heaps = ets_type_heaps } _ # (types, ets) = expandSynTypes rem_annots common_defs types ets @@ -2767,18 +2766,33 @@ mapExprSt map_expr map_free_var postprocess_free_var expr st :== map_expr_st exp = map_expr let_expr st st = foldSt (\{lb_dst} st -> postprocess_free_var lb_dst st) let_lazy_binds st st = foldSt (\{lb_dst} st -> postprocess_free_var lb_dst st) let_strict_binds st - = ( Let { lad & let_lazy_binds = combine lazy_free_vars lazy_rhss let_lazy_binds, - let_strict_binds = combine strict_free_vars strict_rhss let_strict_binds, - let_expr = let_expr - } - , st - ) + = map_expr ( Let { lad & let_lazy_binds = combine lazy_free_vars lazy_rhss let_lazy_binds, + let_strict_binds = combine strict_free_vars strict_rhss let_strict_binds, + let_expr = let_expr + }) + st map_expr_st (Selection a expr b) st # (expr, st) = map_expr expr st - = (Selection a expr b, st) + = map_expr (Selection a expr b) st combine :: [FreeVar] [Expression] [LetBind] -> [LetBind] combine free_vars rhss original_binds = [{ original_bind & lb_dst = lb_dst, lb_src = lb_src} \\ lb_dst <- free_vars & lb_src <- rhss & original_bind <- original_binds] +foldrExprSt f expr st :== foldr_expr_st expr st + where + foldr_expr_st expr=:(Var _) st + = f expr st + foldr_expr_st app=:(App {app_args}) st + = f app (foldSt foldr_expr_st app_args st) + foldr_expr_st lad=:(Let {let_lazy_binds, let_strict_binds, let_expr}) st + # st + = foldSt (\{lb_src} st -> foldr_expr_st lb_src st) let_lazy_binds st + st + = foldSt (\{lb_src} st -> foldr_expr_st lb_src st) let_strict_binds st + st + = f let_expr st + = f lad st + foldr_expr_st sel=:(Selection a expr b) st + = f sel (foldr_expr_st expr st) diff --git a/frontend/transform.icl b/frontend/transform.icl index 51e45bf..8025976 100644 --- a/frontend/transform.icl +++ b/frontend/transform.icl @@ -247,7 +247,7 @@ unfoldVariable var=:{var_name,var_info_ptr} us substitute_class_types class_types no=:No = (class_types, no) substitute_class_types class_types (Yes type_heaps) - # (new_class_types, type_heaps) = substitute class_types type_heaps + # (_, new_class_types, type_heaps) = substitute class_types type_heaps = (new_class_types, Yes type_heaps) readVarInfo var_info_ptr us @@ -381,7 +381,7 @@ where = ({ app & app_args = app_args, app_info_ptr = new_info_ptr}, us) substitute_EI_DictionaryType (EI_DictionaryType class_type) (Yes type_heaps) - # (new_class_type, type_heaps) = substitute class_type type_heaps + # (_, new_class_type, type_heaps) = substitute class_type type_heaps = (EI_DictionaryType new_class_type, Yes type_heaps) substitute_EI_DictionaryType x opt_type_heaps = (x, opt_type_heaps) @@ -495,11 +495,11 @@ substitute_let_or_case_type (EI_Extended extensions expr_info) yes_type_heaps # (new_expr_info, yes_type_heaps) = substitute_let_or_case_type expr_info yes_type_heaps = (EI_Extended extensions new_expr_info, yes_type_heaps) substitute_let_or_case_type (EI_CaseType case_type) (Yes type_heaps) - # (new_case_type, type_heaps) = substitute case_type type_heaps + # (_, new_case_type, type_heaps) = substitute case_type type_heaps = (EI_CaseType new_case_type, Yes type_heaps) // = (EI_CaseType case_type, Yes type_heaps) substitute_let_or_case_type (EI_LetType let_type) (Yes type_heaps) - # (new_let_type, type_heaps) = substitute let_type type_heaps + # (_, new_let_type, type_heaps) = substitute let_type type_heaps = (EI_LetType new_let_type, Yes type_heaps) instance unfold CasePatterns diff --git a/frontend/type.icl b/frontend/type.icl index 048ceb0..e03c019 100644 --- a/frontend/type.icl +++ b/frontend/type.icl @@ -2308,8 +2308,8 @@ where create_instance_type members array_members unboxed_array_type offset_table record_type member_index (array_defs, type_heaps) # {me_type,me_symb,me_class_vars,me_pos} = array_members.[members.[member_index].ds_index] - (instance_type, _, type_heaps) = determineTypeOfMemberInstance me_type me_class_vars {it_vars = [], it_attr_vars = [], it_context = [], - it_types = [unboxed_array_type, record_type]} SP_None type_heaps + (instance_type, _, type_heaps, _) = determineTypeOfMemberInstance me_type me_class_vars {it_vars = [], it_attr_vars = [], it_context = [], + it_types = [unboxed_array_type, record_type]} SP_None type_heaps No instance_type = makeElemTypeOfArrayFunctionStrict instance_type member_index offset_table fun = { fun_symb = me_symb diff --git a/frontend/typesupport.dcl b/frontend/typesupport.dcl index 5505b3b..207dda3 100644 --- a/frontend/typesupport.dcl +++ b/frontend/typesupport.dcl @@ -68,7 +68,7 @@ beautifulizeAttributes :: !SymbolType !*AttrVarHeap -> (!SymbolType, !.AttrVarHe updateExpressionTypes :: !SymbolType !SymbolType ![ExprInfoPtr] !*TypeHeaps !*ExpressionHeap -> (!*TypeHeaps, !*ExpressionHeap) -class substitute a :: !a !*TypeHeaps -> (!a, !*TypeHeaps) +class substitute a :: !a !*TypeHeaps -> (!Bool, !a, !*TypeHeaps) instance substitute AType, Type, TypeContext, AttrInequality, CaseType, [a] | substitute a, (a,b) | substitute a & substitute b diff --git a/frontend/typesupport.icl b/frontend/typesupport.icl index 0ebdfdd..d1aaef5 100644 --- a/frontend/typesupport.icl +++ b/frontend/typesupport.icl @@ -23,13 +23,15 @@ import syntax, parse, check, unitype, utilities, checktypes, RWSDebug | UncheckedType !TempSymbolType | ExpandedType !SymbolType !TempSymbolType !TempSymbolType | EmptyFunctionType -simplifyTypeApplication :: !Type ![AType] -> Type +simplifyTypeApplication :: !Type ![AType] -> (!Bool, !Type) simplifyTypeApplication (TA type_cons=:{type_arity} cons_args) type_args - = TA { type_cons & type_arity = type_arity + length type_args } (cons_args ++ type_args) + = (True, TA { type_cons & type_arity = type_arity + length type_args } (cons_args ++ type_args)) simplifyTypeApplication (TV tv) type_args - = CV tv :@: type_args + = (True, CV tv :@: type_args) simplifyTypeApplication (CV tv :@: type_args1) type_args2 - = CV tv :@: (type_args1 ++ type_args2) + = (True, CV tv :@: (type_args1 ++ type_args2)) +simplifyTypeApplication (TB _) _ + = (False, TE) :: AttributeEnv :== {! TypeAttribute } :: VarEnv :== {! Type } @@ -104,7 +106,7 @@ where # (type, cus) = cus!cus_var_env.[tempvar] # (type, cus) = cleanUpVariable cui.cui_top_level type tempvar cus (types, cus) = clean_up cui types cus - = (simplifyTypeApplication type types, cus) + = (snd (simplifyTypeApplication type types), cus) clean_up cui (TempQCV tempvar :@: types) cus # (type, cus) = cus!cus_var_env.[tempvar] # (TV tv, cus) = cleanUpVariable cui.cui_top_level type tempvar cus @@ -178,7 +180,7 @@ where | checkCleanUpResult cur1 cUndefinedVar = (cur1, TempCV tv_number :@: types, env) # (cur2, types, env) = cleanUpClosed types env - = (combineCleanUpResults cur1 cur2, simplifyTypeApplication type types, env) + = (combineCleanUpResults cur1 cur2, snd (simplifyTypeApplication type types), env) cleanUpClosed t env = (cClosed, t, env) @@ -439,13 +441,13 @@ where # (info, expr_heap) = readPtr expr_ptr expr_heap = case info of EI_CaseType case_type - # (case_type, type_heaps) = substitute case_type type_heaps + # (_, case_type, type_heaps) = substitute case_type type_heaps -> (type_heaps, expr_heap <:= (expr_ptr, EI_CaseType case_type)) EI_LetType let_type - # (let_type, type_heaps) = substitute let_type type_heaps + # (_, let_type, type_heaps) = substitute let_type type_heaps -> (type_heaps, expr_heap <:= (expr_ptr, EI_LetType let_type)) EI_DictionaryType dict_type - # (dict_type, type_heaps) = substitute dict_type type_heaps + # (_, dict_type, type_heaps) = substitute dict_type type_heaps -> (type_heaps, expr_heap <:= (expr_ptr, EI_DictionaryType dict_type)) @@ -482,13 +484,13 @@ instance bindInstances AType = bindInstances t1 t2 type_var_heap -class substitute a :: !a !*TypeHeaps -> (!a, !*TypeHeaps) +class substitute a :: !a !*TypeHeaps -> (!Bool, !a, !*TypeHeaps) instance substitute AType where substitute atype=:{at_attribute,at_type} heaps - # ((at_attribute,at_type), heaps) = substitute (at_attribute,at_type) heaps - = ({ atype & at_attribute = at_attribute, at_type = at_type }, heaps) + # (ok, (at_attribute,at_type), heaps) = substitute (at_attribute,at_type) heaps + = (ok, { atype & at_attribute = at_attribute, at_type = at_type }, heaps) instance substitute TypeAttribute where @@ -496,36 +498,36 @@ where #! av_info = sreadPtr av_info_ptr th_attrs = case av_info of AVI_Attr attr - -> (attr, heaps) + -> (True, attr, heaps) _ - -> (TA_Multi, heaps) + -> (True, TA_Multi, heaps) substitute TA_None heaps - = (TA_Multi, heaps) + = (True, TA_Multi, heaps) substitute attr heaps - = (attr, heaps) + = (True, attr, heaps) instance substitute (a,b) | substitute a & substitute b where substitute (x,y) heaps - # (x, heaps) = substitute x heaps - (y, heaps) = substitute y heaps - = ((x,y), heaps) + # (ok_x, x, heaps) = substitute x heaps + (ok_y, y, heaps) = substitute y heaps + = (ok_x && ok_y, (x,y), heaps) instance substitute [a] | substitute a where substitute [] heaps - = ([], heaps) + = (True, [], heaps) substitute [t:ts] heaps - # (t, heaps) = substitute t heaps - (ts, heaps) = substitute ts heaps - = ([t:ts], heaps) + # (ok_t, t, heaps) = substitute t heaps + (ok_ts, ts, heaps) = substitute ts heaps + = (ok_t && ok_ts, [t:ts], heaps) instance substitute TypeContext where substitute tc=:{tc_types} heaps - # (tc_types, heaps) = substitute tc_types heaps - = ({ tc & tc_types = tc_types }, heaps) + # (ok, tc_types, heaps) = substitute tc_types heaps + = (ok, { tc & tc_types = tc_types }, heaps) substituteTypeVariable tv=:{tv_name,tv_info_ptr} heaps=:{th_vars} # (tv_info, th_vars) = readPtr tv_info_ptr th_vars @@ -539,31 +541,27 @@ substituteTypeVariable tv=:{tv_name,tv_info_ptr} heaps=:{th_vars} instance substitute Type where substitute (TV tv) heaps - = substituteTypeVariable tv heaps + # (type, heaps) = substituteTypeVariable tv heaps + = (True, type, heaps) substitute (arg_type --> res_type) heaps - # ((arg_type, res_type), heaps) = substitute (arg_type, res_type) heaps - = (arg_type --> res_type, heaps) + # (ok, (arg_type, res_type), heaps) = substitute (arg_type, res_type) heaps + = (ok, arg_type --> res_type, heaps) substitute (TA cons_id cons_args) heaps - # (cons_args, heaps) = substitute cons_args heaps - = (TA cons_id cons_args, heaps) -/* MW3 was - substitute (CV type_var :@: types) heaps - # (type, heaps) = substituteTypeVariable type_var heaps - (types, heaps) = substitute types heaps - = (simplifyTypeApplication type types, heaps) -*/ + # (ok, cons_args, heaps) = substitute cons_args heaps + = (ok, TA cons_id cons_args, heaps) substitute (CV type_var :@: types) heaps=:{th_vars} # (tv_info, th_vars) = readPtr type_var.tv_info_ptr th_vars heaps = { heaps & th_vars = th_vars } - (types, heaps) = substitute types heaps + (ok1, types, heaps) = substitute types heaps = case tv_info of TVI_Type tv=:(TempV i) - -> (TempCV i :@: types, heaps) + -> (ok1, TempCV i :@: types, heaps) _ # (type, heaps) = substituteTypeVariable type_var heaps - -> (simplifyTypeApplication type types, heaps) + (ok2, simplified_type) = simplifyTypeApplication type types + -> (ok1 && ok2, simplified_type, heaps) substitute type heaps - = (type, heaps) + = (True, type, heaps) instance substitute AttributeVar where @@ -571,24 +569,24 @@ where #! av_info = sreadPtr av_info_ptr th_attrs = case av_info of AVI_Attr (TA_Var attr_var) - -> (attr_var, heaps) + -> (True, attr_var, heaps) _ - -> (av, heaps) + -> (True, av, heaps) instance substitute AttrInequality where substitute {ai_demanded,ai_offered} heaps - # ((ai_demanded, ai_offered), heaps) = substitute (ai_demanded, ai_offered) heaps - = ({ai_demanded = ai_demanded, ai_offered = ai_offered}, heaps) + # (ok, (ai_demanded, ai_offered), heaps) = substitute (ai_demanded, ai_offered) heaps + = (ok, {ai_demanded = ai_demanded, ai_offered = ai_offered}, heaps) instance substitute CaseType where substitute {ct_pattern_type, ct_result_type, ct_cons_types} heaps - # (ct_pattern_type, heaps) = substitute ct_pattern_type heaps - (ct_result_type, heaps) = substitute ct_result_type heaps - (ct_cons_types, heaps) = substitute ct_cons_types heaps - = ({ct_pattern_type = ct_pattern_type, ct_result_type = ct_result_type, ct_cons_types = ct_cons_types}, heaps) - + # (ok1, ct_pattern_type, heaps) = substitute ct_pattern_type heaps + (ok2, ct_result_type, heaps) = substitute ct_result_type heaps + (ok3, ct_cons_types, heaps) = substitute ct_cons_types heaps + = (ok1 && ok2 && ok3, {ct_pattern_type = ct_pattern_type, ct_result_type = ct_result_type, + ct_cons_types = ct_cons_types}, heaps) class removeAnnotations a :: !a -> (!Bool, !a) @@ -654,7 +652,7 @@ where expandTypeApplication :: ![ATypeVar] !TypeAttribute !Type ![AType] !TypeAttribute !*TypeHeaps -> (!Type, !*TypeHeaps) expandTypeApplication type_args form_attr type_rhs arg_types act_attr type_heaps=:{th_attrs} # type_heaps = bindTypeVarsAndAttributes form_attr act_attr type_args arg_types type_heaps - (exp_type, type_heaps) = substitute type_rhs type_heaps + (_, exp_type, type_heaps) = substitute type_rhs type_heaps = (exp_type, clearBindingsOfTypeVarsAndAttributes form_attr type_args type_heaps) VarIdTable :: {# String} |