Commit 93d85ad0 authored by Martin Wierich's avatar Martin Wierich
Browse files

making kind checking phase compatible with dcl caching

parent ae7da8f1
......@@ -365,7 +365,7 @@ where
//| ins_generate
// = (instance_types, class_defs, member_defs, generic_defs, type_defs, modules, var_heap, type_heaps, cs)
| size ins_members <> 1
# cs = { cs & cs_error = checkError gen_name "generic instance must have one memeber" cs.cs_error }
# cs = { cs & cs_error = checkError gen_name "generic instance must have one member" cs.cs_error }
= (instance_types, class_defs, member_defs, generic_defs, type_defs, modules, var_heap, type_heaps, cs)
# member_name = ins_members.[0].ds_ident
| member_name <> gen_member_name
......@@ -385,6 +385,7 @@ where
= (instance_types, member_defs, type_defs, modules, var_heap, type_heaps, cs)
# ins_member = ins_members.[mem_offset]
class_member = class_members.[mem_offset]
cs = setErrorAdmin (newPosition class_name ins_pos) cs
| 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 class_name ins_pos ins_type
instance_types member_defs type_defs modules var_heap type_heaps
......@@ -394,10 +395,8 @@ where
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_symb, me_type,me_class_vars,me_pos}, member_defs, modules) = getMemberDef member_mod_index class_member.ds_index module_index member_defs modules
cs_error = pushErrorAdmin (newPosition class_name ins_pos) cs.cs_error
(instance_type, _, type_heaps, Yes (modules, type_defs), Yes cs_error)
= determineTypeOfMemberInstance me_type me_class_vars ins_type SP_None type_heaps (Yes (modules, type_defs, x_main_dcl_module_n)) (Yes cs_error)
cs_error = popErrorAdmin cs_error
= determineTypeOfMemberInstance me_type me_class_vars ins_type SP_None type_heaps (Yes (modules, type_defs, x_main_dcl_module_n)) (Yes cs.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 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 }
......@@ -1332,8 +1331,7 @@ checkDclModules imports_of_icl_mod dcl_modules icl_functions heaps cs=:{cs_symbo
= { ini_symbol_nr = nr_of_expl_imp_symbols, ini_imp_decl = imp_decl }
-> ([ident:expl_imp_symbols_accu], nr_of_expl_imp_symbols+1,
[ini:expl_imp_indices_accu], cs_symbol_table)
//import StdDebug
checkDclComponent :: !{![Int]} !{![Int]} ![[(Index, Position, [ImportNrAndIdents])]] ![Int]
!(!Int, !*ExplImpInfos, !*{# DclModule}, !*{# FunDef}, !*Heaps,!*CheckState)
......@@ -1523,7 +1521,8 @@ checkDclModuleWithinComponent dcl_imported_module_numbers component_nr is_on_cyc
checkModule :: !ScannedModule !IndexRange ![FunDef] !Int !Int !(Optional ScannedModule) ![ScannedModule] !{#DclModule} !{#FunDef} !*PredefinedSymbols !*SymbolTable !*File !*Heaps
-> (!Bool, *IclModule, *{# DclModule}, *{! Group}, !(Optional {# Index}), !.{#FunDef},!Int, !*Heaps, !*PredefinedSymbols, !*SymbolTable, *File, [String])
checkModule m icl_global_function_range fun_defs n_functions_and_macros_in_dcl_modules dcl_module_n_in_cache optional_dcl_mod scanned_modules dcl_modules functions_and_macros predef_symbols symbol_table err_file heaps
checkModule m icl_global_function_range fun_defs n_functions_and_macros_in_dcl_modules dcl_module_n_in_cache
optional_dcl_mod scanned_modules dcl_modules functions_and_macros predef_symbols symbol_table err_file heaps
// | False--->("checkModule", m.mod_name)
// = undef
# (optional_pre_def_mod,predef_symbols)
......@@ -1562,7 +1561,10 @@ check_module1 {mod_type,mod_name,mod_imports,mod_imported_objects,mod_defs = cde
init_new_dcl_modules = gimme_a_strict_array_type { initialDclModule scanned_module module_n \\ scanned_module <- scanned_modules & module_n<-[size dcl_modules..]}
init_dcl_modules = {if (i<size dcl_modules) dcl_modules.[i] init_new_dcl_modules.[i-size dcl_modules] \\ i<-[0..size dcl_modules+size init_new_dcl_modules-1]}
init_dcl_modules = { if (i<size dcl_modules)
{ dcl_modules.[i] & dcl_is_cashed = True }
init_new_dcl_modules.[i-size dcl_modules]
\\ i<-[0..size dcl_modules+size init_new_dcl_modules-1]}
= (mod_name,mod_imported_objects,mod_imports,mod_type,icl_global_function_range,nr_of_functions,first_inst_index,local_defs,icl_functions,init_dcl_modules,main_dcl_module_n,cdefs,sizes,cs)
where
......@@ -2162,7 +2164,8 @@ initialDclModule ({mod_name, mod_defs=mod_defs=:{def_funtypes,def_macros}, mod_t
, dcl_is_system = case mod_type of
MK_System -> True
_ -> False
, dcl_imported_module_numbers = EndNumbers
, dcl_imported_module_numbers = EndNumbers
, dcl_is_cashed = False
}
addImportedSymbolsToSymbolTable importing_mod opt_macro_range modules_in_component_set imports_ikh
......
......@@ -2,5 +2,5 @@ definition module checkKindCorrectness
import syntax, checksupport, containers
checkKindCorrectness :: !NumberSet !Index IndexRange !{#CommonDefs} !{#DclModule} !u:{# FunDef} !*TypeVarHeap !*TypeDefInfos !*ErrorAdmin
-> (!u:{# FunDef}, !*TypeVarHeap, !*TypeDefInfos, !*ErrorAdmin)
checkKindCorrectness :: !Index IndexRange !u:{# FunDef} !{#CommonDefs} !*{#DclModule} !*TypeVarHeap !*TypeDefInfos !*ErrorAdmin
-> (!u:{# FunDef}, !*{#DclModule}, !*TypeVarHeap, !*TypeDefInfos, !*ErrorAdmin)
......@@ -5,55 +5,83 @@ import syntax, containers, checksupport, utilities
// import RWSDebug
checkKindCorrectness :: !NumberSet !Index IndexRange !{#CommonDefs} !{#DclModule} !u:{# FunDef} !*TypeVarHeap !*TypeDefInfos !*ErrorAdmin
-> (!u:{# FunDef}, !*TypeVarHeap, !*TypeDefInfos, !*ErrorAdmin)
checkKindCorrectness icl_used_module_numbers main_dcl_module_n icl_instances common_defs dcl_mods
fun_defs th_vars td_infos error_admin
#! n_fun_defs = size fun_defs
# (th_vars, td_infos, error_admin)
checkKindCorrectness :: !Index IndexRange !u:{# FunDef} !{#CommonDefs} !*{#DclModule} !*TypeVarHeap !*TypeDefInfos !*ErrorAdmin
-> (!u:{# FunDef}, !*{#DclModule}, !*TypeVarHeap, !*TypeDefInfos, !*ErrorAdmin)
checkKindCorrectness main_dcl_module_n icl_instances fun_defs common_defs
dcl_mods th_vars td_infos error_admin
#! n_fun_defs
= size fun_defs
size_dcl_mods
= size dcl_mods
# (bv_cashed_modules, dcl_mods)
= iFoldSt mark_cashed_module
0 size_dcl_mods (bitvectCreate size_dcl_mods, dcl_mods)
(dcl_mods, th_vars, td_infos, error_admin)
= iFoldSt (\mod_index state
-> if (inNumberSet mod_index icl_used_module_numbers)
(check_kind_correctness_of_classes common_defs common_defs.[mod_index] state)
state)
0 (size dcl_mods) (th_vars, td_infos, error_admin)
th_vars = th_vars
(th_vars, td_infos, error_admin)
-> if (bitvectSelect mod_index bv_cashed_modules)
state
(check_kind_correctness_of_classes mod_index state))
0 size_dcl_mods (dcl_mods, th_vars, td_infos, error_admin)
icl_common_defs
= common_defs.[main_dcl_module_n]
(_, th_vars, td_infos, error_admin)
= foldrArraySt (check_kind_correctness_of_class icl_common_defs.com_member_defs)
icl_common_defs.com_class_defs
([], th_vars, td_infos, error_admin)
bv_uninitialized_mods
= {el\\el<-:bv_cashed_modules}
(bv_uninitialized_mods, th_vars, td_infos, error_admin)
= iFoldSt (\mod_index state
-> if (inNumberSet mod_index icl_used_module_numbers)
-> if (bitvectSelect mod_index bv_cashed_modules)
state
(check_kind_correctness_of_instances_and_class_and_member_contexts
common_defs common_defs.[mod_index] state)
state)
0 (size dcl_mods) (th_vars, td_infos, error_admin)
common_defs common_defs.[mod_index] state))
0 size_dcl_mods (bv_uninitialized_mods, th_vars, td_infos, error_admin)
// check_kind_correctness_of_icl_function: don't check the types that were generated for instances
th_vars = th_vars
state
= iFoldSt check_kind_correctness_of_icl_function 0 icl_instances.ir_from
(fun_defs, th_vars, td_infos, error_admin)
(fun_defs, th_vars, td_infos, error_admin)
= iFoldSt check_kind_correctness_of_icl_function icl_instances.ir_to n_fun_defs state
th_vars = th_vars
(th_vars, td_infos, error_admin)
= iFoldSt (check_kind_correctness_of_icl_function common_defs) 0 icl_instances.ir_from
(fun_defs, bv_uninitialized_mods, th_vars, td_infos, error_admin)
(fun_defs, bv_uninitialized_mods, th_vars, td_infos, error_admin)
= iFoldSt (check_kind_correctness_of_icl_function common_defs) icl_instances.ir_to n_fun_defs state
(dcl_mods, bv_uninitialized_mods, th_vars, td_infos, error_admin)
= iFoldSt (\mod_index state
-> if (inNumberSet mod_index icl_used_module_numbers && mod_index<>main_dcl_module_n)
(check_kind_correctness_of_dcl_functions common_defs dcl_mods.[mod_index]
state)
state)
0 (size dcl_mods)
(th_vars, td_infos, error_admin)
th_vars = th_vars
= (fun_defs, th_vars, td_infos, error_admin)
-> if (bitvectSelect mod_index bv_cashed_modules || mod_index==main_dcl_module_n)
state
(check_kind_correctness_of_dcl_functions common_defs mod_index state))
0 size_dcl_mods
(dcl_mods, bv_uninitialized_mods, th_vars, td_infos, error_admin)
= (fun_defs, dcl_mods, th_vars, td_infos, error_admin)
where
check_kind_correctness_of_classes common_defs {com_class_defs, com_member_defs} state
= foldlArraySt (check_kind_correctness_of_class common_defs com_member_defs) com_class_defs state
check_kind_correctness_of_class common_defs com_member_defs {class_name, class_args, class_members}
(th_vars, td_infos, error_admin)
mark_cashed_module mod_index (bitvect, dcl_mods)
| dcl_mods.[mod_index].dcl_is_cashed
= (bitvectSet mod_index bitvect, dcl_mods)
= (bitvect, dcl_mods)
check_kind_correctness_of_classes mod_index (dcl_mods, th_vars, td_infos, error_admin)
# (dcl_mod, dcl_mods)
= dcl_mods![mod_index]
{com_class_defs, com_member_defs}
= dcl_mod.dcl_common
(class_defs_with_cacheable_kind_info, th_vars, td_infos, error_admin)
= foldrArraySt (check_kind_correctness_of_class com_member_defs) com_class_defs
([], th_vars, td_infos, error_admin)
dcl_mods
= { dcl_mods & [mod_index].dcl_common.com_class_defs
= { el \\ el <- class_defs_with_cacheable_kind_info }}
= (dcl_mods, th_vars, td_infos, error_admin)
check_kind_correctness_of_class com_member_defs class_def=:{class_name, class_args, class_members}
(class_defs_accu, th_vars, td_infos, error_admin)
# th_vars
= foldSt init_type_var class_args th_vars
= foldlArraySt (\{ds_index} state
-> check_kind_correctness_of_member_without_context common_defs class_args
com_member_defs.[ds_index] state)
class_members (th_vars, td_infos, error_admin)
check_kind_correctness_of_member_without_context common_defs class_args
(th_vars, td_infos, error_admin)
= foldlArraySt (\{ds_index} state
-> check_kind_correctness_of_member_without_context class_args
com_member_defs.[ds_index] state)
class_members (th_vars, td_infos, error_admin)
(derived_kinds, th_vars)
= mapFilterYesSt get_opt_kind class_args th_vars
= ([{ class_def & class_arg_kinds = derived_kinds }:class_defs_accu], th_vars, td_infos, error_admin)
check_kind_correctness_of_member_without_context class_args
{me_symb, me_pos, me_class_vars, me_type=me_type=:{st_vars, st_args, st_result}}
(th_vars, td_infos, error_admin)
# error_admin
......@@ -83,72 +111,115 @@ checkKindCorrectness icl_used_module_numbers main_dcl_module_n icl_instances com
com_class_defs state
= state
check_kind_correctness_of_instance common_defs {ins_is_generic, ins_class, ins_ident, ins_pos, ins_type}
(th_vars, td_infos, error_admin)
(bv_uninitialized_mods, th_vars, td_infos, error_admin)
| ins_is_generic
// kind correctness of user suppliedg eneric instances
// kind correctness of user supplied generic instances
// is checked during generic phase
= (th_vars, td_infos, error_admin)
| otherwise
# {class_args}
= common_defs.[ins_class.glob_module].com_class_defs.[ins_class.glob_object.ds_index]
(expected_kinds, th_vars)
= mapSt get_tvi class_args th_vars
error_admin
= setErrorAdmin (newPosition ins_ident ins_pos) error_admin
th_vars
= foldSt init_type_var ins_type.it_vars th_vars
state
= unsafeFold3St possibly_check_kind_correctness_of_type expected_kinds [1..]
ins_type.it_types (th_vars, td_infos, error_admin)
state
= foldSt (check_kind_correctness_of_context common_defs) ins_type.it_context state
= state
= (bv_uninitialized_mods, th_vars, td_infos, error_admin)
# (expected_kinds, bv_uninitialized_mods, th_vars)
= get_expected_kinds ins_class common_defs bv_uninitialized_mods th_vars
error_admin
= setErrorAdmin (newPosition ins_ident ins_pos) error_admin
th_vars
= foldSt init_type_var ins_type.it_vars th_vars
(th_vars, td_infos, error_admin)
= unsafeFold3St possibly_check_kind_correctness_of_type expected_kinds [1..]
ins_type.it_types (th_vars, td_infos, error_admin)
state
= foldSt (check_kind_correctness_of_context common_defs) ins_type.it_context
(bv_uninitialized_mods, th_vars, td_infos, error_admin)
= state
get_expected_kinds class_index=:{glob_module, glob_object} common_defs bv_uninitialized_mods th_vars
| bitvectSelect glob_module bv_uninitialized_mods
/* the desired class is defined in a module which is a cached one
=> check_kind_correctness_of_classes has not been called for all the classes
within that module
=> the kind information for the class args is not in the heap
=> put it in the heap now
*/
# th_vars
= foldlArraySt write_kind_info common_defs.[glob_module].com_class_defs th_vars
= get_expected_kinds class_index common_defs (bitvectReset glob_module bv_uninitialized_mods)
th_vars
# {class_args, class_arg_kinds}
= common_defs.[glob_module].com_class_defs.[glob_object.ds_index]
(expected_kinds, th_vars)
= mapSt get_tvi class_args th_vars
= (expected_kinds, bv_uninitialized_mods, th_vars)
write_kind_info {class_name, class_args, class_arg_kinds} th_vars
= write_ki class_args class_arg_kinds th_vars
write_ki [{tv_info_ptr}:class_args] [class_arg_kind:class_arg_kinds] th_vars
= write_ki class_args class_arg_kinds (writePtr tv_info_ptr (TVI_Kind class_arg_kind) th_vars)
write_ki [{tv_info_ptr}:class_args] [] th_vars
= write_ki class_args [] (writePtr tv_info_ptr TVI_Empty th_vars)
write_ki [] [] th_vars
= th_vars
possibly_check_kind_correctness_of_type TVI_Empty _ _ state
// This can happen for stooopid classes like StdClass::Ord, where the member type is ignored at all
= state
possibly_check_kind_correctness_of_type (TVI_Kind expected_kind) arg_nr type state
= check_kind_correctness_of_type expected_kind arg_nr type state
check_kind_correctness_of_class_context_and_member_contexts common_defs com_member_defs
{class_name, class_pos, class_context, class_members} (th_vars, td_infos, error_admin)
{class_name, class_pos, class_context, class_members, class_args}
(bv_uninitialized_mods, th_vars, td_infos, error_admin)
# error_admin
= setErrorAdmin (newPosition class_name class_pos) error_admin
state
= foldSt (check_kind_correctness_of_context common_defs) class_context
(th_vars, td_infos, error_admin)
(bv_uninitialized_mods, th_vars, td_infos, error_admin)
state
= foldlArraySt (check_kind_correctness_of_member_context common_defs com_member_defs)
class_members state
= state
check_kind_correctness_of_member_context common_defs com_member_defs {ds_index}
(th_vars, td_infos, error_admin)
(bv_uninitialized_mods, th_vars, td_infos, error_admin)
# {me_symb, me_pos, me_type}
= com_member_defs.[ds_index]
error_admin
= setErrorAdmin (newPosition me_symb me_pos) error_admin
= foldSt (check_kind_correctness_of_context common_defs) me_type.st_context
(th_vars, td_infos, error_admin)
(bv_uninitialized_mods, th_vars, td_infos, error_admin)
get_tvi {tv_info_ptr} th_vars
= readPtr tv_info_ptr th_vars
check_kind_correctness_of_icl_function fun_n (fun_defs, th_vars, td_infos, error_admin)
get_opt_kind {tv_info_ptr} th_vars
# (tvi, th_vars)
= readPtr tv_info_ptr th_vars
#! opt_kind
= case tvi of
TVI_Kind kind -> Yes kind
_ -> No
= (opt_kind, th_vars)
check_kind_correctness_of_icl_function common_defs fun_n
(fun_defs, bv_uninitialized_mods, th_vars, td_infos, error_admin)
# (fun_def, fun_defs) = fun_defs![fun_n]
= case fun_def.fun_type of
No
-> (fun_defs, th_vars, td_infos, error_admin)
-> (fun_defs, bv_uninitialized_mods, th_vars, td_infos, error_admin)
Yes st
# (th_vars, td_infos, error_admin)
# (bv_uninitialized_mods, th_vars, td_infos, error_admin)
= check_kind_correctness_of_symbol_type common_defs fun_def.fun_symb fun_def.fun_pos
st (th_vars, td_infos, error_admin)
-> (fun_defs, th_vars, td_infos, error_admin)
check_kind_correctness_of_dcl_functions common_defs {dcl_functions, dcl_instances, dcl_macros} state
= iFoldSt (\i state
-> if (in_index_range i dcl_instances || in_index_range i dcl_macros) // yawn
state
(let ({ft_symb, ft_pos, ft_type}) = dcl_functions.[i]
in check_kind_correctness_of_symbol_type common_defs ft_symb ft_pos ft_type
state))
0 (size dcl_functions) state
check_kind_correctness_of_symbol_type common_defs fun_symb fun_pos
st=:{st_vars, st_args, st_result, st_context} (th_vars, td_infos, error_admin)
st (bv_uninitialized_mods, th_vars, td_infos, error_admin)
-> (fun_defs, bv_uninitialized_mods, th_vars, td_infos, error_admin)
check_kind_correctness_of_dcl_functions common_defs mod_index
(dcl_mods, bv_uninitialized_mods, th_vars, td_infos, error_admin)
# ({dcl_functions, dcl_instances, dcl_macros}, dcl_mods)
= dcl_mods![mod_index]
(bv_uninitialized_mods, th_vars, td_infos, error_admin)
= iFoldSt (\i state
-> if (in_index_range i dcl_instances || in_index_range i dcl_macros) // yawn
state
(let ({ft_symb, ft_pos, ft_type}) = dcl_functions.[i]
in check_kind_correctness_of_symbol_type common_defs ft_symb ft_pos ft_type
state))
0 (size dcl_functions) (bv_uninitialized_mods, th_vars, td_infos, error_admin)
= (dcl_mods, bv_uninitialized_mods, th_vars, td_infos, error_admin)
check_kind_correctness_of_symbol_type common_defs fun_symb fun_pos
st=:{st_vars, st_args, st_result, st_context}
(bv_uninitialized_mods, th_vars, td_infos, error_admin)
# error_admin
= setErrorAdmin (newPosition fun_symb fun_pos) error_admin
th_vars
......@@ -156,9 +227,10 @@ checkKindCorrectness icl_used_module_numbers main_dcl_module_n icl_instances com
(th_vars, td_infos, error_admin)
= unsafeFold2St (check_kind_correctness_of_atype KindConst)
[0..] [st_result:st_args] (th_vars, td_infos, error_admin)
(th_vars, td_infos, error_admin)
= foldSt (check_kind_correctness_of_context common_defs) st_context (th_vars, td_infos, error_admin)
= (th_vars, td_infos, error_admin)
(bv_uninitialized_mods, th_vars, td_infos, error_admin)
= foldSt (check_kind_correctness_of_context common_defs) st_context
(bv_uninitialized_mods, th_vars, td_infos, error_admin)
= (bv_uninitialized_mods, th_vars, td_infos, error_admin)
check_kind_correctness_of_atype expected_kind arg_nr {at_type} state
= check_kind_correctness_of_type expected_kind arg_nr at_type state
check_kind_correctness_of_type expected_kind arg_nr (TA {type_name,type_index} args)
......@@ -208,22 +280,21 @@ checkKindCorrectness icl_used_module_numbers main_dcl_module_n icl_instances com
= check_equality_of_kinds arg_nr expected_kind KindConst error_admin
= (th_vars, td_infos, error_admin)
check_kind_correctness_of_context common_defs {tc_class, tc_types} (th_vars, td_infos, error_admin)
# {class_args}
= common_defs.[tc_class.glob_module].com_class_defs.[tc_class.glob_object.ds_index]
(expected_kinds, th_vars)
= mapSt get_tvi class_args th_vars
state
check_kind_correctness_of_context common_defs {tc_class, tc_types}
(bv_uninitialized_mods, th_vars, td_infos, error_admin)
# (expected_kinds, bv_uninitialized_mods, th_vars)
= get_expected_kinds tc_class common_defs bv_uninitialized_mods th_vars
(th_vars, td_infos, error_admin)
= unsafeFold3St possibly_check_kind_correctness_of_type expected_kinds (descending (-1))
tc_types (th_vars, td_infos, error_admin)
= state
= (bv_uninitialized_mods, th_vars, td_infos, error_admin)
where
descending i = [i:descending (i-1)]
init_type_var {tv_info_ptr} th_vars
= writePtr tv_info_ptr TVI_Empty th_vars
unify_var_kinds expected_kind {tv_name, tv_info_ptr} th_vars error_admin
unify_var_kinds expected_kind tv=:{tv_name, tv_info_ptr} th_vars error_admin
# (tvi, th_vars)
= readPtr tv_info_ptr th_vars
= case tvi of
......@@ -237,7 +308,7 @@ checkKindCorrectness icl_used_module_numbers main_dcl_module_n icl_instances com
check_equality_of_kinds arg_nr expected_kind kind error_admin
| expected_kind==kind
= error_admin
= checkError "inconsistent kind in " (arg_nr_to_string arg_nr) error_admin
= checkError "inconsistent kind in" (arg_nr_to_string arg_nr) error_admin
arg_nr_to_string 0 = "result type"
arg_nr_to_string i
......@@ -245,5 +316,17 @@ checkKindCorrectness icl_used_module_numbers main_dcl_module_n icl_instances com
= "type of argument nr "+++toString i
= "type context nr "+++toString (~i)
get_common_defs dcl_mods
#! size = size dcl_mods
# ({dcl_common=arbitrary_value_for_initializing}, dcl_mods) = dcl_mods![0]
= loop 0 (createArray size arbitrary_value_for_initializing) dcl_mods
where
loop :: !Int !*{#CommonDefs} !u:{#DclModule} -> (!*{#CommonDefs}, !u:{#DclModule})
loop i common_defs dcl_mods
| i==size dcl_mods
= (common_defs, dcl_mods)
# ({dcl_common}, dcl_mods) = dcl_mods![i]
= loop (i+1) { common_defs & [i] = dcl_common } dcl_mods
in_index_range test ir :== test>=ir.ir_from && test < ir.ir_to
......@@ -107,6 +107,7 @@ cConversionTableSize :== 9 // AA
, dcl_conversions :: !Optional ConversionTable
, dcl_is_system :: !Bool
, dcl_imported_module_numbers :: !NumberSet
, dcl_is_cashed :: !Bool
}
class Erroradmin state
......
......@@ -120,6 +120,7 @@ where
, dcl_conversions :: !Optional ConversionTable
, dcl_is_system :: !Bool
, dcl_imported_module_numbers :: !NumberSet
, dcl_is_cashed :: !Bool
}
class Erroradmin state // PK...
......
......@@ -123,16 +123,16 @@ frontEndInterface upToPhase mod_ident search_paths dcl_modules functions_and_mac
// AA..
# error_admin = {ea_file = error, ea_loc = [], ea_ok = True }
# ti_common_defs = {dcl_common \\ {dcl_common} <-: dcl_mods }
# (saved_main_dcl_common, ti_common_defs) = replace ti_common_defs main_dcl_module_n icl_common
# (ti_common_defs, dcl_mods) = get_common_defs dcl_mods
ti_common_defs = { ti_common_defs & [main_dcl_module_n] = icl_common }
# (td_infos, type_heaps, error_admin) = analTypeDefs ti_common_defs icl_used_module_numbers type_heaps error_admin
(fun_defs, th_vars, td_infos, error_admin)
= checkKindCorrectness icl_used_module_numbers main_dcl_module_n icl_instances
ti_common_defs dcl_mods fun_defs type_heaps.th_vars td_infos error_admin
(fun_defs, dcl_mods, th_vars, td_infos, error_admin)
= checkKindCorrectness main_dcl_module_n icl_instances
fun_defs ti_common_defs dcl_mods type_heaps.th_vars td_infos error_admin
type_heaps = { type_heaps & th_vars = th_vars }
# heaps = { heaps & hp_type_heaps = type_heaps }
# ti_common_defs = {dcl_common \\ {dcl_common} <-: dcl_mods }
# (saved_main_dcl_common, ti_common_defs) = replace ti_common_defs main_dcl_module_n icl_common
#! (components, ti_common_defs, fun_defs, generic_range, td_infos, heaps, hash_table, predef_symbols, dcl_mods, optional_dcl_icl_conversions, error_admin) =
case SupportGenerics of
......@@ -249,6 +249,17 @@ frontEndInterface upToPhase mod_ident search_paths dcl_modules functions_and_mac
= fill_empty_positions (inc next_index) table_size (inc next_new_index) { icl_conversions & [next_index] = next_new_index }
= fill_empty_positions (inc next_index) table_size next_new_index icl_conversions
= icl_conversions
get_common_defs dcl_mods
#! size = size dcl_mods
# ({dcl_common=arbitrary_value_for_initializing}, dcl_mods) = dcl_mods![0]
= loop 0 (createArray size arbitrary_value_for_initializing) dcl_mods
where
loop :: !Int !*{#CommonDefs} !u:{#DclModule} -> (!*{#CommonDefs}, !u:{#DclModule})
loop i common_defs dcl_mods
| i==size dcl_mods
= (common_defs, dcl_mods)
# ({dcl_common}, dcl_mods) = dcl_mods![i]
= loop (i+1) { common_defs & [i] = dcl_common } dcl_mods
newSymbolTable :: !Int -> *{# SymbolTableEntry}
newSymbolTable size
......
......@@ -1680,7 +1680,8 @@ buildClassDef
class_pos = gen_pos,
class_members = createArray 1 class_member,
class_cons_vars = case kind of KindConst -> 0; _ -> 1,
class_dictionary = class_dictionary
class_dictionary = class_dictionary,
class_arg_kinds = [kind]
}
#! com_class_defs = append_array com_class_defs class_def
......@@ -1772,7 +1773,8 @@ where
class_pos = gen_pos,
class_members = createArray 1 class_member,
class_cons_vars = case kind of KindConst -> 0; _ -> 1,
class_dictionary = class_dictionary
class_dictionary = class_dictionary,
class_arg_kinds = [kind]
}
= class_def
......
......@@ -1020,7 +1020,8 @@ wantClassDefinition context pos pState
(members, pState) = wantDefinitions (SetLocalContext context) pState
class_def = { class_name = class_id, class_arity = class_arity, class_args = class_args,
class_context = contexts, class_pos = pos, class_members = {}, class_cons_vars = class_cons_vars,
class_dictionary = { ds_ident = { class_id & id_info = nilPtr }, ds_arity = 0, ds_index = NoIndex }}
class_dictionary = { ds_ident = { class_id & id_info = nilPtr }, ds_arity = 0, ds_index = NoIndex },
class_arg_kinds = []}
pState = wantEndGroup "class" pState
= (PD_Class class_def members, pState)
| isEmpty contexts
......@@ -1030,7 +1031,8 @@ wantClassDefinition context pos pState
(class_id, pState) = stringToIdent class_or_member_name IC_Class pState
class_def = { class_name = class_id, class_arity = class_arity, class_args = class_args,
class_context = contexts, class_pos = pos, class_members = {}, class_cons_vars = class_cons_vars,
class_dictionary = { ds_ident = { class_id & id_info = nilPtr }, ds_arity = 0, ds_index = NoIndex }}
class_dictionary = { ds_ident = { class_id & id_info = nilPtr }, ds_arity = 0, ds_index = NoIndex },
class_arg_kinds = []}
pState = wantEndOfDefinition "class definition" pState
= (PD_Class class_def [], pState)
= (PD_Erroneous, parseError "Class Definition" (Yes token) "<class definition>" pState)
......@@ -1077,7 +1079,8 @@ wantClassDefinition context pos pState
member = PD_TypeSpec pos member_id prio (Yes tspec) SP_None
class_def = { class_name = class_id, class_arity = class_arity, class_args = class_args,
class_context = contexts, class_pos = pos, class_members = {}, class_cons_vars = class_cons_vars,
class_dictionary = { ds_ident = { class_id & id_info = nilPtr }, ds_arity = 0, ds_index = NoIndex }}
class_dictionary = { ds_ident = { class_id & id_info = nilPtr }, ds_arity = 0, ds_index = NoIndex },
class_arg_kinds = []}
pState = wantEndOfDefinition "overloaded function" pState
= (PD_Class class_def [member], pState)
......
......@@ -371,7 +371,8 @@ where
class_def = { class_name = tc_class_name.pds_ident, class_arity = 1, class_args = [class_var], class_context = [],
class_members = {{ds_ident = tc_member_name.pds_ident, ds_index = cTCMemberSymbIndex, ds_arity = 0 }}, class_cons_vars = 0,
class_dictionary = { ds_ident = { tc_class_name.pds_ident & id_info = nilPtr }, ds_arity = 0, ds_index = NoIndex }, class_pos = NoPos }
class_dictionary = { ds_ident = { tc_class_name.pds_ident & id_info = nilPtr }, ds_arity = 0, ds_index = NoIndex }, class_pos = NoPos,
class_arg_kinds = [] }
= (class_def, member_def, pre_def_symbols)
......
......@@ -242,6 +242,7 @@ cNameLocationDependent :== True
, class_dictionary :: !DefinedSymbol
, class_pos :: !Position
, class_cons_vars :: !BITVECT
, class_arg_kinds :: ![TypeKind] // filled in in checkKindCorrectness phase
}
:: MemberDef =
......
......@@ -236,6 +236,7 @@ cNameLocationDependent :== True
, class_dictionary :: !DefinedSymbol