Commit 62cb857f authored by clean's avatar clean
Browse files

Merge Martin/ Sjaak & Ronny branches

parent e783db98
...@@ -309,7 +309,8 @@ analTypeDef modules type_module type_index as=:{as_error,as_heaps,as_kind_heap,a ...@@ -309,7 +309,8 @@ analTypeDef modules type_module type_index as=:{as_error,as_heaps,as_kind_heap,a
| is_abs_type | is_abs_type
# (tdi, as_td_infos) = as_td_infos![type_module].[type_index] # (tdi, as_td_infos) = as_td_infos![type_module].[type_index]
tdi = { tdi & tdi_kinds = [ KindConst \\ _ <- td_args ], tdi_group = [{glob_module = type_module, glob_object = type_index}], tdi = { tdi & tdi_kinds = [ KindConst \\ _ <- td_args ], tdi_group = [{glob_module = type_module, glob_object = type_index}],
tdi_group_vars = [ i \\ _ <- td_args & i <- [0..]], tdi_properties = abs_type_properties } tdi_group_vars = [ i \\ _ <- td_args & i <- [0..]], tdi_properties = abs_type_properties,
tdi_tmp_index = 0 }
= (cMAXINT, ({con_top_var_binds = [], con_var_binds = [] }, { as & as_td_infos = { as_td_infos & [type_module].[type_index] = tdi}})) = (cMAXINT, ({con_top_var_binds = [], con_var_binds = [] }, { as & as_td_infos = { as_td_infos & [type_module].[type_index] = tdi}}))
# position = newPosition td_name td_pos # position = newPosition td_name td_pos
as_error = pushErrorAdmin position as_error as_error = pushErrorAdmin position as_error
...@@ -429,7 +430,7 @@ where ...@@ -429,7 +430,7 @@ where
= (kind_store, kind_heap, { td_infos & [glob_module].[glob_object] = = (kind_store, kind_heap, { td_infos & [glob_module].[glob_object] =
{td_info & tdi_properties = type_properties, tdi_kinds = td_kinds, tdi_group = group, {td_info & tdi_properties = type_properties, tdi_kinds = td_kinds, tdi_group = group,
tdi_group_vars = group_vars, tdi_cons_vars = cons_vars, tdi_group_nr = group_nr, tdi_tmp_index = loc_type_index } }) tdi_group_vars = group_vars, tdi_cons_vars = cons_vars, tdi_group_nr = group_nr, tdi_tmp_index = loc_type_index } })
// ---> ("update_type_def_info", glob_module, glob_object, group_nr) // ---> ("update_type_def_info", glob_module, glob_object, (group_nr, loc_type_index))
where where
determine_type_def_info [ KindVar kind_info_ptr : kind_vars ] [ kind : kinds ] top_vars kind_store kind_heap determine_type_def_info [ KindVar kind_info_ptr : kind_vars ] [ kind : kinds ] top_vars kind_store kind_heap
#! kind_info = sreadPtr kind_info_ptr kind_heap #! kind_info = sreadPtr kind_info_ptr kind_heap
......
...@@ -30,7 +30,7 @@ typeProperties type_index module_index hio_signs hio_props defs type_var_heap td ...@@ -30,7 +30,7 @@ typeProperties type_index module_index hio_signs hio_props defs type_var_heap td
(tsp_propagation, type_var_heap, td_infos) = determinePropClassOfTypeDef type_index module_index td_args td_info hio_props defs type_var_heap td_infos (tsp_propagation, type_var_heap, td_infos) = determinePropClassOfTypeDef type_index module_index td_args td_info hio_props defs type_var_heap td_infos
tsp_coercible = (td_info.tdi_properties bitand cIsNonCoercible) == 0 tsp_coercible = (td_info.tdi_properties bitand cIsNonCoercible) == 0
= ({tsp_sign = tsp_sign, tsp_propagation = tsp_propagation, tsp_coercible = tsp_coercible }, type_var_heap, td_infos) = ({tsp_sign = tsp_sign, tsp_propagation = tsp_propagation, tsp_coercible = tsp_coercible }, type_var_heap, td_infos)
---> ("typeProperties", (td_name, type_index, module_index), tsp_sign, tsp_propagation) // ---> ("typeProperties", (td_name, type_index, module_index), tsp_sign, tsp_propagation)
signClassification :: !Index !Index ![SignClassification] !{# CommonDefs } !*TypeVarHeap !*TypeDefInfos signClassification :: !Index !Index ![SignClassification] !{# CommonDefs } !*TypeVarHeap !*TypeDefInfos
-> (!SignClassification, !*TypeVarHeap, !*TypeDefInfos) -> (!SignClassification, !*TypeVarHeap, !*TypeDefInfos)
...@@ -72,6 +72,7 @@ determineSignClassOfTypeDef type_index module_index td_args {tdi_classification, ...@@ -72,6 +72,7 @@ determineSignClassOfTypeDef type_index module_index td_args {tdi_classification,
No No
# signs_of_group_vars = foldSt (determine_signs_of_group_var tdi_cons_vars hio_signs) tdi_group_vars [] # signs_of_group_vars = foldSt (determine_signs_of_group_var tdi_cons_vars hio_signs) tdi_group_vars []
-> newSignClassOfTypeDefGroup tdi_group_nr { glob_module = module_index, glob_object = type_index} -> newSignClassOfTypeDefGroup tdi_group_nr { glob_module = module_index, glob_object = type_index}
// tdi_group (signs_of_group_vars ---> ("determine_signs_of_group_var", (module_index, type_index), signs_of_group_vars, tdi_group_vars)) ci type_var_heap td_infos
tdi_group signs_of_group_vars ci type_var_heap td_infos tdi_group signs_of_group_vars ci type_var_heap td_infos
where where
...@@ -132,6 +133,7 @@ where ...@@ -132,6 +133,7 @@ where
collect_sign_class_of_type_def group_nr signs_of_group_vars ci {glob_module,glob_object} (sign_requirements, type_var_heap, td_infos) collect_sign_class_of_type_def group_nr signs_of_group_vars ci {glob_module,glob_object} (sign_requirements, type_var_heap, td_infos)
# ({tdi_group_vars,tdi_kinds,tdi_tmp_index},td_infos) = td_infos![glob_module].[glob_object] # ({tdi_group_vars,tdi_kinds,tdi_tmp_index},td_infos) = td_infos![glob_module].[glob_object]
{td_name,td_args,td_rhs} = ci.[glob_module].com_type_defs.[glob_object] {td_name,td_args,td_rhs} = ci.[glob_module].com_type_defs.[glob_object]
// (rev_hio_signs, type_var_heap) = bind_type_vars_to_signs td_args (tdi_group_vars ---> ("bind_type_vars_to_signs",td_name, (glob_module, glob_object), tdi_group_vars)) tdi_kinds signs_of_group_vars ([], type_var_heap)
(rev_hio_signs, type_var_heap) = bind_type_vars_to_signs td_args tdi_group_vars tdi_kinds signs_of_group_vars ([], type_var_heap) (rev_hio_signs, type_var_heap) = bind_type_vars_to_signs td_args tdi_group_vars tdi_kinds signs_of_group_vars ([], type_var_heap)
(sign_env, scs) = sign_class_of_type_def glob_module td_rhs group_nr ci (sign_env, scs) = sign_class_of_type_def glob_module td_rhs group_nr ci
{scs_type_var_heap = type_var_heap, scs_type_def_infos = td_infos, scs_rec_appls = [] } {scs_type_var_heap = type_var_heap, scs_type_def_infos = td_infos, scs_rec_appls = [] }
...@@ -177,6 +179,8 @@ where ...@@ -177,6 +179,8 @@ where
| this_gv == gv | this_gv == gv
= sign = sign
= retrieve_sign this_gv signs = retrieve_sign this_gv signs
retrieve_sign this_gv [ ]
= TopSignClass
restore_binds_of_type_var {atv_variable={tv_info_ptr}} type_var_heap restore_binds_of_type_var {atv_variable={tv_info_ptr}} type_var_heap
# (TVI_SignClass _ _ old_info, type_var_heap) = readPtr tv_info_ptr type_var_heap # (TVI_SignClass _ _ old_info, type_var_heap) = readPtr tv_info_ptr type_var_heap
...@@ -426,10 +430,12 @@ where ...@@ -426,10 +430,12 @@ where
= bind_type_vars_to_props tvs gvs tks props_of_group_vars ([prop:rev_hio_props], type_var_heap <:= (tv_info_ptr, TVI_PropClass gv prop var_info)) = bind_type_vars_to_props tvs gvs tks props_of_group_vars ([prop:rev_hio_props], type_var_heap <:= (tv_info_ptr, TVI_PropClass gv prop var_info))
= bind_type_vars_to_props tvs gvs tks props_of_group_vars (rev_hio_props, type_var_heap <:= (tv_info_ptr, TVI_PropClass gv prop var_info)) = bind_type_vars_to_props tvs gvs tks props_of_group_vars (rev_hio_props, type_var_heap <:= (tv_info_ptr, TVI_PropClass gv prop var_info))
where where
retrieve_prop this_gv [(gv,prop) : signs ] retrieve_prop this_gv [(gv,prop) : props ]
| this_gv == gv | this_gv == gv
= prop = prop
= retrieve_prop this_gv signs = retrieve_prop this_gv props
retrieve_prop this_gv [ ]
= PropClass
restore_binds_of_type_var {atv_variable={tv_info_ptr}} type_var_heap restore_binds_of_type_var {atv_variable={tv_info_ptr}} type_var_heap
# (TVI_PropClass _ _ old_info, type_var_heap) = readPtr tv_info_ptr type_var_heap # (TVI_PropClass _ _ old_info, type_var_heap) = readPtr tv_info_ptr type_var_heap
......
...@@ -4,7 +4,7 @@ import syntax, transform, checksupport, typesupport, predef ...@@ -4,7 +4,7 @@ import syntax, transform, checksupport, typesupport, predef
cPredefinedModuleIndex :== 1 cPredefinedModuleIndex :== 1
checkModule :: !ScannedModule !Int ![FunDef] !ScannedModule !ScannedModule ![ScannedModule] !*PredefinedSymbols !*SymbolTable !*File checkModule :: !ScannedModule !IndexRange ![FunDef] !ScannedModule !ScannedModule ![ScannedModule] !*PredefinedSymbols !*SymbolTable !*File
-> (!Bool, !*IclModule, *{# DclModule}, *{! Group}, !(Optional {# Index}), !*Heaps, !*PredefinedSymbols, !*SymbolTable, *File) -> (!Bool, !*IclModule, *{# DclModule}, *{! Group}, !(Optional {# Index}), !*Heaps, !*PredefinedSymbols, !*SymbolTable, *File)
retrieveGlobalDefinition :: !SymbolTableEntry !STE_Kind !Index -> (!Index, !Index) retrieveGlobalDefinition :: !SymbolTableEntry !STE_Kind !Index -> (!Index, !Index)
......
...@@ -7,6 +7,10 @@ import explicitimports, comparedefimp ...@@ -7,6 +7,10 @@ import explicitimports, comparedefimp
cPredefinedModuleIndex :== 1 cPredefinedModuleIndex :== 1
isMainModule :: ModuleKind -> Bool
isMainModule MK_Main = True
isMainModule _ = False
convertIndex :: !Index !Index !(Optional ConversionTable) -> !Index convertIndex :: !Index !Index !(Optional ConversionTable) -> !Index
convertIndex index table_index (Yes tables) convertIndex index table_index (Yes tables)
= tables.[table_index].[index] = tables.[table_index].[index]
...@@ -2571,9 +2575,9 @@ where ...@@ -2571,9 +2575,9 @@ where
(<=<) state fun :== fun state (<=<) state fun :== fun state
checkModule :: !ScannedModule !Int ![FunDef] !ScannedModule !ScannedModule ![ScannedModule] !*PredefinedSymbols !*SymbolTable !*File checkModule :: !ScannedModule !IndexRange ![FunDef] !ScannedModule !ScannedModule ![ScannedModule] !*PredefinedSymbols !*SymbolTable !*File
-> (!Bool, !*IclModule, *{# DclModule}, *{! Group}, !(Optional {# Index}), !*Heaps, !*PredefinedSymbols, !*SymbolTable, *File) -> (!Bool, !*IclModule, *{# DclModule}, *{! Group}, !(Optional {# Index}), !*Heaps, !*PredefinedSymbols, !*SymbolTable, *File)
checkModule {mod_type,mod_name,mod_imports,mod_imported_objects,mod_defs = cdefs} nr_of_global_funs fun_defs dcl_mod pre_def_mod scanned_modules predef_symbols symbol_table err_file checkModule {mod_type,mod_name,mod_imports,mod_imported_objects,mod_defs = cdefs} icl_global_function_range fun_defs dcl_mod pre_def_mod scanned_modules predef_symbols symbol_table err_file
# error = {ea_file = err_file, ea_loc = [], ea_ok = True } # error = {ea_file = err_file, ea_loc = [], ea_ok = True }
first_inst_index = length fun_defs first_inst_index = length fun_defs
...@@ -2584,7 +2588,7 @@ checkModule {mod_type,mod_name,mod_imports,mod_imported_objects,mod_defs = cdefs ...@@ -2584,7 +2588,7 @@ checkModule {mod_type,mod_name,mod_imports,mod_imported_objects,mod_defs = cdefs
#! nr_of_functions = size icl_functions #! nr_of_functions = size icl_functions
# sizes_and_local_defs = collectCommonfinitions cdefs # sizes_and_local_defs = collectCommonfinitions cdefs
(icl_functions, sizes_and_local_defs) = collectGlobalFunctions cFunctionDefs 0 nr_of_global_funs icl_functions sizes_and_local_defs (icl_functions, sizes_and_local_defs) = collectGlobalFunctions cFunctionDefs icl_global_function_range.ir_from icl_global_function_range.ir_to icl_functions sizes_and_local_defs
(icl_functions, (sizes, local_defs)) = collectMacros cdefs.def_macros icl_functions sizes_and_local_defs (icl_functions, (sizes, local_defs)) = collectMacros cdefs.def_macros icl_functions sizes_and_local_defs
(scanned_modules, icl_functions, cs) (scanned_modules, icl_functions, cs)
...@@ -2635,8 +2639,9 @@ checkModule {mod_type,mod_name,mod_imports,mod_imported_objects,mod_defs = cdefs ...@@ -2635,8 +2639,9 @@ checkModule {mod_type,mod_name,mod_imports,mod_imported_objects,mod_defs = cdefs
ef_is_macro_fun = False } ef_is_macro_fun = False }
(icl_functions, e_info, heaps, cs) = checkMacros cIclModIndex cdefs.def_macros icl_functions e_info heaps cs (icl_functions, e_info, heaps, cs) = checkMacros cIclModIndex cdefs.def_macros icl_functions e_info heaps cs
(icl_functions, e_info, heaps, cs) = checkFunctions cIclModIndex cGlobalScope 0 nr_of_global_funs icl_functions e_info heaps cs (icl_functions, e_info, heaps, cs) = checkFunctions cIclModIndex cGlobalScope icl_global_function_range.ir_from icl_global_function_range.ir_to icl_functions e_info heaps cs
cs = check_start_rule mod_type icl_global_function_range cs
cs = check_needed_modules_are_imported mod_name ".icl" cs cs = check_needed_modules_are_imported mod_name ".icl" cs
(icl_functions, e_info, heaps, {cs_symbol_table, cs_predef_symbols, cs_error}) (icl_functions, e_info, heaps, {cs_symbol_table, cs_predef_symbols, cs_error})
...@@ -2648,7 +2653,6 @@ checkModule {mod_type,mod_name,mod_imports,mod_imported_objects,mod_defs = cdefs ...@@ -2648,7 +2653,6 @@ checkModule {mod_type,mod_name,mod_imports,mod_imported_objects,mod_defs = cdefs
(spec_functions, dcl_modules, class_instances, icl_functions, new_nr_of_functions, dcl_icl_conversions, var_heap, th_vars, expr_heap) (spec_functions, dcl_modules, class_instances, icl_functions, new_nr_of_functions, dcl_icl_conversions, var_heap, th_vars, expr_heap)
= collect_specialized_functions_in_dcl_module dcl_modules icl_common.com_instance_defs icl_functions nr_of_functions = collect_specialized_functions_in_dcl_module dcl_modules icl_common.com_instance_defs icl_functions nr_of_functions
hp_var_heap th_vars hp_expression_heap hp_var_heap th_vars hp_expression_heap
icl_global_function_range = {ir_from = 0, ir_to = nr_of_global_funs}
icl_instances = {ir_from = first_inst_index, ir_to = nr_of_functions} icl_instances = {ir_from = first_inst_index, ir_to = nr_of_functions}
icl_specials = {ir_from = nr_of_functions, ir_to = new_nr_of_functions} icl_specials = {ir_from = nr_of_functions, ir_to = new_nr_of_functions}
icl_functions = copy_instance_types instance_types { icl_fun \\ icl_fun <- [ icl_fun \\ icl_fun <-: icl_functions ] ++ spec_functions } icl_functions = copy_instance_types instance_types { icl_fun \\ icl_fun <- [ icl_fun \\ icl_fun <-: icl_functions ] ++ spec_functions }
...@@ -2656,7 +2660,7 @@ checkModule {mod_type,mod_name,mod_imports,mod_imported_objects,mod_defs = cdefs ...@@ -2656,7 +2660,7 @@ checkModule {mod_type,mod_name,mod_imports,mod_imported_objects,mod_defs = cdefs
(dcl_modules, class_instances, icl_functions, cs_predef_symbols) (dcl_modules, class_instances, icl_functions, cs_predef_symbols)
= adjust_instance_types_of_array_functions_in_std_array_icl dcl_modules class_instances icl_functions cs_predef_symbols = adjust_instance_types_of_array_functions_in_std_array_icl dcl_modules class_instances icl_functions cs_predef_symbols
(untransformed_macro_funs_defs, icl_functions) = memcpy {ir_from = nr_of_global_funs, ir_to = first_inst_index } icl_functions (untransformed_macro_funs_defs, icl_functions) = memcpy cdefs.def_macros icl_functions
(groups, icl_functions, dcl_modules, var_heap, expr_heap, cs_symbol_table, cs_error) (groups, icl_functions, dcl_modules, var_heap, expr_heap, cs_symbol_table, cs_error)
= partitionateAndLiftFunctions [icl_global_function_range, icl_instances] cIclModIndex icl_functions = partitionateAndLiftFunctions [icl_global_function_range, icl_instances] cIclModIndex icl_functions
dcl_modules var_heap expr_heap cs_symbol_table cs_error dcl_modules var_heap expr_heap cs_symbol_table cs_error
...@@ -2668,9 +2672,10 @@ checkModule {mod_type,mod_name,mod_imports,mod_imported_objects,mod_defs = cdefs ...@@ -2668,9 +2672,10 @@ checkModule {mod_type,mod_name,mod_imports,mod_imported_objects,mod_defs = cdefs
heaps = { heaps & hp_var_heap = var_heap, hp_expression_heap = expr_heap, hp_type_heaps = {hp_type_heaps & th_vars = th_vars}} heaps = { heaps & hp_var_heap = var_heap, hp_expression_heap = expr_heap, hp_type_heaps = {hp_type_heaps & th_vars = th_vars}}
/* RWS
(dcl_modules, icl_mod, heaps, cs_error) (dcl_modules, icl_mod, heaps, cs_error)
= compareDefImp (nr_of_global_funs, untransformed_macro_funs_defs) dcl_modules icl_mod heaps cs_error = compareDefImp (cdefs.def_macros.ir_from, untransformed_macro_funs_defs) dcl_modules icl_mod heaps cs_error
*/
= (cs_error.ea_ok, icl_mod, dcl_modules, groups, dcl_icl_conversions, heaps, cs_predef_symbols, cs_symbol_table, cs_error.ea_file) = (cs_error.ea_ok, icl_mod, dcl_modules, groups, dcl_icl_conversions, heaps, cs_predef_symbols, cs_symbol_table, cs_error.ea_file)
# icl_common = { icl_common & com_type_defs = e_info.ef_type_defs, com_selector_defs = e_info.ef_selector_defs, com_class_defs = e_info.ef_class_defs, # icl_common = { icl_common & com_type_defs = e_info.ef_type_defs, com_selector_defs = e_info.ef_selector_defs, com_class_defs = e_info.ef_class_defs,
com_cons_defs = e_info.ef_cons_defs, com_member_defs = e_info.ef_member_defs } com_cons_defs = e_info.ef_cons_defs, com_member_defs = e_info.ef_member_defs }
...@@ -2681,6 +2686,23 @@ checkModule {mod_type,mod_name,mod_imports,mod_imported_objects,mod_defs = cdefs ...@@ -2681,6 +2686,23 @@ checkModule {mod_type,mod_name,mod_imports,mod_imported_objects,mod_defs = cdefs
icl_declared = {dcls_local = local_defs, dcls_import = icl_imported, dcls_explicit = dcls_explicit} } icl_declared = {dcls_local = local_defs, dcls_import = icl_imported, dcls_explicit = dcls_explicit} }
= (False, icl_mod, dcl_modules, {}, No, heaps, cs_predef_symbols, cs_symbol_table, cs_error.ea_file) = (False, icl_mod, dcl_modules, {}, No, heaps, cs_predef_symbols, cs_symbol_table, cs_error.ea_file)
where where
check_start_rule mod_kind {ir_from, ir_to} cs=:{cs_predef_symbols,cs_symbol_table}
# (pre_symb, cs_predef_symbols) = cs_predef_symbols![PD_Start]
({ste_kind, ste_index}, cs_symbol_table) = readPtr pre_symb.pds_ident.id_info cs_symbol_table
cs = { cs & cs_predef_symbols = cs_predef_symbols, cs_symbol_table = cs_symbol_table }
= case ste_kind of
STE_FunctionOrMacro _
| ir_from <= ste_index && ste_index < ir_to
-> { cs & cs_predef_symbols = { cs.cs_predef_symbols & [PD_Start] = { pre_symb & pds_def = ste_index, pds_module = cIclModIndex }}}
STE_Imported STE_DclFunction mod_index
-> { cs & cs_predef_symbols = { cs.cs_predef_symbols & [PD_Start] = { pre_symb & pds_def = ste_index, pds_module = mod_index }}}
_
-> case mod_kind of
MK_Main
-> { cs & cs_error = checkError "Start" " function not defined" cs.cs_error }
_
-> cs
convert_class_instances [pi=:{pi_members} : pins] next_fun_index convert_class_instances [pi=:{pi_members} : pins] next_fun_index
# ins_members = sort pi_members # ins_members = sort pi_members
(member_symbols, next_fun_index) = determine_indexes_of_members ins_members next_fun_index (member_symbols, next_fun_index) = determine_indexes_of_members ins_members next_fun_index
......
...@@ -21,16 +21,16 @@ import RWSDebug ...@@ -21,16 +21,16 @@ import RWSDebug
frontEndInterface :: !Ident !SearchPaths !*PredefinedSymbols !*HashTable !*Files !*File !*File !*File -> (!*PredefinedSymbols, !*HashTable, !*Files, !*File, !*File, !*File, !Optional *FrontEndSyntaxTree) frontEndInterface :: !Ident !SearchPaths !*PredefinedSymbols !*HashTable !*Files !*File !*File !*File -> (!*PredefinedSymbols, !*HashTable, !*Files, !*File, !*File, !*File, !Optional *FrontEndSyntaxTree)
frontEndInterface mod_ident search_paths predef_symbols hash_table files error io out frontEndInterface mod_ident search_paths predef_symbols hash_table files error io out
# (ok, mod, hash_table, error, predef_symbols, files) # (ok, mod, hash_table, error, predef_symbols, files)
= wantModule cWantIclFile mod_ident (hash_table ---> ("Parsing:", mod_ident)) error search_paths predef_symbols files = wantModule cWantIclFile mod_ident (hash_table -*-> ("Parsing:", mod_ident)) error search_paths predef_symbols files
| not ok | not ok
= (predef_symbols, hash_table, files, error, io, out, No) = (predef_symbols, hash_table, files, error, io, out, No)
# (ok, mod, nr_of_global_funs, mod_functions, dcl_mod, predef_mod, modules, hash_table, error, predef_symbols, files) # (ok, mod, global_fun_range, mod_functions, dcl_mod, predef_mod, modules, hash_table, error, predef_symbols, files)
= scanModule (mod -*-> "Scanning") hash_table error search_paths predef_symbols files = scanModule (mod -*-> "Scanning") hash_table error search_paths predef_symbols files
| not ok | not ok
= (predef_symbols, hash_table, files, error, io, out, No) = (predef_symbols, hash_table, files, error, io, out, No)
# symbol_table = hash_table.hte_symbol_heap # symbol_table = hash_table.hte_symbol_heap
(ok, icl_mod, dcl_mods, components, optional_dcl_icl_conversions, heaps, predef_symbols, symbol_table, error) (ok, icl_mod, dcl_mods, components, optional_dcl_icl_conversions, heaps, predef_symbols, symbol_table, error)
= checkModule mod nr_of_global_funs mod_functions dcl_mod predef_mod modules predef_symbols (symbol_table -*-> "Checking") error = checkModule mod global_fun_range mod_functions dcl_mod predef_mod modules predef_symbols (symbol_table -*-> "Checking") error
hash_table = { hash_table & hte_symbol_heap = symbol_table} hash_table = { hash_table & hte_symbol_heap = symbol_table}
| not ok | not ok
= (predef_symbols, hash_table, files, error, io, out, No) = (predef_symbols, hash_table, files, error, io, out, No)
...@@ -41,7 +41,7 @@ frontEndInterface mod_ident search_paths predef_symbols hash_table files error i ...@@ -41,7 +41,7 @@ frontEndInterface mod_ident search_paths predef_symbols hash_table files error i
| not ok | not ok
= (predef_symbols, hash_table, files, error, io, out, No) = (predef_symbols, hash_table, files, error, io, out, No)
# (components, fun_defs) = partitionateFunctions (fun_defs -*-> "partitionateFunctions") [ { ir_from = 0, ir_to = nr_of_global_funs }, icl_instances, icl_specials] # (components, fun_defs) = partitionateFunctions (fun_defs -*-> "partitionateFunctions") [ global_fun_range, icl_instances, icl_specials]
// (components, fun_defs, error) = showTypes components 0 fun_defs error // (components, fun_defs, error) = showTypes components 0 fun_defs error
// (components, fun_defs, error) = showComponents components 0 True fun_defs error // (components, fun_defs, error) = showComponents components 0 True fun_defs error
// (fun_defs, error) = showFunctions array_instances fun_defs error // (fun_defs, error) = showFunctions array_instances fun_defs error
...@@ -62,7 +62,7 @@ frontEndInterface mod_ident search_paths predef_symbols hash_table files error i ...@@ -62,7 +62,7 @@ frontEndInterface mod_ident search_paths predef_symbols hash_table files error i
var_heap type_heaps expression_heap var_heap type_heaps expression_heap
(dcl_types, type_heaps, var_heap) (dcl_types, type_heaps, var_heap)
= convertImportedTypeSpecifications dcl_mods imported_funs common_defs used_conses used_funs dcl_types type_heaps var_heap = convertImportedTypeSpecifications dcl_mods imported_funs common_defs used_conses used_funs dcl_types type_heaps var_heap
(components, fun_defs, out) = showComponents components 0 False fun_defs out // (components, fun_defs, out) = showComponents components 0 False fun_defs out
= (predef_symbols,hash_table,files,error,io,out, = (predef_symbols,hash_table,files,error,io,out,
Yes { fe_icl = {icl_mod & icl_functions=fun_defs } Yes { fe_icl = {icl_mod & icl_functions=fun_defs }
......
...@@ -675,7 +675,7 @@ where ...@@ -675,7 +675,7 @@ where
convert_reduced_context_to_expression defs contexts {rc_class, rc_inst_module, rc_inst_members, rc_red_contexts, rc_types} dictionary_args heaps convert_reduced_context_to_expression defs contexts {rc_class, rc_inst_module, rc_inst_members, rc_red_contexts, rc_types} dictionary_args heaps
# (expressions, heaps) = convertClassApplsToExpressions defs contexts rc_red_contexts heaps # (expressions, heaps) = convertClassApplsToExpressions defs contexts rc_red_contexts heaps
context_size = length expressions context_size = length expressions
| size rc_inst_members > 1 && context_size > 0 | False // RWS test size rc_inst_members > 1 && context_size > 0
# (let_binds, let_types, rev_dicts, hp_var_heap, hp_expression_heap) # (let_binds, let_types, rev_dicts, hp_var_heap, hp_expression_heap)
= foldSt (bind_shared_dictionary (size rc_inst_members)) expressions ([], [], [], heaps.hp_var_heap, heaps.hp_expression_heap) = foldSt (bind_shared_dictionary (size rc_inst_members)) expressions ([], [], [], heaps.hp_var_heap, heaps.hp_expression_heap)
dictionary_args = build_class_members (size rc_inst_members) rc_inst_members rc_inst_module (reverse rev_dicts) context_size dictionary_args dictionary_args = build_class_members (size rc_inst_members) rc_inst_members rc_inst_module (reverse rev_dicts) context_size dictionary_args
......
...@@ -5,4 +5,4 @@ import StdEnv ...@@ -5,4 +5,4 @@ import StdEnv
import syntax, parse, predef import syntax, parse, predef
scanModule :: !ParsedModule !*HashTable !*File !SearchPaths !*PredefinedSymbols !*Files scanModule :: !ParsedModule !*HashTable !*File !SearchPaths !*PredefinedSymbols !*Files
-> (!Bool, !ScannedModule, !Int, ![FunDef], !ScannedModule, !ScannedModule, ![ScannedModule], !*HashTable, !*File, !*PredefinedSymbols, !*Files) -> (!Bool, !ScannedModule, !IndexRange, ![FunDef], !ScannedModule, !ScannedModule, ![ScannedModule], !*HashTable, !*File, !*PredefinedSymbols, !*Files)
This diff is collapsed.
...@@ -79,7 +79,9 @@ PD_variablePlaceholder :== 127 ...@@ -79,7 +79,9 @@ PD_variablePlaceholder :== 127
PD_StdDynamics :== 128 PD_StdDynamics :== 128
PD_undo_indirections :== 129 PD_undo_indirections :== 129
PD_NrOfPredefSymbols :== 130 PD_Start :== 130
PD_NrOfPredefSymbols :== 131
GetTupleConsIndex tup_arity :== PD_Arity2TupleSymbol + tup_arity - 2 GetTupleConsIndex tup_arity :== PD_Arity2TupleSymbol + tup_arity - 2
......
...@@ -77,7 +77,9 @@ PD_variablePlaceholder :== 127 ...@@ -77,7 +77,9 @@ PD_variablePlaceholder :== 127
PD_StdDynamics :== 128 PD_StdDynamics :== 128
PD_undo_indirections :== 129 PD_undo_indirections :== 129
PD_NrOfPredefSymbols :== 130 PD_Start :== 130
PD_NrOfPredefSymbols :== 131
(<<=) infixl (<<=) infixl
...@@ -146,6 +148,7 @@ where ...@@ -146,6 +148,7 @@ where
<<- ("_unify", IC_Expression, PD_unify) <<- ("_unify", IC_Expression, PD_unify)
<<- ("StdDynamics", IC_Module, PD_StdDynamics) <<- ("StdDynamics", IC_Module, PD_StdDynamics)
<<- ("_undo_indirections", IC_Expression, PD_undo_indirections) <<- ("_undo_indirections", IC_Expression, PD_undo_indirections)
<<- ("Start", IC_Expression, PD_Start)
MakeTupleConsSymbIndex arity :== arity - 2 + cArity2TupleConsSymbIndex MakeTupleConsSymbIndex arity :== arity - 2 + cArity2TupleConsSymbIndex
......
...@@ -529,7 +529,7 @@ where ...@@ -529,7 +529,7 @@ where
EI_Attribute sa_attr_nr EI_Attribute sa_attr_nr
# (succ, coercion_env) = tryToMakeNonUnique sa_attr_nr coercion_env # (succ, coercion_env) = tryToMakeNonUnique sa_attr_nr coercion_env
| succ | succ
---> ("make_shared_occurrence_non_unique", free_var, var_expr_ptr) // ---> ("make_shared_occurrence_non_unique", free_var, var_expr_ptr)
-> (coercion_env, expr_heap, error) -> (coercion_env, expr_heap, error)
-> (coercion_env, expr_heap, uniquenessError { cp_expression = FreeVar free_var} " demanded attribute cannot be offered by shared object" error) -> (coercion_env, expr_heap, uniquenessError { cp_expression = FreeVar free_var} " demanded attribute cannot be offered by shared object" error)
_ _
......
...@@ -1169,14 +1169,14 @@ InitFunEnv nr_of_fun_defs ...@@ -1169,14 +1169,14 @@ InitFunEnv nr_of_fun_defs
= createArray nr_of_fun_defs EmptyFunctionType = createArray nr_of_fun_defs EmptyFunctionType
//CreateInitialSymbolTypes :: ![Int] !u:{# FunDef} !{# CommonDefs } !*TypeState -> (!u:{# FunDef}, !*TypeState) //CreateInitialSymbolTypes :: ![Int] !u:{# FunDef} !{# CommonDefs } !*TypeState -> (!u:{# FunDef}, !*TypeState)
CreateInitialSymbolTypes common_defs [] defs_and_state CreateInitialSymbolTypes start_index common_defs [] defs_and_state
= defs_and_state = defs_and_state
CreateInitialSymbolTypes common_defs [fun : funs] (fun_defs, pre_def_symbols, req_cons_variables, ts) CreateInitialSymbolTypes start_index common_defs [fun : funs] (fun_defs, pre_def_symbols, req_cons_variables, ts)
# (fd, fun_defs) = fun_defs![fun] # (fd, fun_defs) = fun_defs![fun]
(pre_def_symbols, req_cons_variables, ts) = initial_symbol_type common_defs fd (pre_def_symbols, req_cons_variables, ts) (pre_def_symbols, req_cons_variables, ts) = initial_symbol_type (start_index == fun) common_defs fd (pre_def_symbols, req_cons_variables, ts)
= CreateInitialSymbolTypes common_defs funs (fun_defs, pre_def_symbols, req_cons_variables, ts) = CreateInitialSymbolTypes start_index common_defs funs (fun_defs, pre_def_symbols, req_cons_variables, ts)
where where
initial_symbol_type common_defs {fun_type = Yes ft=:{st_arity,st_args,st_result,st_attr_vars,st_attr_env}, fun_lifted, fun_info = {fi_dynamics} } initial_symbol_type is_start_rule common_defs {fun_type = Yes ft=:{st_arity,st_args,st_result,st_attr_vars,st_attr_env}, fun_lifted, fun_info = {fi_dynamics} }
(pre_def_symbols, req_cons_variables, ts=:{ts_type_heaps,ts_expr_heap,ts_td_infos,ts_error}) (pre_def_symbols, req_cons_variables, ts=:{ts_type_heaps,ts_expr_heap,ts_td_infos,ts_error})
# (st_args, ps) = addPropagationAttributesToATypes common_defs st_args # (st_args, ps) = addPropagationAttributesToATypes common_defs st_args
{ prop_type_heaps = ts_type_heaps, prop_td_infos = ts_td_infos, { prop_type_heaps = ts_type_heaps, prop_td_infos = ts_td_infos,
...@@ -1193,8 +1193,8 @@ where ...@@ -1193,8 +1193,8 @@ where
{ ts & ts_fun_env = { ts.ts_fun_env & [fun] = SpecifiedType ft lifted_args { ts & ts_fun_env = { ts.ts_fun_env & [fun] = SpecifiedType ft lifted_args
{ fresh_fun_type & tst_arity = st_arity + fun_lifted, tst_args = lifted_args ++ fresh_fun_type.tst_args, tst_lifted = fun_lifted }}, { fresh_fun_type & tst_arity = st_arity + fun_lifted, tst_args = lifted_args ++ fresh_fun_type.tst_args, tst_lifted = fun_lifted }},
ts_var_heap = ts_var_heap, ts_var_store = ts_var_store, ts_expr_heap = ts_expr_heap, ts_type_heaps = ts_type_heaps }) ts_var_heap = ts_var_heap, ts_var_store = ts_var_store, ts_expr_heap = ts_expr_heap, ts_type_heaps = ts_type_heaps })
initial_symbol_type common_defs {fun_arity, fun_lifted, fun_info = {fi_dynamics}} (pre_def_symbols, req_cons_variables, ts) initial_symbol_type is_start_rule common_defs {fun_arity, fun_lifted, fun_info = {fi_dynamics}} (pre_def_symbols, req_cons_variables, ts)
# (st_gen, ts) = create_general_symboltype fun_arity fun_lifted ts # (st_gen, ts) = create_general_symboltype is_start_rule fun_arity fun_lifted ts
ts_type_heaps = ts.ts_type_heaps ts_type_heaps = ts.ts_type_heaps
(th_vars, ts_expr_heap) = clear_dynamics fi_dynamics (ts_type_heaps.th_vars, ts.ts_expr_heap) (th_vars, ts_expr_heap) = clear_dynamics fi_dynamics (ts_type_heaps.th_vars, ts.ts_expr_heap)
(ts_var_store, ts_type_heaps, ts_var_heap, ts_expr_heap, pre_def_symbols) (ts_var_store, ts_type_heaps, ts_var_heap, ts_expr_heap, pre_def_symbols)
...@@ -1204,12 +1204,16 @@ where ...@@ -1204,12 +1204,16 @@ where
ts_expr_heap = ts_expr_heap, ts_type_heaps = ts_type_heaps, ts_var_heap = ts_var_heap}) ts_expr_heap = ts_expr_heap, ts_type_heaps = ts_type_heaps, ts_var_heap = ts_var_heap})
create_general_symboltype :: !Int !Int !*TypeState -> (!TempSymbolType, !*TypeState) create_general_symboltype :: !Bool !Int !Int !*TypeState -> (!TempSymbolType, !*TypeState)
create_general_symboltype nr_of_args nr_of_lifted_args ts create_general_symboltype is_start_rule nr_of_args nr_of_lifted_args ts
# (tst_args, ts) = fresh_attributed_type_variables nr_of_args [] ts | is_start_rule && nr_of_args > 0
(tst_args, ts) = fresh_attributed_type_variables nr_of_lifted_args tst_args ts # (tst_args, ts) = fresh_attributed_type_variables (nr_of_args - 1) [{at_attribute = TA_Unique, at_annotation = AN_Strict, at_type = TB BT_World }] ts
(tst_result, ts) = freshAttributedVariable ts (tst_result, ts) = freshAttributedVariable ts
= ({ tst_args = tst_args, tst_arity = nr_of_args + nr_of_lifted_args, tst_result = tst_result, tst_context = [], tst_attr_env = [], tst_lifted = 0 }, ts) = ({ tst_args = tst_args, tst_arity = 1, tst_result = tst_result, tst_context = [], tst_attr_env = [], tst_lifted = 0 }, ts)
# (tst_args, ts) = fresh_attributed_type_variables nr_of_args [] ts
(tst_args, ts) = fresh_attributed_type_variables nr_of_lifted_args tst_args ts
(tst_result, ts) = freshAttributedVariable ts
= ({ tst_args = tst_args, tst_arity = nr_of_args + nr_of_lifted_args, tst_result = tst_result, tst_context = [], tst_attr_env = [], tst_lifted = 0 }, ts)
fresh_attributed_type_variables :: !Int ![AType] !*TypeState -> (![AType], !*TypeState) fresh_attributed_type_variables :: !Int ![AType] !*TypeState -> (![AType], !*TypeState)
fresh_attributed_type_variables n vars ts fresh_attributed_type_variables n vars ts
...@@ -1321,23 +1325,23 @@ specification_error type err ...@@ -1321,23 +1325,23 @@ specification_error type err
format = { form_properties = cAttributed, form_attr_position = No} format = { form_properties = cAttributed, form_attr_position = No}
= { err & ea_file = err.ea_file <<< " specified type conflicts with derived type " <:: (format, type) <<< '\n' } = { err & ea_file = err.ea_file <<< " specified type conflicts with derived type " <:: (format, type) <<< '\n' }
cleanUpAndCheckFunctionTypes [] _ defs type_contexts coercion_env attr_partition type_var_env attr_var_env (fun_defs, ts) cleanUpAndCheckFunctionTypes [] _ start_index defs type_contexts coercion_env attr_partition type_var_env attr_var_env (fun_defs, ts)
= (fun_defs, ts) = (fun_defs, ts)
cleanUpAndCheckFunctionTypes [fun : funs] [ {fe_requirements = {req_case_and_let_exprs}} : reqs] defs type_contexts coercion_env cleanUpAndCheckFunctionTypes [fun : funs] [ {fe_requirements = {req_case_and_let_exprs}} : reqs] start_index defs type_contexts coercion_env
attr_partition type_var_env attr_var_env (fun_defs, ts) attr_partition type_var_env attr_var_env (fun_defs, ts)
# (fd, fun_defs) = fun_defs![fun] # (fd, fun_defs) = fun_defs![fun]
# (type_var_env, attr_var_env, ts) = clean_up_and_check_function_type fd fun defs type_contexts # (type_var_env, attr_var_env, ts) = clean_up_and_check_function_type fd fun (start_index == fun) defs type_contexts
req_case_and_let_exprs coercion_env attr_partition type_var_env attr_var_env ts req_case_and_let_exprs coercion_env attr_partition type_var_env attr_var_env ts
= cleanUpAndCheckFunctionTypes funs reqs defs type_contexts coercion_env attr_partition type_var_env attr_var_env (fun_defs, ts) = cleanUpAndCheckFunctionTypes funs reqs start_index defs type_contexts coercion_env attr_partition type_var_env attr_var_env (fun_defs, ts)
where where
clean_up_and_check_function_type {fun_symb,fun_pos,fun_type = opt_fun_type} fun defs type_contexts case_and_let_exprs clean_up_and_check_function_type {fun_symb,fun_pos,fun_type = opt_fun_type} fun is_start_rule defs type_contexts case_and_let_exprs
coercion_env attr_partition type_var_env attr_var_env ts coercion_env attr_partition type_var_env attr_var_env ts
# (env_type, ts) = ts!ts_fun_env.[fun] # (env_type, ts) = ts!ts_fun_env.[fun]
# ts = { ts & ts_error = setErrorAdmin (newPosition fun_symb fun_pos) ts.ts_error} # ts = { ts & ts_error = setErrorAdmin (newPosition fun_symb fun_pos) ts.ts_error}
= case env_type of = case env_type of
ExpandedType fun_type tmp_fun_type exp_fun_type ExpandedType fun_type tmp_fun_type exp_fun_type
# (clean_fun_type, type_var_env, attr_var_env, ts_type_heaps, ts_var_heap, ts_expr_heap, ts_error) # (clean_fun_type, type_var_env, attr_var_env, ts_type_heaps, ts_var_heap, ts_expr_heap, ts_error)
= cleanUpSymbolType cSpecifiedType exp_fun_type type_contexts case_and_let_exprs coercion_env = cleanUpSymbolType is_start_rule cSpecifiedType exp_fun_type type_contexts case_and_let_exprs coercion_env
attr_partition type_var_env attr_var_env ts.ts_type_heaps ts.ts_var_heap ts.ts_expr_heap ts.ts_error attr_partition type_var_env attr_var_env ts.ts_type_heaps ts.ts_var_heap ts.ts_expr_heap ts.ts_error
| ts_error.ea_ok | ts_error.ea_ok
# (ts_fun_env, attr_var_env, ts_type_heaps, ts_expr_heap, ts_error) # (ts_fun_env, attr_var_env, ts_type_heaps, ts_expr_heap, ts_error)
...@@ -1346,7 +1350,7 @@ where ...@@ -1346,7 +1350,7 @@ where
-> (type_var_env, attr_var_env, { ts & ts_type_heaps = ts_type_heaps, ts_var_heap = ts_var_heap, ts_expr_heap = ts_expr_heap, ts_error = ts_error }) -> (type_var_env, attr_var_env, { ts & ts_type_heaps = ts_type_heaps, ts_var_heap = ts_var_heap, ts_expr_heap = ts_expr_heap, ts_error = ts_error })
UncheckedType exp_fun_type UncheckedType exp_fun_type
# (clean_fun_type, type_var_env, attr_var_env, ts_type_heaps, ts_var_heap, ts_expr_heap, ts_error) # (clean_fun_type, type_var_env, attr_var_env, ts_type_heaps, ts_var_heap, ts_expr_heap, ts_error)
= cleanUpSymbolType cDerivedType exp_fun_type type_contexts case_and_let_exprs coercion_env = cleanUpSymbolType is_start_rule cDerivedType exp_fun_type type_contexts case_and_let_exprs coercion_env
attr_partition type_var_env attr_var_env ts.ts_type_heaps ts.ts_var_heap ts.ts_expr_heap ts.ts_error attr_partition type_var_env attr_var_env ts.ts_type_heaps ts.ts_var_heap ts.ts_expr_heap ts.ts_error
ts_fun_env = { ts.ts_fun_env & [fun] = CheckedType clean_fun_type } ts_fun_env = { ts.ts_fun_env & [fun] = CheckedType clean_fun_type }
-> (type_var_env, attr_var_env, { ts & ts_type_heaps = ts_type_heaps, ts_var_heap = ts_var_heap, ts_expr_heap = ts_expr_heap, ts_fun_env = ts_fun_env, ts_error = ts_error }) -> (type_var_env, attr_var_env, {