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
| is_abs_type
# (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_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}}))
# position = newPosition td_name td_pos
as_error = pushErrorAdmin position as_error
......@@ -429,7 +430,7 @@ where
= (kind_store, kind_heap, { td_infos & [glob_module].[glob_object] =
{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 } })
// ---> ("update_type_def_info", glob_module, glob_object, group_nr)
// ---> ("update_type_def_info", glob_module, glob_object, (group_nr, loc_type_index))
where
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
......
......@@ -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_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)
---> ("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, !*TypeVarHeap, !*TypeDefInfos)
......@@ -72,6 +72,7 @@ determineSignClassOfTypeDef type_index module_index td_args {tdi_classification,
No
# 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}
// 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
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)
# ({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]
// (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)
(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 = [] }
......@@ -177,6 +179,8 @@ where
| this_gv == gv
= sign
= retrieve_sign this_gv signs
retrieve_sign this_gv [ ]
= TopSignClass
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
......@@ -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 (rev_hio_props, type_var_heap <:= (tv_info_ptr, TVI_PropClass gv prop var_info))
where
retrieve_prop this_gv [(gv,prop) : signs ]
retrieve_prop this_gv [(gv,prop) : props ]
| this_gv == gv
= 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
# (TVI_PropClass _ _ old_info, type_var_heap) = readPtr tv_info_ptr type_var_heap
......
......@@ -4,7 +4,7 @@ import syntax, transform, checksupport, typesupport, predef
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)
retrieveGlobalDefinition :: !SymbolTableEntry !STE_Kind !Index -> (!Index, !Index)
......
......@@ -7,6 +7,10 @@ import explicitimports, comparedefimp
cPredefinedModuleIndex :== 1
isMainModule :: ModuleKind -> Bool
isMainModule MK_Main = True
isMainModule _ = False
convertIndex :: !Index !Index !(Optional ConversionTable) -> !Index
convertIndex index table_index (Yes tables)
= tables.[table_index].[index]
......@@ -2571,9 +2575,9 @@ where
(<=<) 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)
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 }
first_inst_index = length fun_defs
......@@ -2584,7 +2588,7 @@ checkModule {mod_type,mod_name,mod_imports,mod_imported_objects,mod_defs = cdefs
#! nr_of_functions = size icl_functions
# 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
(scanned_modules, icl_functions, cs)
......@@ -2635,8 +2639,9 @@ checkModule {mod_type,mod_name,mod_imports,mod_imported_objects,mod_defs = cdefs
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) = 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
(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
(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
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_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 }
......@@ -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)
= 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)
= partitionateAndLiftFunctions [icl_global_function_range, icl_instances] cIclModIndex icl_functions
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
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)
= 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)
# 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 }
......@@ -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} }
= (False, icl_mod, dcl_modules, {}, No, heaps, cs_predef_symbols, cs_symbol_table, cs_error.ea_file)
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
# ins_members = sort pi_members
(member_symbols, next_fun_index) = determine_indexes_of_members ins_members next_fun_index
......
......@@ -21,16 +21,16 @@ import RWSDebug
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
# (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
= (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
| not ok
= (predef_symbols, hash_table, files, error, io, out, No)
# symbol_table = hash_table.hte_symbol_heap
(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}
| not ok
= (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
| not ok
= (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) = showComponents components 0 True 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
var_heap type_heaps expression_heap
(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,
Yes { fe_icl = {icl_mod & icl_functions=fun_defs }
......
......@@ -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
# (expressions, heaps) = convertClassApplsToExpressions defs contexts rc_red_contexts heaps
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)
= 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
......
......@@ -5,4 +5,4 @@ import StdEnv
import syntax, parse, predef
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)
......@@ -8,6 +8,15 @@ import RWSDebug
**/
:: *CollectAdmin =
{ ca_error :: !*ParseErrorAdmin
, ca_fun_count :: !Int
, ca_rev_fun_defs :: ![FunDef]
, ca_predefs :: !PredefinedIdents
, ca_u_predefs :: !*PredefinedSymbols
, ca_hash_table :: !*HashTable
}
cIsAGlobalDef :== True
cIsNotAGlobalDef :== False
......@@ -40,9 +49,7 @@ exprToRhs expr
{ ewl_nodes = []
, ewl_expr = expr
, ewl_locals = LocalParsedDefs []
// , ewl_locals = CollectedLocalDefs {loc_functions = {ir_from=0,ir_to=0}, loc_nodes=[] }
}
// , rhs_locals = CollectedLocalDefs {loc_functions = {ir_from=0,ir_to=0}, loc_nodes=[] }
, rhs_locals = LocalParsedDefs []
}
......@@ -96,45 +103,52 @@ where
get_file_and_line_nr (LinePos filename linenr)
= (filename, linenr, No)
:: *CollectAdmin =
{ ca_error :: !ParseErrorAdmin
, ca_fun_count :: !Int
, ca_predefs :: !PredefinedIdents
, ca_hash_table :: !*HashTable
}
class collectFunctions a :: a !CollectAdmin -> (a, ![FunDef], !CollectAdmin)
class collectFunctions a :: a !*CollectAdmin -> (a, !*CollectAdmin)
addFunctionsRange :: [FunDef] *CollectAdmin -> (IndexRange, *CollectAdmin)
addFunctionsRange fun_defs ca
# (frm, ca)
= ca!ca_fun_count
ca
= foldSt add_function fun_defs ca
(to, ca)
= ca!ca_fun_count
= ({ir_from = frm, ir_to = to}, ca)
where
add_function :: FunDef !*CollectAdmin -> !*CollectAdmin
add_function fun_def ca=:{ca_fun_count, ca_rev_fun_defs}
= {ca & ca_fun_count = ca.ca_fun_count + 1
, ca_rev_fun_defs = [fun_def : ca.ca_rev_fun_defs]
}
instance collectFunctions ParsedExpr
where
collectFunctions (PE_List exprs) ca
# (exprs, fun_defs, ca) = collectFunctions exprs ca
= (PE_List exprs, fun_defs, ca)
# (exprs, ca) = collectFunctions exprs ca
= (PE_List exprs, ca)
collectFunctions (PE_Bound bound_expr) ca
# (bound_expr, fun_defs, ca) = collectFunctions bound_expr ca
= (PE_Bound bound_expr, fun_defs, ca)
# (bound_expr, ca) = collectFunctions bound_expr ca
= (PE_Bound bound_expr, ca)
collectFunctions (PE_Lambda lam_ident args res) ca
# fun_count = ca.ca_fun_count
next_fun_count = inc fun_count
((args,res), fun_defs, ca) = collectFunctions (args,res) {ca & ca_fun_count = next_fun_count}
fun_def = transformLambda lam_ident args res
= (PE_Let cIsStrict (CollectedLocalDefs { loc_functions = { ir_from = fun_count, ir_to = next_fun_count }, loc_nodes = [] })
(PE_Ident lam_ident), [fun_def : fun_defs], ca)
# ((args,res), ca) = collectFunctions (args,res) ca
# (range, ca) = addFunctionsRange [transformLambda lam_ident args res] ca
= (PE_Let cIsStrict (CollectedLocalDefs { loc_functions = range, loc_nodes = [] })
(PE_Ident lam_ident), ca)
collectFunctions (PE_Record rec_expr type_name fields) ca
# ((rec_expr,fields), fun_defs, ca) = collectFunctions (rec_expr,fields) ca
= (PE_Record rec_expr type_name fields, fun_defs, ca)
# ((rec_expr,fields), ca) = collectFunctions (rec_expr,fields) ca
= (PE_Record rec_expr type_name fields, ca)
collectFunctions (PE_Tuple exprs) ca
# (exprs, fun_defs, ca) = collectFunctions exprs ca
= (PE_Tuple exprs, fun_defs, ca)
# (exprs, ca) = collectFunctions exprs ca
= (PE_Tuple exprs, ca)
collectFunctions (PE_Selection is_unique expr selectors) ca
# ((expr, selectors), fun_defs, ca) = collectFunctions (expr, selectors) ca
= (PE_Selection is_unique expr selectors, fun_defs, ca)
# ((expr, selectors), ca) = collectFunctions (expr, selectors) ca
= (PE_Selection is_unique expr selectors, ca)
collectFunctions (PE_Update expr1 updates expr2) ca
# ((expr1, (updates, expr2)), fun_defs, ca) = collectFunctions (expr1, (updates, expr2)) ca
= (PE_Update expr1 updates expr2, fun_defs, ca)
# ((expr1, (updates, expr2)), ca) = collectFunctions (expr1, (updates, expr2)) ca
= (PE_Update expr1 updates expr2, ca)
collectFunctions (PE_Case case_ident pattern_expr case_alts) ca
# ((pattern_expr,case_alts), fun_defs, ca) = collectFunctions (pattern_expr,case_alts) ca
= (PE_Case case_ident pattern_expr case_alts, fun_defs, ca)
# ((pattern_expr,case_alts), ca) = collectFunctions (pattern_expr,case_alts) ca
= (PE_Case case_ident pattern_expr case_alts, ca)
collectFunctions (PE_If if_ident c t e) ca
# true_pattern = PE_Basic (BVB True)
false_pattern = PE_WildCard // PE_Basic (BVB False)
......@@ -143,8 +157,8 @@ where
, {calt_pattern = false_pattern, calt_rhs = exprToRhs e}
]) ca
collectFunctions (PE_Let strict locals in_expr) ca
# ((node_defs,in_expr), fun_defs, ca) = collectFunctions (locals,in_expr) ca
= (PE_Let strict node_defs in_expr, fun_defs, ca)
# ((node_defs,in_expr), ca) = collectFunctions (locals,in_expr) ca
= (PE_Let strict node_defs in_expr, ca)
collectFunctions (PE_Compr gen_kind expr qualifiers) ca
# (compr, ca)
= transformComprehension gen_kind expr qualifiers ca
......@@ -158,152 +172,128 @@ where
collectFunctions (PE_ArrayDenot exprs) ca=:{ca_predefs}
= collectFunctions (transformArrayDenot exprs ca_predefs) ca
collectFunctions expr ca
= (expr, [], ca)
= (expr, ca)
instance collectFunctions [a] | collectFunctions a
where
collectFunctions [x:xs] ca
# (x, fun_defs_in_x, ca) = collectFunctions x ca
(xs, fun_defs_in_xs, ca) = collectFunctions xs ca
= ([x:xs], fun_defs_in_x ++ fun_defs_in_xs, ca)
collectFunctions [] ca
= ([], [], ca)
collectFunctions l ca
= mapSt collectFunctions l ca
instance collectFunctions (a,b) | collectFunctions a & collectFunctions b
where
collectFunctions (x,y) ca
# (x, fun_defs_in_x, ca) = collectFunctions x ca
(y, fun_defs_in_y, ca) = collectFunctions y ca
= ((x,y), fun_defs_in_x ++ fun_defs_in_y, ca)
# (x, ca) = collectFunctions x ca
(y, ca) = collectFunctions y ca
= ((x,y), ca)
instance collectFunctions Qualifier
where
collectFunctions qual=:{qual_generators, qual_filter} ca
# ((qual_generators, qual_filter), fun_defs, ca) = collectFunctions (qual_generators, qual_filter) ca
= ({ qual & qual_generators = qual_generators, qual_filter = qual_filter }, fun_defs, ca)
# ((qual_generators, qual_filter), ca) = collectFunctions (qual_generators, qual_filter) ca
= ({ qual & qual_generators = qual_generators, qual_filter = qual_filter }, ca)
instance collectFunctions Generator
where
collectFunctions gen=:{gen_pattern,gen_expr} ca
# ((gen_pattern,gen_expr), fun_defs, ca) = collectFunctions (gen_pattern,gen_expr) ca
= ({gen & gen_pattern = gen_pattern, gen_expr = gen_expr}, fun_defs, ca)
# ((gen_pattern,gen_expr), ca) = collectFunctions (gen_pattern,gen_expr) ca
= ({gen & gen_pattern = gen_pattern, gen_expr = gen_expr}, ca)
instance collectFunctions (Optional a) | collectFunctions a
where
collectFunctions (Yes expr) ca
# (expr, fun_defs, ca) = collectFunctions expr ca
= (Yes expr, fun_defs, ca)
# (expr, ca) = collectFunctions expr ca
= (Yes expr, ca)
collectFunctions No ca
= (No, [], ca)
= (No, ca)
instance collectFunctions ParsedSelection
where
collectFunctions (PS_Array index_expr) ca
# (index_expr, fun_defs, ca) = collectFunctions index_expr ca
= (PS_Array index_expr, fun_defs, ca)
# (index_expr, ca) = collectFunctions index_expr ca
= (PS_Array index_expr, ca)
collectFunctions expr ca
= (expr, [], ca)
= (expr, ca)
instance collectFunctions CaseAlt
where
collectFunctions calt=:{calt_pattern,calt_rhs} ca
// MW why not # (calt_rhs, fun_defs, ca) = collectFunctions calt_rhs ca
# ((calt_pattern,calt_rhs), fun_defs, ca) = collectFunctions (calt_pattern,calt_rhs) ca
= ({calt & calt_pattern = calt_pattern, calt_rhs = calt_rhs}, fun_defs, ca)
instance collectFunctions Sequence
where
collectFunctions (SQ_FromThen from_expr then_expr) ca
# ((from_expr,then_expr), fun_defs, ca) = collectFunctions (from_expr,then_expr) ca
= (SQ_FromThen from_expr then_expr, fun_defs, ca)
collectFunctions (SQ_FromThenTo from_expr then_expr to_expr) ca
# ((from_expr,(then_expr,to_expr)), fun_defs, ca) = collectFunctions (from_expr,(then_expr,to_expr)) ca
= (SQ_FromThenTo from_expr then_expr to_expr, fun_defs, ca)
collectFunctions (SQ_FromTo from_expr to_expr) ca
# ((from_expr,to_expr), fun_defs, ca) = collectFunctions (from_expr,to_expr) ca
= (SQ_FromTo from_expr to_expr, fun_defs, ca)
collectFunctions (SQ_From from_expr) ca
# (from_expr, fun_defs, ca) = collectFunctions from_expr ca
= (SQ_From from_expr, fun_defs, ca)
# ((calt_pattern,calt_rhs), ca) = collectFunctions (calt_pattern,calt_rhs) ca
= ({calt & calt_pattern = calt_pattern, calt_rhs = calt_rhs}, ca)
instance collectFunctions (Bind a b) | collectFunctions a & collectFunctions b
where
collectFunctions bind=:{bind_src,bind_dst} ca
# ((bind_src,bind_dst), fun_defs, ca) = collectFunctions (bind_src,bind_dst) ca
= ({ bind_src = bind_src, bind_dst = bind_dst }, fun_defs, ca)
# ((bind_src,bind_dst), ca) = collectFunctions (bind_src,bind_dst) ca
= ({bind & bind_src = bind_src, bind_dst = bind_dst }, ca)
instance collectFunctions OptGuardedAlts
where
collectFunctions (GuardedAlts guarded_exprs (Yes def_expr)) ca
# ((guarded_exprs, def_expr), fun_defs, ca) = collectFunctions (guarded_exprs, def_expr) ca
= (GuardedAlts guarded_exprs (Yes def_expr), fun_defs, ca)
# ((guarded_exprs, def_expr), ca) = collectFunctions (guarded_exprs, def_expr) ca
= (GuardedAlts guarded_exprs (Yes def_expr), ca)
collectFunctions (GuardedAlts guarded_exprs No) ca
# (guarded_exprs, fun_defs, ca) = collectFunctions guarded_exprs ca
= (GuardedAlts guarded_exprs No, fun_defs, ca)
# (guarded_exprs, ca) = collectFunctions guarded_exprs ca
= (GuardedAlts guarded_exprs No, ca)
collectFunctions (UnGuardedExpr unguarded_expr) ca
# (unguarded_expr, fun_defs, ca) = collectFunctions unguarded_expr ca
= (UnGuardedExpr unguarded_expr, fun_defs, ca)
# (unguarded_expr, ca) = collectFunctions unguarded_expr ca
= (UnGuardedExpr unguarded_expr, ca)
instance collectFunctions GuardedExpr
where
collectFunctions alt=:{alt_nodes,alt_guard,alt_expr} ca
# ((alt_nodes, (alt_guard, alt_expr)), fun_defs, ca) =
# ((alt_nodes, (alt_guard, alt_expr)), ca) =
collectFunctions (alt_nodes, (alt_guard, alt_expr)) ca
= ({alt & alt_nodes = alt_nodes, alt_guard = alt_guard, alt_expr = alt_expr}, fun_defs, ca)
= ({alt & alt_nodes = alt_nodes, alt_guard = alt_guard, alt_expr = alt_expr}, ca)
instance collectFunctions ExprWithLocalDefs
where
collectFunctions expr=:{ewl_nodes, ewl_expr,ewl_locals} ca
# ((ewl_nodes, (ewl_expr, ewl_locals)), fun_defs, ca) = collectFunctions (ewl_nodes, (ewl_expr, ewl_locals)) ca
= ({expr & ewl_nodes = ewl_nodes, ewl_expr = ewl_expr, ewl_locals = ewl_locals}, fun_defs, ca)
# ((ewl_nodes, (ewl_expr, ewl_locals)), ca) = collectFunctions (ewl_nodes, (ewl_expr, ewl_locals)) ca
= ({expr & ewl_nodes = ewl_nodes, ewl_expr = ewl_expr, ewl_locals = ewl_locals}, ca)
instance collectFunctions NodeDefWithLocals
where
collectFunctions node_def=:{ndwl_def, ndwl_locals} ca
# (( ndwl_def, ndwl_locals), fun_defs, ca) = collectFunctions (ndwl_def, ndwl_locals) ca
= ({node_def & ndwl_def = ndwl_def, ndwl_locals = ndwl_locals}, fun_defs, ca)
# (( ndwl_def, ndwl_locals), ca) = collectFunctions (ndwl_def, ndwl_locals) ca
= ({node_def & ndwl_def = ndwl_def, ndwl_locals = ndwl_locals}, ca)
instance collectFunctions Rhs
where
collectFunctions {rhs_alts, rhs_locals} ca
# ((rhs_alts, rhs_locals), fun_defs, ca) = collectFunctions (rhs_alts, rhs_locals) ca
= ({rhs_alts = rhs_alts, rhs_locals = rhs_locals}, fun_defs, ca)
# ((rhs_alts, rhs_locals), ca) = collectFunctions (rhs_alts, rhs_locals) ca
= ({rhs_alts = rhs_alts, rhs_locals = rhs_locals}, ca)
instance collectFunctions LocalDefs
where
collectFunctions (LocalParsedDefs locals) ca
# (fun_defs, node_defs, ca) = reorganizeLocalDefinitions locals ca
ir_from = ca.ca_fun_count
ir_to = ca.ca_fun_count + length fun_defs
(node_defs, fun_defs_in_node_defs, ca) = collect_functions_in_node_defs node_defs {ca & ca_fun_count = ir_to}
(fun_defs, collected_fun_defs, ca) = reorganizeLocalDefinitionsOfFunctions fun_defs ca
= (CollectedLocalDefs { loc_functions = { ir_from = ir_from, ir_to = ir_to }, loc_nodes = node_defs },
fun_defs ++ fun_defs_in_node_defs ++ collected_fun_defs, ca)
# (fun_defs, node_defs, ca) = reorganiseLocalDefinitions locals ca
(node_defs, ca) = collect_functions_in_node_defs node_defs ca
(fun_defs, ca) = collectFunctions fun_defs ca
(range, ca) = addFunctionsRange fun_defs ca
= (CollectedLocalDefs { loc_functions = range, loc_nodes = node_defs }, ca)
where
collect_functions_in_node_defs :: [(Optional SymbolType,NodeDef ParsedExpr)] *CollectAdmin -> ([(Optional SymbolType,NodeDef ParsedExpr)],[FunDef],*CollectAdmin)
collect_functions_in_node_defs :: [(Optional SymbolType,NodeDef ParsedExpr)] *CollectAdmin -> ([(Optional SymbolType,NodeDef ParsedExpr)],*CollectAdmin)
collect_functions_in_node_defs [ (node_def_type, bind) : node_defs ] ca
# (bind, fun_defs_in_bind, ca) = collectFunctions bind ca
(node_defs, fun_defs_in_node_defs, ca) = collect_functions_in_node_defs node_defs ca
= ([(node_def_type, bind):node_defs], fun_defs_in_bind ++ fun_defs_in_node_defs, ca)
# (bind, ca) = collectFunctions bind ca
(node_defs, ca) = collect_functions_in_node_defs node_defs ca
= ([(node_def_type, bind):node_defs], ca)
collect_functions_in_node_defs [] ca
= ([], [], ca)
= ([], ca)
// RWS ... +++ remove recollection
collectFunctions locals ca
= (locals, [], ca)
= (locals, ca)
// ... RWS
instance collectFunctions (NodeDef a) | collectFunctions a
where
collectFunctions node_def=:{nd_dst,nd_alts,nd_locals} ca
# ((nd_dst,(nd_alts,nd_locals)), fun_defs, ca) = collectFunctions (nd_dst,(nd_alts,nd_locals)) ca
= ({ node_def & nd_dst = nd_dst, nd_alts = nd_alts, nd_locals = nd_locals }, fun_defs, ca)
# ((nd_dst,(nd_alts,nd_locals)), ca) = collectFunctions (nd_dst,(nd_alts,