Commit 872f12c1 authored by Artem Alimarine's avatar Artem Alimarine
Browse files

new implementation of generics

parent 681324e3
......@@ -15,7 +15,7 @@ instance =< Type, SymbIdent
instance == BasicType, TypeVar, AttributeVar, AttrInequality, TypeSymbIdent, DefinedSymbol,
TypeContext , BasicValue, FunKind, (Global a) | == a, Priority, Assoc, Type,
ConsVariable, SignClassification
ConsVariable, SignClassification, TypeCons
instance < MemberDef
......
......@@ -117,6 +117,11 @@ where
instance == SignClassification where
(==) sc1 sc2 = sc1.sc_pos_vect == sc2.sc_pos_vect && sc1.sc_neg_vect == sc2.sc_neg_vect
instance == TypeCons where
(==) (TypeConsSymb x) (TypeConsSymb y) = x == y
(==) (TypeConsBasic x) (TypeConsBasic y) = x == y
(==) TypeConsArrow TypeConsArrow = True
:: CompareValue :== Int
Smaller :== -1
Greater :== 1
......
......@@ -13,7 +13,7 @@ determineKindsOfClasses :: !NumberSet !{#CommonDefs} !*TypeDefInfos !*TypeVarHea
-> (!*ClassDefInfos, !*TypeDefInfos, !*TypeVarHeap, !*ErrorAdmin)
checkKindsOfCommonDefsAndFunctions :: !Index !Index !NumberSet ![IndexRange] !{#CommonDefs} !u:{# FunDef} !v:{#DclModule} !*TypeDefInfos !*ClassDefInfos
!*TypeVarHeap !*ErrorAdmin -> (!u:{# FunDef}, !v:{#DclModule}, !*TypeDefInfos, !*TypeVarHeap, !*ErrorAdmin)
!*TypeVarHeap !*GenericHeap !*ErrorAdmin -> (!u:{# FunDef}, !v:{#DclModule}, !*TypeDefInfos, !*TypeVarHeap, !*GenericHeap, !*ErrorAdmin)
isATopConsVar cv :== cv < 0
encodeTopConsVar cv :== dec (~cv)
......
......@@ -831,9 +831,9 @@ where
= ( type_var_heap <:= (tv_info_ptr, TVI_TypeKind kind_info_ptr), kind_heap <:= (kind_info_ptr, KI_Var kind_info_ptr))
checkKindsOfCommonDefsAndFunctions :: !Index !Index !NumberSet ![IndexRange] !{#CommonDefs} !u:{# FunDef} !v:{#DclModule} !*TypeDefInfos !*ClassDefInfos
!*TypeVarHeap !*ErrorAdmin -> (!u:{# FunDef}, !v:{#DclModule}, !*TypeDefInfos, !*TypeVarHeap, !*ErrorAdmin)
!*TypeVarHeap !*GenericHeap !*ErrorAdmin -> (!u:{# FunDef}, !v:{#DclModule}, !*TypeDefInfos, !*TypeVarHeap, !*GenericHeap, !*ErrorAdmin)
checkKindsOfCommonDefsAndFunctions first_uncached_module main_module_index used_module_numbers icl_fun_def_ranges common_defs icl_fun_defs dcl_modules
type_def_infos class_infos type_var_heap error
type_def_infos class_infos type_var_heap gen_heap error
# as =
{ as_td_infos = type_def_infos
, as_type_var_heap = type_var_heap
......@@ -841,27 +841,29 @@ checkKindsOfCommonDefsAndFunctions first_uncached_module main_module_index used_
, as_error = error
}
# (icl_fun_defs, dcl_modules, class_infos, as)
# (icl_fun_defs, dcl_modules, class_infos, gen_heap, as)
= iFoldSt (check_kinds_of_module first_uncached_module main_module_index used_module_numbers icl_fun_def_ranges common_defs)
0 (size common_defs) (icl_fun_defs, dcl_modules, class_infos, as)
= (icl_fun_defs, dcl_modules, as.as_td_infos, as.as_type_var_heap, as.as_error)
0 (size common_defs) (icl_fun_defs, dcl_modules, class_infos, gen_heap, as)
= (icl_fun_defs, dcl_modules, as.as_td_infos, as.as_type_var_heap, gen_heap, as.as_error)
where
check_kinds_of_module first_uncached_module main_module_index used_module_numbers icl_fun_def_ranges common_defs module_index
(icl_fun_defs, dcl_modules, class_infos, as)
(icl_fun_defs, dcl_modules, class_infos, gen_heap, as)
| inNumberSet module_index used_module_numbers
| module_index == main_module_index
# (class_infos, as) = check_kinds_of_class_instances common_defs 0 common_defs.[module_index].com_instance_defs class_infos as
# (class_infos, gen_heap, as) = check_kinds_of_generics common_defs 0 common_defs.[module_index].com_generic_defs class_infos gen_heap as
# (icl_fun_defs, class_infos, as) = foldSt (check_kinds_of_icl_fuctions common_defs) icl_fun_def_ranges (icl_fun_defs, class_infos, as)
with
check_kinds_of_icl_fuctions common_defs {ir_from,ir_to} (icl_fun_defs, class_infos, as)
= iFoldSt (check_kinds_of_icl_fuction common_defs) ir_from ir_to (icl_fun_defs, class_infos, as)
= (icl_fun_defs, dcl_modules, class_infos, as)
= (icl_fun_defs, dcl_modules, class_infos, gen_heap, as)
| module_index >= first_uncached_module
# (class_infos, as) = check_kinds_of_class_instances common_defs 0 common_defs.[module_index].com_instance_defs class_infos as
# (class_infos, gen_heap, as) = check_kinds_of_generics common_defs 0 common_defs.[module_index].com_generic_defs class_infos gen_heap as
# (dcl_modules, class_infos, as) = check_kinds_of_dcl_fuctions common_defs module_index dcl_modules class_infos as
= (icl_fun_defs, dcl_modules, class_infos, as)
= (icl_fun_defs, dcl_modules, class_infos, as)
= (icl_fun_defs, dcl_modules, class_infos, as)
= (icl_fun_defs, dcl_modules, class_infos, gen_heap, as)
= (icl_fun_defs, dcl_modules, class_infos, gen_heap, as)
= (icl_fun_defs, dcl_modules, class_infos, gen_heap, as)
check_kinds_of_class_instances common_defs instance_index instance_defs class_infos as
| instance_index == size instance_defs
......@@ -870,9 +872,9 @@ where
= check_kinds_of_class_instances common_defs (inc instance_index) instance_defs class_infos as
where
check_kinds_of_class_instance :: !{#CommonDefs} !ClassInstance !*ClassDefInfos !*AnalyseState -> (!*ClassDefInfos, !*AnalyseState)
check_kinds_of_class_instance common_defs {ins_is_generic, ins_class,ins_ident,ins_pos,ins_type={it_vars,it_types,it_context}} class_infos
check_kinds_of_class_instance common_defs {ins_generated, ins_class,ins_ident,ins_pos,ins_type={it_vars,it_types,it_context}} class_infos
as=:{as_type_var_heap,as_kind_heap,as_error}
| ins_is_generic
| ins_generated
// generic instances are cheched in the generic phase
= (class_infos, as)
# as_error = pushErrorAdmin (newPosition ins_ident ins_pos) as_error
......@@ -882,6 +884,40 @@ where
[{tc_class = ins_class, tc_types = it_types, tc_var = nilPtr} : it_context] class_infos as
= (class_infos, { as & as_error = popErrorAdmin as.as_error})
check_kinds_of_generics common_defs index generic_defs class_infos gen_heap as
| index == size generic_defs
= (class_infos, gen_heap, as)
# (class_infos, gen_heap, as) = check_kinds_of_generic common_defs generic_defs.[index] class_infos gen_heap as
= check_kinds_of_generics common_defs (inc index) generic_defs class_infos gen_heap as
where
check_kinds_of_generic :: !{#CommonDefs} !GenericDef !*ClassDefInfos !*GenericHeap !*AnalyseState -> (!*ClassDefInfos, !*GenericHeap, !*AnalyseState)
check_kinds_of_generic common_defs {gen_type, gen_name, gen_pos, gen_vars, gen_info_ptr} class_infos gen_heap as
# as = {as & as_error = pushErrorAdmin (newPosition gen_name gen_pos) as.as_error}
# (class_infos, as) = check_kinds_of_symbol_type common_defs gen_type class_infos as
# (kinds, as) = mapSt retrieve_tv_kind gen_type.st_vars as
# as = check_kinds_of_generic_vars (take (length gen_vars) kinds) as
# (gen_info, gen_heap) = readPtr gen_info_ptr gen_heap
# gen_heap = writePtr gen_info_ptr {gen_info & gen_var_kinds = kinds} gen_heap
# as = {as & as_error = popErrorAdmin as.as_error}
= (class_infos, gen_heap, as)
retrieve_tv_kind :: !TypeVar !*AnalyseState -> (!TypeKind, !*AnalyseState)
retrieve_tv_kind tv=:{tv_info_ptr} as=:{as_type_var_heap, as_kind_heap}
#! (TVI_TypeKind kind_info_ptr, as_type_var_heap) = readPtr tv_info_ptr as_type_var_heap
#! (kind_info, as_kind_heap) = readPtr kind_info_ptr as_kind_heap
#! (kind, as_kind_heap) = kindInfoToKind kind_info as_kind_heap
= (kind, {as & as_kind_heap = as_kind_heap, as_type_var_heap = as_type_var_heap})
check_kinds_of_generic_vars :: ![TypeKind] !*AnalyseState -> !*AnalyseState
check_kinds_of_generic_vars [gen_kind:gen_kinds] as
| all (\k -> k == gen_kind) gen_kinds
= as
# as_error = checkError
"conflicting kinds: "
"generic variables must have the same kind"
as.as_error
= {as & as_error = as_error}
check_kinds_of_icl_fuction common_defs fun_index (icl_fun_defs, class_infos, as)
# ({fun_type,fun_symb,fun_pos}, icl_fun_defs) = icl_fun_defs![fun_index]
= case fun_type of
......@@ -904,7 +940,7 @@ where
(class_infos, as) = check_kinds_of_symbol_type common_defs ft_type class_infos
{ as & as_error = as_error }
= (class_infos, { as & as_error = popErrorAdmin as.as_error})
check_kinds_of_symbol_type :: !{#CommonDefs} !SymbolType !*ClassDefInfos !*AnalyseState -> (!*ClassDefInfos, !*AnalyseState)
check_kinds_of_symbol_type common_defs {st_vars,st_result,st_args,st_context} class_infos as=:{as_type_var_heap,as_kind_heap}
# (as_type_var_heap, as_kind_heap) = bindFreshKindVariablesToTypeVars st_vars as_type_var_heap as_kind_heap
......
This diff is collapsed.
......@@ -6,11 +6,12 @@ import syntax, checksupport
:: ExpressionState =
{ es_expr_heap :: !.ExpressionHeap
, es_var_heap :: !.VarHeap
, es_type_heaps :: !.TypeHeaps
, es_calls :: ![FunCall]
, es_dynamics :: !Dynamics
, es_fun_defs :: !.{# FunDef}
, es_var_heap :: !.VarHeap
, es_type_heaps :: !.TypeHeaps
, es_generic_heap :: !.GenericHeap
, es_calls :: ![FunCall]
, es_dynamics :: ![ExprInfoPtr]
, es_fun_defs :: !.{# FunDef}
}
:: ExpressionInput =
......
......@@ -14,11 +14,12 @@ cEndWithSelection :== False
:: ExpressionState =
{ es_expr_heap :: !.ExpressionHeap
, es_var_heap :: !.VarHeap
, es_type_heaps :: !.TypeHeaps
, es_calls :: ![FunCall]
, es_dynamics :: !Dynamics
, es_fun_defs :: !.{# FunDef}
, es_var_heap :: !.VarHeap
, es_type_heaps :: !.TypeHeaps
, es_generic_heap :: !.GenericHeap
, es_calls :: ![FunCall]
, es_dynamics :: ![ExprInfoPtr]
, es_fun_defs :: !.{# FunDef}
}
:: ExpressionInput =
......@@ -308,8 +309,11 @@ where
# (var_expr_ptr, expr_heap) = newPtr EI_Empty expr_heap
= (Var { var_name = fv_name, var_info_ptr = fv_info_ptr, var_expr_ptr = var_expr_ptr }, result_expr, expr_heap)
checkFunctionBodies GeneratedBody function_ident_for_errors e_input e_state e_info cs
= (GeneratedBody, [], e_state, e_info, cs)
//---> ("checkFunctionBodies: function to derive ", function_ident_for_errors)
checkFunctionBodies _ function_ident_for_errors e_input=:{ei_expr_level,ei_mod_index} e_state=:{es_var_heap, es_fun_defs} e_info cs
= abort ("checkFunctionBodies "+++toString function_ident_for_errors)
= abort ("checkFunctionBodies " +++ toString function_ident_for_errors +++ "\n")
removeLocalsFromSymbolTable :: !Index !Level ![Ident] !LocalDefs !Int !*{#FunDef} !*{#*{#FunDef}} !*(Heap SymbolTableEntry)
......@@ -329,11 +333,11 @@ checkRhs free_vars rhs_alts rhs_locals e_input=:{ei_expr_level,ei_mod_index,ei_l
(loc_defs, (var_env, array_patterns), e_state, e_info, cs) = checkLhssOfLocalDefs ei_expr_level ei_mod_index rhs_locals ei_local_functions_index_offset e_state e_info cs
(es_fun_defs, e_info, heaps, cs)
= checkLocalFunctions ei_mod_index ei_expr_level rhs_locals ei_local_functions_index_offset e_state.es_fun_defs e_info
{ hp_var_heap = e_state.es_var_heap, hp_expression_heap = e_state.es_expr_heap, hp_type_heaps = e_state.es_type_heaps } cs
{ hp_var_heap = e_state.es_var_heap, hp_expression_heap = e_state.es_expr_heap, hp_type_heaps = e_state.es_type_heaps, hp_generic_heap = e_state.es_generic_heap } cs
(rhs_expr, free_vars, e_state, e_info, cs)
= check_opt_guarded_alts free_vars rhs_alts { e_input & ei_expr_level = ei_expr_level }
{ e_state & es_fun_defs = es_fun_defs, es_var_heap = heaps.hp_var_heap, es_expr_heap = heaps.hp_expression_heap,
es_type_heaps = heaps.hp_type_heaps } e_info cs
es_type_heaps = heaps.hp_type_heaps,es_generic_heap=heaps.hp_generic_heap } e_info cs
(expr, free_vars, e_state, e_info, cs)
= addArraySelections array_patterns rhs_expr free_vars e_input e_state e_info cs
(expr, free_vars, e_state, e_info, cs) = checkRhssAndTransformLocalDefs free_vars loc_defs expr e_input e_state e_info cs
......@@ -414,10 +418,11 @@ where
= checkRhssAndTransformLocalDefs free_vars loc_defs seq_let_expr e_input { e_state & es_expr_heap = es_expr_heap} e_info cs
(es_fun_defs, e_info, heaps, cs)
= checkLocalFunctions ei_mod_index rhs_expr_level ewl_locals ei_local_functions_index_offset e_state.es_fun_defs e_info
{ hp_var_heap = e_state.es_var_heap, hp_expression_heap = e_state.es_expr_heap, hp_type_heaps = e_state.es_type_heaps } cs
{ hp_var_heap = e_state.es_var_heap, hp_expression_heap = e_state.es_expr_heap, hp_type_heaps = e_state.es_type_heaps,hp_generic_heap=e_state.es_generic_heap } cs
(es_fun_defs,macro_defs,cs_symbol_table) = removeLocalsFromSymbolTable ei_mod_index this_expr_level var_env ewl_locals ei_local_functions_index_offset es_fun_defs e_info.ef_macro_defs cs.cs_symbol_table
= (expr, free_vars, {e_state & es_fun_defs = es_fun_defs, es_var_heap = heaps.hp_var_heap,
es_expr_heap = heaps.hp_expression_heap, es_type_heaps = heaps.hp_type_heaps }, {e_info & ef_macro_defs=macro_defs}, { cs & cs_symbol_table = cs_symbol_table} )
es_expr_heap = heaps.hp_expression_heap, es_type_heaps = heaps.hp_type_heaps, es_generic_heap=heaps.hp_generic_heap},
{e_info & ef_macro_defs=macro_defs}, { cs & cs_symbol_table = cs_symbol_table} )
remove_seq_let_vars level [] symbol_table
= symbol_table
......@@ -457,14 +462,14 @@ where
(src_expr, free_vars, e_state, e_info, cs)
= addArraySelections loc_array_patterns src_expr free_vars e_input e_state e_info cs
(src_expr, free_vars, e_state, e_info, cs) = checkRhssAndTransformLocalDefs free_vars loc_defs src_expr e_input e_state e_info cs
(es_fun_defs, e_info, {hp_var_heap,hp_expression_heap,hp_type_heaps}, cs)
(es_fun_defs, e_info, {hp_var_heap,hp_expression_heap,hp_type_heaps,hp_generic_heap}, cs)
= checkLocalFunctions ei_mod_index ei_expr_level ndwl_locals ei_local_functions_index_offset e_state.es_fun_defs e_info
{ hp_var_heap = e_state.es_var_heap, hp_expression_heap = e_state.es_expr_heap, hp_type_heaps = e_state.es_type_heaps } cs
{ hp_var_heap = e_state.es_var_heap, hp_expression_heap = e_state.es_expr_heap, hp_type_heaps = e_state.es_type_heaps,hp_generic_heap=e_state.es_generic_heap} cs
(es_fun_defs,macro_defs,cs_symbol_table) = removeLocalsFromSymbolTable ei_mod_index ei_expr_level loc_env ndwl_locals ei_local_functions_index_offset es_fun_defs e_info.ef_macro_defs cs.cs_symbol_table
(pattern, accus, {ps_fun_defs,ps_var_heap}, e_info, cs)
= checkPattern bind_dst No { pi_def_level = ei_expr_level, pi_mod_index = ei_mod_index, pi_is_node_pattern = True } ([], [])
{ps_var_heap = hp_var_heap,ps_fun_defs = es_fun_defs } {e_info & ef_macro_defs=macro_defs} { cs & cs_symbol_table = cs_symbol_table }
e_state = { e_state & es_var_heap = ps_var_heap, es_expr_heap = hp_expression_heap, es_type_heaps = hp_type_heaps,es_fun_defs = ps_fun_defs }
e_state = { e_state & es_var_heap = ps_var_heap, es_expr_heap = hp_expression_heap, es_type_heaps = hp_type_heaps,es_generic_heap=hp_generic_heap,es_fun_defs = ps_fun_defs }
= (src_expr, pattern, accus, free_vars, e_state, e_info, popErrorAdmin cs)
build_sequential_lets :: ![(![LetBind],![LetBind])] !Expression !Position !*ExpressionHeap -> (!Position, !Expression, !*ExpressionHeap)
......@@ -606,11 +611,12 @@ checkExpression free_vars (PE_Let strict let_locals expr) e_input=:{ei_expr_leve
(expr, free_vars, e_state, e_info, cs) = checkRhssAndTransformLocalDefs free_vars loc_defs expr e_input e_state e_info cs
(es_fun_defs, e_info, heaps, cs)
= checkLocalFunctions ei_mod_index ei_expr_level let_locals ei_local_functions_index_offset e_state.es_fun_defs e_info
{ hp_var_heap = e_state.es_var_heap, hp_expression_heap = e_state.es_expr_heap, hp_type_heaps = e_state.es_type_heaps } cs
{ hp_var_heap = e_state.es_var_heap, hp_expression_heap = e_state.es_expr_heap, hp_type_heaps = e_state.es_type_heaps, hp_generic_heap = e_state.es_generic_heap } cs
(es_fun_defs,macro_defs,cs_symbol_table) = removeLocalsFromSymbolTable ei_mod_index ei_expr_level var_env let_locals ei_local_functions_index_offset es_fun_defs e_info.ef_macro_defs cs.cs_symbol_table
= (expr, free_vars,
{ e_state & es_fun_defs = es_fun_defs, es_var_heap = heaps.hp_var_heap, es_expr_heap = heaps.hp_expression_heap,
es_type_heaps = heaps.hp_type_heaps }, {e_info & ef_macro_defs=macro_defs}, { cs & cs_symbol_table = cs_symbol_table })
es_type_heaps = heaps.hp_type_heaps,es_generic_heap = heaps.hp_generic_heap },
{e_info & ef_macro_defs=macro_defs}, { cs & cs_symbol_table = cs_symbol_table })
checkExpression free_vars (PE_Case case_ident expr alts) e_input e_state e_info cs
# (pattern_expr, free_vars, e_state, e_info, cs) = checkExpression free_vars expr e_input e_state e_info cs
......@@ -1187,13 +1193,14 @@ checkExpression free_vars (PE_Generic id=:{id_name,id_info} kind) e_input e_stat
add_kind :: !Index !TypeKind !u:{#GenericDef} !*ExpressionState
-> (!u:{#GenericDef}, !*ExpressionState)
add_kind generic_index kind generic_defs e_state=:{es_type_heaps=es_type_heaps=:{th_vars}}
#! (generic_def=:{gen_kinds_ptr}, generic_defs) = generic_defs ! [generic_index]
#! (TVI_Kinds kinds, th_vars) = readPtr gen_kinds_ptr th_vars
#! kinds = eqMerge [kind] kinds
#! th_vars = writePtr gen_kinds_ptr (TVI_Kinds kinds) th_vars
#! e_state = { e_state & es_type_heaps = {es_type_heaps & th_vars = th_vars}}
= (generic_defs, e_state)
add_kind generic_index kind generic_defs e_state=:{es_generic_heap}
/*
#! ({gen_info_ptr}, generic_defs) = generic_defs ! [generic_index]
#! (gen_info, es_generic_heap) = readPtr gen_info_ptr es_generic_heap
#! gen_kinds = eqMerge [(kind,NoIndex)] gen_info.gen_kinds
#! es_generic_heap = writePtr gen_info_ptr {gen_info&gen_kinds=gen_kinds} es_generic_heap
*/
= (generic_defs, {e_state & es_generic_heap = es_generic_heap})
checkExpression free_vars expr e_input e_state e_info cs
= abort "checkExpression (checkFunctionBodies.icl, line 868)" // <<- expr
......
......@@ -22,6 +22,7 @@ cNeedStdStrictLists :== 16
{ hp_var_heap ::!.VarHeap
, hp_expression_heap ::!.ExpressionHeap
, hp_type_heaps ::!.TypeHeaps
, hp_generic_heap ::!.GenericHeap
}
:: ErrorAdmin = { ea_file :: !.File, ea_loc :: ![IdentPos], ea_ok :: !Bool }
......@@ -42,11 +43,12 @@ cSelectorDefs :== 2
cClassDefs :== 3
cMemberDefs :== 4
cGenericDefs :== 5
cInstanceDefs :== 6
cFunctionDefs :== 7
cMacroDefs :== 8
cGenericCaseDefs :== 6
cInstanceDefs :== 7
cFunctionDefs :== 8
cMacroDefs :== 9
cConversionTableSize :== 9
cConversionTableSize :== 10
:: CommonDefs =
{ com_type_defs :: !.{# CheckedTypeDef}
......@@ -55,7 +57,8 @@ cConversionTableSize :== 9
, com_class_defs :: !.{# ClassDef}
, com_member_defs :: !.{# MemberDef}
, com_instance_defs :: !.{# ClassInstance}
, com_generic_defs :: !.{# GenericDef}
, com_generic_defs :: !.{# GenericDef} // AA
, com_gencase_defs :: !.{# GenericCaseDef} // AA
}
:: Declarations = {
......@@ -81,6 +84,7 @@ cConversionTableSize :== 9
:: CopiedDefinitions =
{ copied_type_defs :: {#Bool}
, copied_class_defs :: {#Bool}
, copied_generic_defs :: {#Bool}
}
:: IclModule =
......@@ -89,6 +93,7 @@ cConversionTableSize :== 9
, icl_global_functions :: ![IndexRange]
, icl_instances :: ![IndexRange]
, icl_specials :: !IndexRange
, icl_gencases :: ![IndexRange]
, icl_common :: !.CommonDefs
, icl_import :: !{!Declaration}
, icl_imported_objects :: ![ImportedObject]
......@@ -105,6 +110,7 @@ cConversionTableSize :== 9
, dcl_instances :: !IndexRange
, dcl_macros :: !IndexRange
, dcl_specials :: !IndexRange
, dcl_gencases :: !IndexRange
, dcl_common :: !CommonDefs
, dcl_sizes :: !{# Int}
, dcl_dictionary_info :: !DictionaryInfo
......
......@@ -26,6 +26,7 @@ cNeedStdStrictLists :== 16
{ hp_var_heap ::!.VarHeap
, hp_expression_heap ::!.ExpressionHeap
, hp_type_heaps ::!.TypeHeaps
, hp_generic_heap ::!.GenericHeap
}
:: ErrorAdmin = { ea_file :: !.File, ea_loc :: ![IdentPos], ea_ok :: !Bool }
......@@ -42,11 +43,12 @@ cSelectorDefs :== 2
cClassDefs :== 3
cMemberDefs :== 4
cGenericDefs :== 5
cInstanceDefs :== 6
cFunctionDefs :== 7
cMacroDefs :== 8
cGenericCaseDefs :== 6
cInstanceDefs :== 7
cFunctionDefs :== 8
cMacroDefs :== 9
cConversionTableSize :== 9
cConversionTableSize :== 10
instance toInt STE_Kind
where
......@@ -55,6 +57,7 @@ where
toInt (STE_Field _) = cSelectorDefs
toInt STE_Class = cClassDefs
toInt STE_Generic = cGenericDefs
toInt STE_GenericCase = cGenericCaseDefs
toInt STE_Member = cMemberDefs
toInt (STE_Instance _) = cInstanceDefs
toInt STE_DclFunction = cFunctionDefs
......@@ -71,6 +74,7 @@ where
, com_member_defs :: !.{# MemberDef}
, com_instance_defs :: !.{# ClassInstance}
, com_generic_defs :: !.{# GenericDef} // AA
, com_gencase_defs :: !.{# GenericCaseDef} // AA
}
:: Declarations = {
......@@ -96,6 +100,7 @@ where
:: CopiedDefinitions =
{ copied_type_defs :: {#Bool}
, copied_class_defs :: {#Bool}
, copied_generic_defs :: {#Bool}
}
:: IclModule =
......@@ -104,6 +109,7 @@ where
, icl_global_functions :: ![IndexRange]
, icl_instances :: ![IndexRange]
, icl_specials :: !IndexRange
, icl_gencases :: ![IndexRange]
, icl_common :: !.CommonDefs
, icl_import :: !{!Declaration}
, icl_imported_objects :: ![ImportedObject]
......@@ -120,6 +126,7 @@ where
, dcl_instances :: !IndexRange
, dcl_macros :: !IndexRange
, dcl_specials :: !IndexRange
, dcl_gencases :: !IndexRange
, dcl_common :: !CommonDefs
, dcl_sizes :: !{# Int}
, dcl_dictionary_info :: !DictionaryInfo
......
......@@ -2,8 +2,8 @@ definition module checktypes
import checksupport, typesupport
checkTypeDefs :: !Index !(Optional (CopiedDefinitions, Int)) !*{# CheckedTypeDef} !*{# ConsDef} !*{# SelectorDef} !*{# DclModule} !*VarHeap !*TypeHeaps !*CheckState
-> (!*{# CheckedTypeDef}, !*{# ConsDef}, !*{# SelectorDef}, !*{# DclModule}, !*VarHeap, !*TypeHeaps, !*CheckState)
checkTypeDefs :: !Index !(Optional (CopiedDefinitions, Int)) !*{# CheckedTypeDef} !*{# ConsDef} !*{# SelectorDef} !*{# DclModule} !*Heaps !*CheckState
-> (!*{# CheckedTypeDef}, !*{# ConsDef}, !*{# SelectorDef}, !*{# DclModule}, !*Heaps, !*CheckState)
checkFunctionType :: !Index !SymbolType !Specials !u:{# CheckedTypeDef} !v:{# ClassDef} !u:{# DclModule} !*TypeHeaps !*CheckState
-> (!SymbolType, !Specials, !u:{# CheckedTypeDef}, !v:{# ClassDef}, !u:{# DclModule}, !*TypeHeaps, !*CheckState)
......@@ -11,7 +11,12 @@ checkFunctionType :: !Index !SymbolType !Specials !u:{# CheckedTypeDef} !v:{# Cl
checkMemberType :: !Index !SymbolType !u:{# CheckedTypeDef} !v:{# ClassDef} !u:{# DclModule} !*TypeHeaps !*CheckState
-> (!SymbolType, !u:{# CheckedTypeDef}, !v:{# ClassDef}, !u:{# DclModule}, !*TypeHeaps, !*CheckState)
//1.3
checkInstanceType :: !Index !(Global DefinedSymbol) !InstanceType !Specials !u:{# CheckedTypeDef} !v:{# ClassDef} !u:{# DclModule} !*TypeHeaps !*CheckState
//3.1
/*2.0
checkInstanceType :: !Index !(Global DefinedSymbol) !InstanceType !Specials !u:{# CheckedTypeDef} !v:{# ClassDef} !u:{# DclModule} !*TypeHeaps !*CheckState
0.2*/
-> (!InstanceType, !Specials, !u:{# CheckedTypeDef}, !v:{# ClassDef}, !u:{# DclModule}, !*TypeHeaps, !*CheckState)
checkSuperClasses :: ![TypeVar] ![TypeContext] !Index !u:{# CheckedTypeDef} !v:{# ClassDef} !u:{# DclModule} !*TypeHeaps !*CheckState
......
......@@ -326,15 +326,15 @@ where
CS_Checked :== 1
CS_Checking :== 0
checkTypeDefs :: !Index !(Optional (CopiedDefinitions, Int)) !*{# CheckedTypeDef} !*{# ConsDef} !*{# SelectorDef} !*{# DclModule} !*VarHeap !*TypeHeaps !*CheckState
-> (!*{# CheckedTypeDef}, !*{# ConsDef}, !*{# SelectorDef}, !*{# DclModule}, !*VarHeap, !*TypeHeaps, !*CheckState)
checkTypeDefs module_index opt_icl_info type_defs cons_defs selector_defs modules var_heap type_heaps cs
checkTypeDefs :: !Index !(Optional (CopiedDefinitions, Int)) !*{# CheckedTypeDef} !*{# ConsDef} !*{# SelectorDef} !*{# DclModule} !*Heaps !*CheckState
-> (!*{# CheckedTypeDef}, !*{# ConsDef}, !*{# SelectorDef}, !*{# DclModule}, !*Heaps, !*CheckState)
checkTypeDefs module_index opt_icl_info type_defs cons_defs selector_defs modules heaps=:{hp_type_heaps,hp_var_heap} cs
#! nr_of_types = size type_defs
# ts = { ts_type_defs = type_defs, ts_cons_defs = cons_defs, ts_selector_defs = selector_defs, ts_modules = modules }
ti = { ti_type_heaps = type_heaps, ti_var_heap = var_heap, ti_used_types = [] }
ti = { ti_type_heaps = hp_type_heaps, ti_var_heap = hp_var_heap, ti_used_types = [] }
({ts_type_defs,ts_cons_defs, ts_selector_defs, ts_modules}, {ti_var_heap,ti_type_heaps}, cs)
= iFoldSt (check_type_def module_index opt_icl_info) 0 nr_of_types (ts, ti, cs)
= (ts_type_defs, ts_cons_defs, ts_selector_defs, ts_modules, ti_var_heap, ti_type_heaps, cs)
= (ts_type_defs, ts_cons_defs, ts_selector_defs, ts_modules, {heaps& hp_var_heap=ti_var_heap, hp_type_heaps=ti_type_heaps}, cs)
where
check_type_def module_index opt_icl_info type_index (ts, ti, cs)
| has_to_be_checked module_index opt_icl_info type_index
......@@ -371,6 +371,11 @@ determineAttributeVariable attr_var=:{av_name=attr_name=:{id_info}} oti=:{oti_he
= ({ attr_var & av_info_ptr = attr_ptr}, oti, symbol_table)
:: DemandedAttributeKind = DAK_Ignore | DAK_Unique | DAK_None
instance toString DemandedAttributeKind where
toString DAK_Ignore = "DAK_Ignore"
toString DAK_Unique = "DAK_Unique"
toString DAK_None = "DAK_None"
newAttribute :: !DemandedAttributeKind {#Char} TypeAttribute !*OpenTypeInfo !*CheckState -> (!TypeAttribute, !*OpenTypeInfo, !*CheckState)
newAttribute DAK_Ignore var_name attr oti cs
......
......@@ -11,6 +11,7 @@ import syntax, checksupport, compare_constructor, utilities, StdCompare, compile
type_def_error = "type definition in the impl module conflicts with the def module"
class_def_error = "class definition in the impl module conflicts with the def module"
instance_def_error = "instance definition in the impl module conflicts with the def module"
generic_def_error = "generic definition in the impl module conflicts with the def module"
compareError message pos error_admin
= popErrorAdmin (checkError "" message (pushErrorAdmin pos error_admin))
......@@ -160,6 +161,27 @@ where
// ---> ("compare_instance_defs", dcl_instance_def.ins_ident, dcl_instance_def.ins_type, icl_instance_def.ins_ident, icl_instance_def.ins_type)
compareGenericDefs :: !{# Int} !{#Bool} !{# GenericDef} !u:{# GenericDef} !*CompareState -> (!u:{# GenericDef}, !*CompareState)
compareGenericDefs dcl_sizes copied_from_dcl dcl_generic_defs icl_generic_defs comp_st
# nr_of_dcl_generics = dcl_sizes.[cGenericDefs]
= iFoldSt (compare_generic_defs copied_from_dcl dcl_generic_defs) 0 nr_of_dcl_generics (icl_generic_defs, comp_st)
where
compare_generic_defs :: !{#Bool} !{# GenericDef} !Index (!u:{# GenericDef}, !*CompareState) -> (!u:{# GenericDef}, !*CompareState)
compare_generic_defs copied_from_dcl dcl_generic_defs generic_index (icl_generic_defs, comp_st)
| not copied_from_dcl.[generic_index]
# dcl_generic_def = dcl_generic_defs.[generic_index]
(icl_generic_def, icl_generic_defs) = icl_generic_defs![generic_index]
# (ok1, comp_st) = compare dcl_generic_def.gen_type icl_generic_def.gen_type comp_st
# (ok2, comp_st) = compare dcl_generic_def.gen_vars icl_generic_def.gen_vars comp_st
| ok1 && ok2
= (icl_generic_defs, comp_st)
# comp_error = compareError generic_def_error (newPosition icl_generic_def.gen_name icl_generic_def.gen_pos) comp_st.comp_error
= (icl_generic_defs, { comp_st & comp_error = comp_error })
| otherwise
= (icl_generic_defs, comp_st)
class compare a :: !a !a !*CompareState -> (!Bool, !*CompareState)
......@@ -384,13 +406,14 @@ compareDefImp main_dcl_module_n main_dcl_module=:{dcl_macro_conversions=Yes macr
// && Trace_array macro_defs.[main_dcl_module_n]
# {dcl_functions,dcl_macros,dcl_common} = main_dcl_module
{icl_common, icl_functions, icl_copied_from_dcl = {copied_type_defs,copied_class_defs}}
{icl_common, icl_functions, icl_copied_from_dcl = {copied_type_defs,copied_class_defs,copied_generic_defs}}
= icl_module
{hp_var_heap, hp_expression_heap, hp_type_heaps={th_vars, th_attrs}}
= heaps
{ com_cons_defs=icl_com_cons_defs, com_type_defs = icl_com_type_defs,
com_selector_defs=icl_com_selector_defs, com_class_defs = icl_com_class_defs,
com_member_defs=icl_com_member_defs, com_instance_defs = icl_com_instance_defs }
com_member_defs=icl_com_member_defs, com_instance_defs = icl_com_instance_defs,
com_generic_defs=icl_com_generic_defs}
= icl_common
comp_st
= { comp_type_var_heap = th_vars
......@@ -408,6 +431,11 @@ compareDefImp main_dcl_module_n main_dcl_module=:{dcl_macro_conversions=Yes macr
(icl_com_instance_defs, comp_st)
= compareInstanceDefs main_dcl_module.dcl_sizes dcl_common.com_instance_defs icl_com_instance_defs comp_st
(icl_com_generic_defs, comp_st)
= compareGenericDefs
main_dcl_module.dcl_sizes copied_generic_defs
dcl_common.com_generic_defs icl_com_generic_defs comp_st
{ comp_type_var_heap = th_vars, comp_attr_var_heap = th_attrs, comp_error = error_admin } = comp_st
tc_state
......@@ -424,9 +452,10 @@ compareDefImp main_dcl_module_n main_dcl_module=:{dcl_macro_conversions=Yes macr
icl_common
= { icl_common & com_cons_defs=icl_com_cons_defs, com_type_defs = icl_com_type_defs,
com_selector_defs=icl_com_selector_defs, com_class_defs=icl_com_class_defs,
com_member_defs=icl_com_member_defs, com_instance_defs = icl_com_instance_defs }
heaps
= { hp_var_heap = hp_var_heap, hp_expression_heap = hp_expression_heap,
com_member_defs=icl_com_member_defs, com_instance_defs = icl_com_instance_defs,
com_generic_defs=icl_com_generic_defs }
heaps
= { heaps & hp_var_heap = hp_var_heap, hp_expression_heap = hp_expression_heap,
hp_type_heaps = { th_vars = tc_type_vars.hwn_heap, th_attrs = tc_attr_vars.hwn_heap}}
= ({ icl_module & icl_common = icl_common, icl_functions = icl_functions },macro_defs,heaps, error_admin )
......
......@@ -18,6 +18,9 @@ nsFromTo :: !Int -> NumberSet
// all numbers from 0 to (i-1)
bitvectToNumberSet :: !LargeBitvect -> .NumberSet
numberSetToList :: !NumberSet -> [Int]
:: LargeBitvect :== {#Int}
bitvectCreate :: !Int -> .LargeBitvect
......