aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--frontend/check.icl63
-rw-r--r--frontend/comparedefimp.icl11
-rw-r--r--frontend/convertcases.icl7
-rw-r--r--frontend/frontend.icl14
-rw-r--r--frontend/overloading.icl10
-rw-r--r--frontend/postparse.icl322
-rw-r--r--frontend/syntax.dcl9
-rw-r--r--frontend/syntax.icl35
-rw-r--r--frontend/trans.icl39
-rw-r--r--frontend/transform.dcl15
-rw-r--r--frontend/transform.icl438
-rw-r--r--frontend/type.icl16
12 files changed, 549 insertions, 430 deletions
diff --git a/frontend/check.icl b/frontend/check.icl
index 1353c39..3ceeeeb 100644
--- a/frontend/check.icl
+++ b/frontend/check.icl
@@ -669,6 +669,7 @@ where
= (AP_Algebraic cons_symbol cons_def.cons_type_index patterns opt_var, ums)
= (AP_Empty cons_def.cons_symb, { ums & ums_cons_defs = ums_cons_defs, ums_modules = ums_modules,
ums_error = checkError cons_def.cons_symb " missing argument(s)" ums_error })
+
get_cons_def mod_index cons_mod cons_index cons_defs modules
| mod_index == cons_mod
# (cons_def, cons_defs) = cons_defs![cons_index]
@@ -676,7 +677,6 @@ where
# ({dcl_common,dcl_conversions}, modules) = modules![cons_mod]
cons_def = dcl_common.com_cons_defs.[cons_index]
= (cons_def, convertIndex cons_index (toInt STE_Constructor) dcl_conversions, cons_defs, modules)
-
get_cons_def mod_index cons_mod cons_index cons_defs modules
# ({dcl_common,dcl_conversions}, modules) = modules![cons_mod]
cons_def = dcl_common.com_cons_defs.[cons_index]
@@ -703,7 +703,7 @@ checkPatternConstructor _ _ {ste_kind = STE_Empty} ident _ ps e_info cs=:{cs_er
checkPatternConstructor mod_index is_expr_list {ste_kind = STE_FunctionOrMacro _,ste_index} ident opt_var ps=:{ps_fun_defs} e_info cs=:{cs_error,cs_x}
# ({fun_symb,fun_arity,fun_kind,fun_priority},ps_fun_defs) = ps_fun_defs![ste_index]
ps = { ps & ps_fun_defs = ps_fun_defs }
- | fun_kind == FK_Macro
+ | case fun_kind of FK_DefMacro->True ; FK_ImpMacro->True; _ -> False
| is_expr_list
# macro_symbol = { glob_object = MakeDefinedSymbol fun_symb ste_index fun_arity, glob_module = cs_x.x_main_dcl_module_n }
= (AP_Constant APK_Macro macro_symbol fun_priority, ps, e_info, cs)
@@ -1112,15 +1112,21 @@ where
# ({fun_symb,fun_arity,fun_kind,fun_priority}, es_fun_defs) = es_fun_defs![ste_index]
# index = { glob_object = ste_index, glob_module = cs_x.x_main_dcl_module_n }
| is_called_before ei_fun_index calls
- | fun_kind == FK_Macro
+ | case fun_kind of FK_DefMacro->True ; FK_ImpMacro->True; _ -> False
= (SK_Macro index, fun_arity, fun_priority, cIsAFunction, { e_state & es_fun_defs = es_fun_defs }, e_info, cs)
-// = (SK_Function index, fun_arity, fun_priority, cIsAFunction, { e_state & es_fun_defs = es_fun_defs }, e_info, cs)
# symbol_kind = if ef_is_macro_fun (SK_LocalMacroFunction ste_index) (SK_Function index)
= (symbol_kind, fun_arity, fun_priority, cIsAFunction, { e_state & es_fun_defs = es_fun_defs }, e_info, cs)
# cs = { cs & cs_symbol_table = cs_symbol_table <:= (symb_info, { entry & ste_kind = STE_FunctionOrMacro [ ei_fun_index : calls ]})}
e_state = { e_state & es_fun_defs = es_fun_defs, es_calls = [{ fc_index = ste_index, fc_level = ste_def_level} : es_calls ]}
-// = (if (fun_kind == FK_Macro) (SK_Macro index) (SK_Function index), fun_arity, fun_priority, cIsAFunction, e_state, e_info, cs)
- # symbol_kind = if (fun_kind == FK_Macro) (SK_Macro index) (if ef_is_macro_fun (SK_LocalMacroFunction ste_index) (SK_Function index))
+ # symbol_kind = case fun_kind of
+ FK_DefMacro
+ -> SK_Macro index;
+ FK_ImpMacro
+ -> SK_Macro index;
+ _
+ | ef_is_macro_fun
+ -> SK_LocalMacroFunction ste_index
+ -> SK_Function index
= (symbol_kind, fun_arity, fun_priority, cIsAFunction, e_state, e_info, cs)
where
is_called_before caller_index []
@@ -2426,7 +2432,11 @@ where
get_calls (STE_FunctionOrMacro [x:xs]) = (x,xs)
get_calls ste_kind = abort "get_calls (check.icl)" // <<- ste_kind
- push_error_admin_beautifully {id_name} fun_pos (FK_Function fun_name_is_location_dependent) cs_error
+ push_error_admin_beautifully {id_name} fun_pos (FK_ImpFunction fun_name_is_location_dependent) cs_error
+ | fun_name_is_location_dependent && size id_name>0
+ # beautiful_name = if (id_name.[0]==backslash) "lambda" "comprehension"
+ = pushErrorAdmin (newPosition { id_name=beautiful_name, id_info=nilPtr } fun_pos) cs_error
+ push_error_admin_beautifully {id_name} fun_pos (FK_DefFunction fun_name_is_location_dependent) cs_error
| fun_name_is_location_dependent && size id_name>0
# beautiful_name = if (id_name.[0]==backslash) "lambda" "comprehension"
= pushErrorAdmin (newPosition { id_name=beautiful_name, id_info=nilPtr } fun_pos) cs_error
@@ -2800,7 +2810,7 @@ checkModule m icl_global_function_range fun_defs n_functions_and_macros_in_dcl_m
// # (ea_ok, icl_mod, dcl_modules, groups, dcl_icl_conversions, heaps, cs_predef_symbols, cs_symbol_table, ea_file)
= check_module2 mod_name mod_imported_objects mod_imports mod_type icl_global_function_range icl_instance_range nr_of_functions n_functions_and_macros_in_dcl_modules optional_pre_def_mod local_defs icl_functions init_dcl_modules cdefs sizes heaps cs
// = (ea_ok, icl_mod, dcl_modules, groups, dcl_icl_conversions, cached_functions_and_macros, heaps, cs_predef_symbols, cs_symbol_table, ea_file)
-
+
check_module1 {mod_type,mod_name,mod_imports,mod_imported_objects,mod_defs = cdefs} icl_global_function_range fun_defs optional_dcl_mod optional_pre_def_mod scanned_modules dcl_modules functions_and_macros dcl_module_n_in_cache predef_symbols symbol_table err_file
# error = {ea_file = err_file, ea_loc = [], ea_ok = True }
@@ -2858,7 +2868,6 @@ check_module1 {mod_type,mod_name,mod_imports,mod_imported_objects,mod_defs = cde
# (mod_entry, symbol_table) = readPtr mod_symb.pds_ident.id_info symbol_table
= case mod_entry.ste_kind of
STE_Module _
-// -> ({ pre_def_symbols & [predef_index] = { mod_symb & pds_module = cIclModIndex, pds_def = mod_entry.ste_index }}, symbol_table)
-> ({ pre_def_symbols & [predef_index] = { mod_symb & pds_module = cs_x.x_main_dcl_module_n, pds_def = mod_entry.ste_index }}, symbol_table)
_
-> (pre_def_symbols, symbol_table)
@@ -2939,6 +2948,29 @@ replace_icl_macros_by_dcl_macros _ {ir_from=first_icl_macro_index,ir_to=end_icl_
= []
= (decls,dcl_modules,cs)
+remove_function_conversion_table main_dcl_module_n dcl_modules
+ # (dcl_mod,dcl_modules) = dcl_modules![main_dcl_module_n]
+ = case dcl_mod.dcl_conversions of
+ No
+ -> ({},dcl_modules)
+ (Yes conversion_table)
+ #! size_function_conversions = size conversion_table.[cFunctionDefs]
+ # conversion_table = {e \\ e <-:conversion_table}
+ # (function_conversions,conversion_table) = replace conversion_table cFunctionDefs {n \\ n<-[0..size_function_conversions-1]}
+ # dcl_modules = {dcl_modules & [main_dcl_module_n].dcl_conversions=Yes conversion_table}
+ -> (function_conversions,dcl_modules)
+
+add_function_conversion_table dcl_to_icl_function_conversions main_dcl_module_n dcl_modules
+ # (dcl_mod,dcl_modules) = dcl_modules![main_dcl_module_n]
+ = case dcl_mod.dcl_conversions of
+ No
+ -> dcl_modules
+ (Yes conversion_table)
+ # conversion_table = {e \\ e <-:conversion_table}
+ # conversion_table = {conversion_table & [cFunctionDefs]=dcl_to_icl_function_conversions}
+ # dcl_modules = {dcl_modules & [main_dcl_module_n].dcl_conversions=Yes conversion_table}
+ -> dcl_modules
+
check_module2 :: Ident [.ImportedObject] .[Import ImportDeclaration] .ModuleKind !.IndexRange !.IndexRange !Int !Int
(Optional (Module a)) [.Declaration] *{#FunDef} *{#DclModule} (CollectedDefinitions ClassInstance IndexRange)
*{#.Int} *Heaps *CheckState
@@ -2957,13 +2989,17 @@ check_module2 mod_name mod_imported_objects mod_imports mod_type icl_global_func
(dcl_modules, icl_functions, heaps, cs)
= check_predefined_module optional_pre_def_mod dcl_modules icl_functions heaps cs
+ # (main_dcl_module_n,cs)=cs!cs_x.x_main_dcl_module_n
+ (dcl_to_icl_function_conversions,dcl_modules) = remove_function_conversion_table main_dcl_module_n dcl_modules
+
iinfo = { ii_modules = dcl_modules, ii_funs_and_macros = icl_functions, ii_next_num = 0, ii_deps = [] }
(iinfo, heaps, cs) = check_dcl_module iinfo heaps cs
(_, imported_module_numbers,{ii_modules,ii_funs_and_macros = icl_functions}, heaps, cs) = checkImports mod_imports EndModuleNumbers iinfo heaps cs
-
+
+ ii_modules = add_function_conversion_table dcl_to_icl_function_conversions main_dcl_module_n ii_modules
+
cs = { cs & cs_x.x_needed_modules = 0 }
- # (main_dcl_module_n,cs)=cs!cs_x.x_main_dcl_module_n
# imported_module_numbers = add_module_n main_dcl_module_n (add_module_n 1 imported_module_numbers)
// ii_modules = print_imported_modules 0 ii_modules
(used_module_numbers,ii_modules) = compute_used_module_numbers imported_module_numbers imported_module_numbers ii_modules
@@ -3143,7 +3179,7 @@ check_module2 mod_name mod_imported_objects mod_imports mod_type icl_global_func
= ([new_fun_def : new_fun_defs], funs_index_heaps)
= ([], (icl_functions, next_fun_index, heaps))
- build_function new_fun_index fun_def=:{fun_symb, fun_arity, fun_index, fun_body = CheckedBody {cb_args}, fun_info} fun_type
+ build_function new_fun_index fun_def=:{fun_symb, fun_index, fun_arity, fun_body = CheckedBody {cb_args}, fun_info} fun_type
(var_heap, type_var_heap, expr_heap)
# (tb_args, var_heap) = mapSt new_free_var cb_args var_heap
(app_args, expr_heap) = mapSt new_bound_var tb_args expr_heap
@@ -3152,7 +3188,7 @@ check_module2 mod_name mod_imported_objects mod_imports mod_type icl_global_func
symb_kind = SK_Function { glob_module = main_dcl_module_n, glob_object = fun_index }},
app_args = app_args,
app_info_ptr = app_info_ptr }
- = ({ fun_def & fun_index = new_fun_index, fun_body = TransformedBody {tb_args = tb_args, tb_rhs = tb_rhs}, fun_type = Yes fun_type,
+ = ({ fun_def & fun_index=new_fun_index, fun_body = TransformedBody {tb_args = tb_args, tb_rhs = tb_rhs}, fun_type = Yes fun_type,
fun_info = { EmptyFunInfo & fi_calls = [ { fc_index = fun_index, fc_level = cGlobalScope }] }},
(var_heap, type_var_heap, expr_heap))
@@ -3445,7 +3481,6 @@ checkDclModule is_on_cycle {mod_name,mod_imports,mod_defs} mod_index modules icl
cs = { cs & cs_x.x_needed_modules = 0 }
nr_of_dcl_functions = size dcl_mod.dcl_functions
-
dcls_explicit = flatten [[dcls_explicit\\dcls_explicit<-:dcls_explicit] \\ (_,{dcls_explicit})<-imports]
#! main_dcl_module_n = cs.cs_x.x_main_dcl_module_n
diff --git a/frontend/comparedefimp.icl b/frontend/comparedefimp.icl
index ec3957d..cc3cee5 100644
--- a/frontend/comparedefimp.icl
+++ b/frontend/comparedefimp.icl
@@ -19,8 +19,7 @@ implementation module comparedefimp
(see type HeapWithNumber). The same happens with attribute variables and variables in macros/functions.
*/
-import syntax, checksupport, compare_constructor, utilities, StdCompare
-import RWSDebug
+import syntax, checksupport, compare_constructor, utilities, StdCompare //, RWSDebug
:: TypesCorrespondState =
{ tc_type_vars
@@ -623,9 +622,9 @@ instance t_corresponds TypeRhs where
= return True
// sanity check ...
t_corresponds UnknownType _
- = undef <<- "t_corresponds (TypeRhs): dclDef == UnknownType"
+ = undef // <<- "t_corresponds (TypeRhs): dclDef == UnknownType"
t_corresponds _ UnknownType
- = undef <<- "t_corresponds (TypeRhs): iclDef == UnknownType"
+ = undef // <<- "t_corresponds (TypeRhs): iclDef == UnknownType"
// ... sanity check
t_corresponds _ _
= return False
@@ -990,7 +989,9 @@ continuation_for_possibly_twice_defined_macros dcl_app_symb dcl_index icl_app_sy
&& (implies (not dcl_name_is_loc_dependent) (dcl_function.fun_symb.id_name==icl_function.fun_symb.id_name))
// functions that originate from e.g. lambda expressions can correspond although their names differ
where
- name_is_location_dependent (FK_Function name_is_loc_dependent)
+ name_is_location_dependent (FK_ImpFunction name_is_loc_dependent)
+ = name_is_loc_dependent
+ name_is_location_dependent (FK_DefFunction name_is_loc_dependent)
= name_is_loc_dependent
name_is_location_dependent _
= False
diff --git a/frontend/convertcases.icl b/frontend/convertcases.icl
index 88a142c..11b09e0 100644
--- a/frontend/convertcases.icl
+++ b/frontend/convertcases.icl
@@ -1,7 +1,6 @@
implementation module convertcases
-import syntax, transform, checksupport, StdCompare, check, utilities, trans, general, RWSDebug
-
+import syntax, transform, checksupport, StdCompare, check, utilities, trans, general // , RWSDebug
:: *ConversionInfo =
{ ci_new_functions :: ![FunctionInfoPtr]
@@ -306,7 +305,7 @@ newFunction opt_id fun_bodies local_vars arg_types result_type group_index (ci_n
, fun_type = Yes fun_type
, fun_pos = NoPos
, fun_index = NoIndex
- , fun_kind = FK_Function cNameNotLocationDependent
+ , fun_kind = FK_ImpFunction cNameNotLocationDependent
, fun_lifted = 0
, fun_info = { EmptyFunInfo & fi_group_index = group_index, fi_local_vars = local_vars }
}
@@ -792,7 +791,7 @@ where
{ cp_info & cp_free_vars = [ (var_info_ptr, type) : cp_info.cp_free_vars ],
cp_var_heap = cp_var_heap <:= (var_info_ptr, VI_FreeVar var_name new_info_ptr 1 type) })
_
- -> abort "copy [BoundVar] (convertcases, 612)" <<- (var_info ---> (var_name, ptrToInt var_info_ptr))
+ -> abort "copy [BoundVar] (convertcases)" // <<- (var_info ---> (var_name, ptrToInt var_info_ptr))
instance copy Expression
where
diff --git a/frontend/frontend.icl b/frontend/frontend.icl
index 13af162..00bce5a 100644
--- a/frontend/frontend.icl
+++ b/frontend/frontend.icl
@@ -73,7 +73,7 @@ frontSyntaxTree predef_symbols hash_table files error io out icl_mod dcl_mods fu
frontEndInterface :: !FrontEndPhase !Ident !SearchPaths !{#DclModule} !{#FunDef} !(Optional Bool) !*PredefinedSymbols !*HashTable !*Files !*File !*File !*File !*Heaps -> ( !Optional *FrontEndSyntaxTree,!.{# FunDef },!Int,!Int,!*PredefinedSymbols, !*HashTable, !*Files, !*File, !*File, !*File,!*Heaps)
frontEndInterface upToPhase mod_ident search_paths dcl_modules functions_and_macros list_inferred_types predef_symbols hash_table files error io out heaps
# (ok, mod, hash_table, error, predef_symbols, files)
- = wantModule cWantIclFile mod_ident NoPos (hash_table -*-> ("Parsing:", mod_ident)) error search_paths predef_symbols files
+ = wantModule cWantIclFile mod_ident NoPos (hash_table /* ---> ("Parsing:", mod_ident)*/) error search_paths predef_symbols files
| not ok
= (No,{},0,0,predef_symbols, hash_table, files, error, io, out,heaps)
# cached_module_idents = [dcl_mod.dcl_name \\ dcl_mod<-:dcl_modules]
@@ -100,13 +100,17 @@ frontEndInterface upToPhase mod_ident search_paths dcl_modules functions_and_mac
// # {icl_functions,icl_instances,icl_specials,icl_common,icl_import} = icl_mod
# {icl_instances,icl_specials,icl_common,icl_import,icl_name,icl_imported_objects,icl_used_module_numbers} = icl_mod
-
-// (components, icl_functions, error) = showComponents components 0 True icl_functions error
-
+/*
+ (_,f,files) = fopen "components" FWriteText files
+ (components, icl_functions, f) = showComponents components 0 True icl_functions f
+ (ok,files) = fclose f files
+ | ok<>ok
+ = abort "";
+*/
// dcl_mods = {{dcl_mod & dcl_declared={dcls_import=[],dcls_local=[],dcls_explicit=[]}}\\ dcl_mod<-:dcl_mods}
// # dcl_mods = {{dcl_mod & dcl_declared={dcls_import={},dcls_local=[],dcls_local_for_import={},dcls_explicit={}}}\\ dcl_mod<-:dcl_mods}
- var_heap = heaps.hp_var_heap
+ # var_heap = heaps.hp_var_heap
type_heaps = heaps.hp_type_heaps
fun_defs = icl_functions
array_instances = {ir_from=0, ir_to=0}
diff --git a/frontend/overloading.icl b/frontend/overloading.icl
index 57b6d1f..83baedb 100644
--- a/frontend/overloading.icl
+++ b/frontend/overloading.icl
@@ -2,8 +2,7 @@ implementation module overloading
import StdEnv
-import syntax, check, type, typesupport, utilities, unitype, predef, checktypes, RWSDebug, convertDynamics
-
+import syntax, check, type, typesupport, utilities, unitype, predef, checktypes, convertDynamics // ,RWSDebug
:: InstanceTree = IT_Node !(Global Index) !InstanceTree !InstanceTree | IT_Empty
@@ -695,7 +694,7 @@ expressionToTypeCodeExpression (ClassVariable var_info_ptr) = TCE_TypeTerm var
/*
expressionToTypeCodeExpression (Var {var_info_ptr}) = TCE_Var var_info_ptr
*/
-expressionToTypeCodeExpression expr = abort ("expressionToTypeCodeExpression (overloading.icl)" <<- expr)
+expressionToTypeCodeExpression expr = abort "expressionToTypeCodeExpression (overloading.icl)" // <<- expr)
generateClassSelection address last_selectors
= mapAppend (\(off_set,selector) -> RecordSelection selector off_set) address last_selectors
@@ -1170,11 +1169,10 @@ where
get_recursive_fun_index :: !Index !SymbKind Int !{# FunDef} -> Index
get_recursive_fun_index group_index (SK_Function {glob_module,glob_object}) main_dcl_module_n fun_defs
-// | glob_module == cIclModIndex
| glob_module == main_dcl_module_n
- # {fun_info, fun_index} = fun_defs.[glob_object]
+ # {fun_info,fun_index} = fun_defs.[glob_object]
| fun_info.fi_group_index == group_index
- = fun_index
+ = fun_index
= NoIndex
= NoIndex
get_recursive_fun_index group_index _ main_dcl_module_n fun_defs
diff --git a/frontend/postparse.icl b/frontend/postparse.icl
index 9110509..16ef220 100644
--- a/frontend/postparse.icl
+++ b/frontend/postparse.icl
@@ -100,8 +100,6 @@ where
get_file_and_line_nr (LinePos filename linenr)
= (filename, linenr, No)
-class collectFunctions a :: a !*CollectAdmin -> (a, !*CollectAdmin)
-
addFunctionsRange :: [FunDef] *CollectAdmin -> (IndexRange, *CollectAdmin)
addFunctionsRange fun_defs ca
# (frm, ca)
@@ -118,197 +116,248 @@ addFunctionsRange fun_defs ca
, ca_rev_fun_defs = [fun_def : ca.ca_rev_fun_defs]
}
+class collectFunctions a :: a Bool !*CollectAdmin -> (a, !*CollectAdmin)
+
instance collectFunctions ParsedExpr
where
- collectFunctions (PE_List exprs) ca
- # (exprs, ca) = collectFunctions exprs ca
+ collectFunctions (PE_List exprs) icl_module ca
+ # (exprs, ca) = collectFunctions exprs icl_module ca
= (PE_List exprs, ca)
- collectFunctions (PE_Bound bound_expr) ca
- # (bound_expr, ca) = collectFunctions bound_expr ca
+ collectFunctions (PE_Bound bound_expr) icl_module ca
+ # (bound_expr, ca) = collectFunctions bound_expr icl_module ca
= (PE_Bound bound_expr, ca)
- collectFunctions (PE_Lambda lam_ident args res pos) ca
- # ((args,res), ca) = collectFunctions (args,res) ca
- # (range, ca) = addFunctionsRange [transformLambda lam_ident args res pos] ca
+ collectFunctions (PE_Lambda lam_ident args res pos) icl_module ca
+ # ((args,res), ca) = collectFunctions (args,res) icl_module ca
+ # (range, ca) = addFunctionsRange [transformLambda lam_ident args res pos icl_module] 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), ca) = collectFunctions (rec_expr,fields) ca
+ collectFunctions (PE_Record rec_expr type_name fields) icl_module ca
+ # ((rec_expr,fields), ca) = collectFunctions (rec_expr,fields) icl_module ca
= (PE_Record rec_expr type_name fields, ca)
- collectFunctions (PE_Tuple exprs) ca
- # (exprs, ca) = collectFunctions exprs ca
+ collectFunctions (PE_Tuple exprs) icl_module ca
+ # (exprs, ca) = collectFunctions exprs icl_module ca
= (PE_Tuple exprs, ca)
- collectFunctions (PE_Selection is_unique expr selectors) ca
- # ((expr, selectors), ca) = collectFunctions (expr, selectors) ca
+ collectFunctions (PE_Selection is_unique expr selectors) icl_module ca
+ # ((expr, selectors), ca) = collectFunctions (expr, selectors) icl_module ca
= (PE_Selection is_unique expr selectors, ca)
- collectFunctions (PE_Update expr1 updates expr2) ca
- # ((expr1, (updates, expr2)), ca) = collectFunctions (expr1, (updates, expr2)) ca
+ collectFunctions (PE_Update expr1 updates expr2) icl_module ca
+ # ((expr1, (updates, expr2)), ca) = collectFunctions (expr1, (updates, expr2)) icl_module ca
= (PE_Update expr1 updates expr2, ca)
- collectFunctions (PE_Case case_ident pattern_expr case_alts) ca
- # ((pattern_expr,case_alts), ca) = collectFunctions (pattern_expr,case_alts) ca
+ collectFunctions (PE_Case case_ident pattern_expr case_alts) icl_module ca
+ # ((pattern_expr,case_alts), ca) = collectFunctions (pattern_expr,case_alts) icl_module ca
= (PE_Case case_ident pattern_expr case_alts, ca)
- collectFunctions (PE_If if_ident c t e) ca
+ collectFunctions (PE_If if_ident c t e) icl_module ca
# true_pattern = PE_Basic (BVB True)
false_pattern = PE_WildCard // PE_Basic (BVB False)
= collectFunctions (PE_Case if_ident c
[ {calt_pattern = true_pattern , calt_rhs = exprToRhs t}
, {calt_pattern = false_pattern, calt_rhs = exprToRhs e}
- ]) ca
- collectFunctions (PE_Let strict locals in_expr) ca
- # ((node_defs,in_expr), ca) = collectFunctions (locals,in_expr) ca
+ ]) icl_module ca
+ collectFunctions (PE_Let strict locals in_expr) icl_module ca
+ # ((node_defs,in_expr), ca) = collectFunctions (locals,in_expr) icl_module ca
= (PE_Let strict node_defs in_expr, ca)
- collectFunctions (PE_Compr gen_kind expr qualifiers) ca
+ collectFunctions (PE_Compr gen_kind expr qualifiers) icl_module ca
# (compr, ca)
= transformComprehension gen_kind expr qualifiers ca
- = collectFunctions compr ca
- collectFunctions (PE_UpdateComprehension expr updateExpr identExpr qualifiers) ca
+ = collectFunctions compr icl_module ca
+ collectFunctions (PE_UpdateComprehension expr updateExpr identExpr qualifiers) icl_module ca
# (compr, ca)
= transformUpdateComprehension expr updateExpr identExpr qualifiers ca
- = collectFunctions compr ca
- collectFunctions (PE_Sequ sequence) ca=:{ca_predefs}
- = collectFunctions (transformSequence sequence ca_predefs) ca
- collectFunctions (PE_ArrayDenot exprs) ca=:{ca_predefs}
- = collectFunctions (transformArrayDenot exprs ca_predefs) ca
- collectFunctions (PE_Dynamic exprs opt_dyn_type) ca
- # (exprs, ca) = collectFunctions exprs ca
+ = collectFunctions compr icl_module ca
+ collectFunctions (PE_Sequ sequence) icl_module ca=:{ca_predefs}
+ = collectFunctions (transformSequence sequence ca_predefs) icl_module ca
+ collectFunctions (PE_ArrayDenot exprs) icl_module ca=:{ca_predefs}
+ = collectFunctions (transformArrayDenot exprs ca_predefs) icl_module ca
+ collectFunctions (PE_Dynamic exprs opt_dyn_type) icl_module ca
+ # (exprs, ca) = collectFunctions exprs icl_module ca
= (PE_Dynamic exprs opt_dyn_type, ca)
- collectFunctions expr ca
+ collectFunctions expr icl_module ca
= (expr, ca)
instance collectFunctions [a] | collectFunctions a
where
- collectFunctions l ca
- = mapSt collectFunctions l ca
+ collectFunctions l icl_module ca
+// = mapSt collectFunctions l icl_module ca
+ = map_st l ca
+ where
+ map_st [x : xs] s
+ # (x, s) = collectFunctions x icl_module s
+ (xs, s) = map_st xs s
+ #! s = s
+ = ([x : xs], s)
+ map_st [] s
+ = ([], s)
instance collectFunctions (a,b) | collectFunctions a & collectFunctions b
where
- collectFunctions (x,y) ca
- # (x, ca) = collectFunctions x ca
- (y, ca) = collectFunctions y ca
+ collectFunctions (x,y) icl_module ca
+ # (x, ca) = collectFunctions x icl_module ca
+ (y, ca) = collectFunctions y icl_module ca
= ((x,y), ca)
instance collectFunctions Qualifier
where
- collectFunctions qual=:{qual_generators, qual_filter} ca
- # ((qual_generators, qual_filter), ca) = collectFunctions (qual_generators, qual_filter) ca
+ collectFunctions qual=:{qual_generators, qual_filter} icl_module ca
+ # ((qual_generators, qual_filter), ca) = collectFunctions (qual_generators, qual_filter) icl_module 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), ca) = collectFunctions (gen_pattern,gen_expr) ca
+ collectFunctions gen=:{gen_pattern,gen_expr} icl_module ca
+ # ((gen_pattern,gen_expr), ca) = collectFunctions (gen_pattern,gen_expr) icl_module ca
= ({gen & gen_pattern = gen_pattern, gen_expr = gen_expr}, ca)
instance collectFunctions (Optional a) | collectFunctions a
where
- collectFunctions (Yes expr) ca
- # (expr, ca) = collectFunctions expr ca
+ collectFunctions (Yes expr) icl_module ca
+ # (expr, ca) = collectFunctions expr icl_module ca
= (Yes expr, ca)
- collectFunctions No ca
+ collectFunctions No icl_module ca
= (No, ca)
instance collectFunctions ParsedSelection
where
- collectFunctions (PS_Array index_expr) ca
- # (index_expr, ca) = collectFunctions index_expr ca
+ collectFunctions (PS_Array index_expr) icl_module ca
+ # (index_expr, ca) = collectFunctions index_expr icl_module ca
= (PS_Array index_expr, ca)
- collectFunctions expr ca
+ collectFunctions expr icl_module ca
= (expr, ca)
instance collectFunctions CaseAlt
where
- collectFunctions calt=:{calt_pattern,calt_rhs} ca
- # ((calt_pattern,calt_rhs), ca) = collectFunctions (calt_pattern,calt_rhs) ca
+ collectFunctions calt=:{calt_pattern,calt_rhs} icl_module ca
+ # ((calt_pattern,calt_rhs), ca) = collectFunctions (calt_pattern,calt_rhs) icl_module 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), ca) = collectFunctions (bind_src,bind_dst) ca
+ collectFunctions bind=:{bind_src,bind_dst} icl_module ca
+ # ((bind_src,bind_dst), ca) = collectFunctions (bind_src,bind_dst) icl_module 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), ca) = collectFunctions (guarded_exprs, def_expr) ca
+ collectFunctions (GuardedAlts guarded_exprs (Yes def_expr)) icl_module ca
+ # ((guarded_exprs, def_expr), ca) = collectFunctions (guarded_exprs, def_expr) icl_module ca
= (GuardedAlts guarded_exprs (Yes def_expr), ca)
- collectFunctions (GuardedAlts guarded_exprs No) ca
- # (guarded_exprs, ca) = collectFunctions guarded_exprs ca
+ collectFunctions (GuardedAlts guarded_exprs No) icl_module ca
+ # (guarded_exprs, ca) = collectFunctions guarded_exprs icl_module ca
= (GuardedAlts guarded_exprs No, ca)
- collectFunctions (UnGuardedExpr unguarded_expr) ca
- # (unguarded_expr, ca) = collectFunctions unguarded_expr ca
+ collectFunctions (UnGuardedExpr unguarded_expr) icl_module ca
+ # (unguarded_expr, ca) = collectFunctions unguarded_expr icl_module ca
= (UnGuardedExpr unguarded_expr, ca)
instance collectFunctions GuardedExpr
where
- collectFunctions alt=:{alt_nodes,alt_guard,alt_expr} ca
+ collectFunctions alt=:{alt_nodes,alt_guard,alt_expr} icl_module ca
# ((alt_nodes, (alt_guard, alt_expr)), ca) =
- collectFunctions (alt_nodes, (alt_guard, alt_expr)) ca
+ collectFunctions (alt_nodes, (alt_guard, alt_expr)) icl_module 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)), ca) = collectFunctions (ewl_nodes, (ewl_expr, ewl_locals)) ca
+ collectFunctions expr=:{ewl_nodes, ewl_expr,ewl_locals} icl_module ca
+ # ((ewl_nodes, (ewl_expr, ewl_locals)), ca) = collectFunctions (ewl_nodes, (ewl_expr, ewl_locals)) icl_module 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), ca) = collectFunctions (ndwl_def, ndwl_locals) ca
+ collectFunctions node_def=:{ndwl_def, ndwl_locals} icl_module ca
+ # (( ndwl_def, ndwl_locals), ca) = collectFunctions (ndwl_def, ndwl_locals) icl_module 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), ca) = collectFunctions (rhs_alts, rhs_locals) ca
+ collectFunctions {rhs_alts, rhs_locals} icl_module ca
+ # ((rhs_alts, rhs_locals), ca) = collectFunctions (rhs_alts, rhs_locals) icl_module ca
= ({rhs_alts = rhs_alts, rhs_locals = rhs_locals}, ca)
instance collectFunctions LocalDefs
where
- collectFunctions (LocalParsedDefs locals) ca
+ collectFunctions (LocalParsedDefs locals) icl_module 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
+ (fun_defs, ca) = collectFunctions fun_defs icl_module ca
(range, ca) = addFunctionsRange fun_defs ca
= (CollectedLocalDefs { loc_functions = range, loc_nodes = node_defs }, ca)
where
+ reorganiseLocalDefinitions :: [ParsedDefinition] *CollectAdmin -> ([FunDef],[(Optional SymbolType,NodeDef ParsedExpr)],*CollectAdmin)
+ reorganiseLocalDefinitions [PD_NodeDef pos pattern {rhs_alts,rhs_locals} : defs] ca
+ # (fun_defs, node_defs, ca) = reorganiseLocalDefinitions defs ca
+ = (fun_defs, [(No, { nd_dst = pattern, nd_alts = rhs_alts, nd_locals = rhs_locals, nd_position = pos }) : node_defs], ca)
+ reorganiseLocalDefinitions [PD_Function pos name is_infix args rhs fun_kind : defs] ca
+ # prio = if is_infix (Prio NoAssoc 9) NoPrio
+ fun_arity = length args
+ (bodies, fun_kind, defs, ca) = collectFunctionBodies name fun_arity prio fun_kind defs ca
+ (fun_defs, node_defs, ca) = reorganiseLocalDefinitions defs ca
+ fun = MakeNewImpOrDefFunction icl_module name fun_arity [{ pb_args = args, pb_rhs = rhs, pb_position = pos } : bodies ] fun_kind prio No pos
+ = ([ fun : fun_defs ], node_defs, ca)
+ reorganiseLocalDefinitions [PD_TypeSpec pos1 name1 prio type specials : defs] ca
+ = case defs of
+ [PD_Function pos name is_infix args rhs fun_kind : _]
+ | belongsToTypeSpec name1 prio name is_infix
+ # fun_arity = determineArity args type
+ # (bodies, fun_kind, defs, ca) = collectFunctionBodies name1 fun_arity prio fun_kind defs ca
+ (fun_defs, node_defs, ca) = reorganiseLocalDefinitions defs ca
+ fun = MakeNewImpOrDefFunction icl_module name fun_arity bodies fun_kind prio type pos
+ -> ([fun : fun_defs], node_defs, ca)
+ -> reorganiseLocalDefinitions defs (postParseError pos "function body expected" ca)
+ [PD_NodeDef pos pattern=:(PE_Ident id) {rhs_alts,rhs_locals} : defs]
+ | belongsToTypeSpec name1 prio id False
+ # (fun_defs, node_defs, ca) = reorganiseLocalDefinitions defs ca
+ -> (fun_defs, [(type, { nd_dst = pattern, nd_alts = rhs_alts, nd_locals = rhs_locals, nd_position = pos }) : node_defs], ca)
+ -> reorganiseLocalDefinitions defs (postParseError pos "function body expected" ca)
+ _
+ -> reorganiseLocalDefinitions defs (postParseError pos1 "function body expected" ca)
+ reorganiseLocalDefinitions [] ca
+ = ([], [], ca)
+
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, ca) = collectFunctions bind ca
+ # (bind, ca) = collectFunctions bind icl_module 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)
// RWS ... +++ remove recollection
- collectFunctions locals ca
+ collectFunctions locals icl_module 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)), ca) = collectFunctions (nd_dst,(nd_alts,nd_locals)) ca
+ collectFunctions node_def=:{nd_dst,nd_alts,nd_locals} icl_module ca
+ # ((nd_dst,(nd_alts,nd_locals)), ca) = collectFunctions (nd_dst,(nd_alts,nd_locals)) icl_module ca
= ({ node_def & nd_dst = nd_dst, nd_alts = nd_alts, nd_locals = nd_locals }, ca)
instance collectFunctions Ident
where
- collectFunctions e ca
+ collectFunctions e icl_module ca
= (e, ca)
+instance collectFunctions (ParsedInstance a) | collectFunctions a where
+ collectFunctions inst=:{pi_members} icl_module ca
+ # (pi_members, ca) = collectFunctions pi_members icl_module ca
+ = ({inst & pi_members = pi_members }, ca)
+
+instance collectFunctions FunDef where
+ collectFunctions fun_def=:{fun_body = ParsedBody bodies} icl_module ca
+ # (bodies, ca) = collectFunctions bodies icl_module ca
+ = ({fun_def & fun_body = ParsedBody bodies}, ca)
+
+instance collectFunctions ParsedBody where
+ collectFunctions pb=:{pb_rhs} icl_module ca
+ # (pb_rhs, ca) = collectFunctions pb_rhs icl_module ca
+ = ({ pb & pb_rhs = pb_rhs }, ca)
+
NoCollectedLocalDefs :== CollectedLocalDefs { loc_functions = { ir_from = 0, ir_to = 0 }, loc_nodes = [] }
-// MW was:transformLambda :: Ident [ParsedExpr] ParsedExpr -> FunDef
-transformLambda :: Ident [ParsedExpr] ParsedExpr Position -> FunDef
-// MW was:transformLambda lam_ident args result
-transformLambda lam_ident args result pos
- # lam_rhs = { rhs_alts = UnGuardedExpr { ewl_nodes = [], ewl_expr = result, ewl_locals = NoCollectedLocalDefs,
- ewl_position = NoPos },
- rhs_locals = NoCollectedLocalDefs }
-// MW4 was: lam_body = [{pb_args = args, pb_rhs = lam_rhs }]
+transformLambda :: Ident [ParsedExpr] ParsedExpr Position Bool -> FunDef
+transformLambda lam_ident args result pos icl_module
+ # lam_rhs = { rhs_alts = UnGuardedExpr { ewl_nodes = [], ewl_expr = result, ewl_locals = NoCollectedLocalDefs, ewl_position = NoPos },
+ rhs_locals = NoCollectedLocalDefs }
lam_body = [{pb_args = args, pb_rhs = lam_rhs, pb_position = pos }]
-// MW was: fun_def = MakeNewFunction lam_ident (length args) lam_body (FK_Function cNameLocationDependent) NoPrio No NoPos
- fun_def = MakeNewFunction lam_ident (length args) lam_body (FK_Function cNameLocationDependent) NoPrio No pos
- = fun_def
+ = MakeNewImpOrDefFunction icl_module lam_ident (length args) lam_body (FK_Function cNameLocationDependent) NoPrio No pos
makeNilExpression :: *CollectAdmin -> (ParsedExpr,*CollectAdmin)
makeNilExpression ca=:{ca_predefs}
@@ -427,7 +476,6 @@ transformQualifier {qual_generators, qual_filter, qual_position, qual_filename}
// =array&callArray are misnomers (can also be records)
transformUpdateQualifier :: ParsedExpr ParsedExpr Qualifier *CollectAdmin -> (TransformedQualifier, *CollectAdmin)
-//MW3 was:transformUpdateQualifier array callArray {qual_generators, qual_filter, qual_position} ca
transformUpdateQualifier array callArray {qual_generators, qual_filter, qual_position, qual_filename} ca
# (transformedGenerators, ca)
= mapSt transformGenerator qual_generators ca
@@ -473,7 +521,6 @@ transformComprehension gen_kind expr qualifiers ca
(create_array, ca)
= get_predef_id PD__CreateArrayFun ca
(length, ca)
-//MW3 was: = computeLength qualifiers qual_position ca
= computeLength qualifiers qual_position hd_qualifier.qual_filename ca
new_array
= PE_List [PE_Ident create_array, length]
@@ -483,8 +530,6 @@ transformComprehension gen_kind expr qualifiers ca
= [{hd_qualifier & qual_generators = [index_generator : hd_qualifier.qual_generators] } : tl_qualifiers]
= transformUpdateComprehension new_array update (PE_Ident c_a) qualifiers ca
-//MW3 was:computeLength :: [Qualifier] LineAndColumn *CollectAdmin -> (ParsedExpr, *CollectAdmin)
-//MW3 was:computeLength qualifiers qual_position ca
computeLength :: [Qualifier] LineAndColumn FileName *CollectAdmin -> (ParsedExpr, *CollectAdmin)
computeLength qualifiers qual_position qual_filename ca
# (fun_ident, ca)
@@ -500,12 +545,6 @@ computeLength qualifiers qual_position qual_filename ca
(inc, ca)
= get_predef_id PD_IncFun ca
new_fun_pos = LinePos qual_filename qual_position.lc_line // MW3++
-/* MW3 was
- parsedFunction1
- = MakeNewParsedDef fun_ident [cons, PE_Ident i_ident] (exprToRhs (PE_List [PE_Ident fun_ident, PE_Ident tail_ident, PE_List [PE_Ident inc, PE_Ident i_ident]]))
- parsedFunction2
- = MakeNewParsedDef fun_ident [PE_WildCard, PE_Ident i_ident] (exprToRhs (PE_Ident i_ident))
-*/
parsedFunction1
= MakeNewParsedDef fun_ident [cons, PE_Ident i_ident]
(exprToRhs (PE_List [PE_Ident fun_ident, PE_Ident tail_ident, PE_List [PE_Ident inc, PE_Ident i_ident]]))
@@ -708,7 +747,7 @@ where
# (_, defs, imports, imported_objects, ca)
= reorganiseDefinitions False pdefs 0 0 0 ca
(macro_defs, ca)
- = collectFunctions defs.def_macros ca
+ = collectFunctions defs.def_macros False ca
(range, ca)
= addFunctionsRange macro_defs ca
(pea_ok,ca)
@@ -748,11 +787,11 @@ scanModule mod=:{mod_name,mod_type,mod_defs = pdefs} cached_modules first_new_fu
ca = {ca & ca_hash_table=set_hte_mark 1 ca.ca_hash_table}
- (fun_defs, ca) = collectFunctions fun_defs ca
+ (fun_defs, ca) = collectFunctions fun_defs True ca
(fun_range, ca) = addFunctionsRange fun_defs ca
- (macro_defs, ca) = collectFunctions defs.def_macros ca
+ (macro_defs, ca) = collectFunctions defs.def_macros True ca
(macro_range, ca) = addFunctionsRange macro_defs ca
- (def_instances, ca) = collectFunctions defs.def_instances ca
+ (def_instances, ca) = collectFunctions defs.def_instances True ca
ca = {ca & ca_hash_table=set_hte_mark 0 ca.ca_hash_table}
@@ -796,7 +835,7 @@ where
= (import_ok, Yes mod, NoIndex,parsed_modules, cached_modules,files, ca)
collect_main_dcl_module (Yes mod=:{mod_defs=defs}) dcl_module_n ca
- # (macro_defs, ca) = collectFunctions defs.def_macros ca
+ # (macro_defs, ca) = collectFunctions defs.def_macros False ca
(range, ca) = addFunctionsRange macro_defs ca
(pea_ok,ca) = ca!ca_error.pea_ok
mod = { mod & mod_defs = { defs & def_macros = range }}
@@ -806,25 +845,21 @@ where
= (True,Yes (MakeEmptyModule mod_name),ca)
= (True,No,ca)
-instance collectFunctions (ParsedInstance a) | collectFunctions a where
- collectFunctions inst=:{pi_members} ca
- # (pi_members, ca) = collectFunctions pi_members ca
- = ({inst & pi_members = pi_members }, ca)
-
-instance collectFunctions FunDef where
- collectFunctions fun_def=:{fun_body = ParsedBody bodies} ca
- # (bodies, ca) = collectFunctions bodies ca
- = ({fun_def & fun_body = ParsedBody bodies}, ca)
-
-instance collectFunctions ParsedBody where
- collectFunctions pb=:{pb_rhs} ca
- # (pb_rhs, ca) = collectFunctions pb_rhs ca
- = ({ pb & pb_rhs = pb_rhs }, ca)
-
-MakeNewFunction name arity body kind prio opt_type pos
- :== { fun_symb = name, fun_arity = arity, fun_priority = prio, fun_type = opt_type, fun_kind = kind,
+MakeNewImpOrDefFunction icl_module name arity body kind prio opt_type pos
+ :== { fun_symb = name, fun_arity = arity, fun_priority = prio, fun_type = opt_type, fun_kind = fun_kind_to_def_or_imp_fun_kind icl_module kind,
fun_body = ParsedBody body, fun_pos = pos, fun_lifted = 0, fun_index = NoIndex, fun_info = EmptyFunInfo }
+fun_kind_to_def_or_imp_fun_kind icl_module (FK_Function b)
+ | icl_module
+ = FK_ImpFunction b
+ = FK_DefFunction b
+fun_kind_to_def_or_imp_fun_kind icl_module FK_Macro
+ | icl_module
+ = FK_ImpMacro
+ = FK_DefMacro
+fun_kind_to_def_or_imp_fun_kind icl_module FK_Caf = FK_ImpCaf
+fun_kind_to_def_or_imp_fun_kind icl_module FK_Unknown = FK_DefOrImpUnknown
+
/* MW3 was
// +++ position
MakeNewParsedDef ident args rhs
@@ -862,15 +897,13 @@ collectFunctionBodies fun_name fun_arity fun_prio fun_kind all_defs=:[PD_Functio
collectFunctionBodies fun_name fun_arity fun_prio fun_kind defs ca
= ([], fun_kind, defs, ca)
-//reorganiseDefinitions :: Bool [ParsedDefinition] Index Index Index *CollectAdmin -> ([FunDef],CollectedDefinitions (ParsedInstance FunDef) [FunDef], [ParsedImport], [ImportedObject], *CollectAdmin)
reorganiseDefinitions :: Bool [ParsedDefinition] Index Index Index *CollectAdmin -> (![FunDef],!CollectedDefinitions (ParsedInstance FunDef) [FunDef], ![ParsedImport], ![ImportedObject], !*CollectAdmin)
reorganiseDefinitions icl_module [PD_Function pos name is_infix args rhs fun_kind : defs] cons_count sel_count mem_count ca
# prio = if is_infix (Prio NoAssoc 9) NoPrio
fun_arity = length args
(bodies, fun_kind, defs, ca) = collectFunctionBodies name fun_arity prio fun_kind defs ca
(fun_defs, c_defs, imports, imported_objects, ca) = reorganiseDefinitions icl_module defs cons_count sel_count mem_count ca
-// MW4 was: fun = MakeNewFunction name fun_arity [{ pb_args = args, pb_rhs = rhs } : bodies] fun_kind prio No pos
- fun = MakeNewFunction name fun_arity [{ pb_args = args, pb_rhs = rhs, pb_position = pos } : bodies] fun_kind prio No pos
+ fun = MakeNewImpOrDefFunction icl_module name fun_arity [{ pb_args = args, pb_rhs = rhs, pb_position = pos } : bodies] fun_kind prio No pos
| fun_kind == FK_Macro
= (fun_defs, { c_defs & def_macros = [ fun : c_defs.def_macros ]}, imports, imported_objects, ca)
= ([ fun : fun_defs ], c_defs, imports, imported_objects, ca)
@@ -885,8 +918,7 @@ reorganiseDefinitions icl_module [PD_TypeSpec fun_pos fun_name prio No specials
# fun_arity = length args
(bodies, fun_kind, defs, ca) = collectFunctionBodies name fun_arity prio fun_kind defs ca
(fun_defs, c_defs, imports, imported_objects, ca) = reorganiseDefinitions icl_module defs cons_count sel_count mem_count ca
-// MW4 was: fun = MakeNewFunction name fun_arity [{ pb_args = args, pb_rhs = rhs } : bodies ] fun_kind prio No pos
- fun = MakeNewFunction name fun_arity [{ pb_args = args, pb_rhs = rhs, pb_position = pos } : bodies ] fun_kind prio No pos
+ fun = MakeNewImpOrDefFunction icl_module name fun_arity [{ pb_args = args, pb_rhs = rhs, pb_position = pos } : bodies ] fun_kind prio No pos
| fun_kind == FK_Macro
-> (fun_defs, { c_defs & def_macros = [ fun : c_defs.def_macros]}, imports, imported_objects, ca)
-> ([ fun : fun_defs ], c_defs, imports, imported_objects, ca)
@@ -902,7 +934,7 @@ reorganiseDefinitions icl_module [PD_TypeSpec pos name prio (Yes fun_type=:{st_a
| icl_module
= (fun_defs, c_defs, imports, imported_objects, postParseError pos "function body expected" ca)
= (fun_defs, c_defs, imports, imported_objects, ca)
- # fun = MakeNewFunction name fun_type.st_arity bodies fun_kind prio (Yes fun_type) pos
+ # fun = MakeNewImpOrDefFunction icl_module name fun_type.st_arity bodies fun_kind prio (Yes fun_type) pos
| icl_module
= ([fun : fun_defs], c_defs, imports, imported_objects, ca)
= ([fun : fun_defs], c_defs, imports, imported_objects, postParseError pos "function body not allowed in definition module" ca)
@@ -969,7 +1001,7 @@ where
me_offset = NoIndex, me_class_vars = [], me_class = { glob_module = NoIndex, glob_object = NoIndex}, me_type_ptr = nilPtr }
( mem_defs, mem_macros, ca) = check_symbols_of_class_members defs type_context ca
= ([mem_def : mem_defs], mem_macros, ca)
- # macro = MakeNewFunction name st_arity bodies FK_Macro prio opt_type pos
+ # macro = MakeNewImpOrDefFunction icl_module name st_arity bodies FK_Macro prio opt_type pos
(mem_defs, mem_macros,ca) = check_symbols_of_class_members defs type_context ca
= (mem_defs, [macro : mem_macros], ca)
check_symbols_of_class_members [PD_TypeSpec fun_pos fun_name prio No specials : defs] type_context ca
@@ -979,7 +1011,7 @@ where
# fun_arity = length args
(bodies, fun_kind, defs, ca) = collectFunctionBodies name fun_arity prio fun_kind defs ca
(mem_defs, mem_macros, ca) = check_symbols_of_class_members defs type_context ca
- macro = MakeNewFunction name fun_arity bodies FK_Macro prio No pos
+ macro = MakeNewImpOrDefFunction icl_module name fun_arity bodies FK_Macro prio No pos
-> (mem_defs, [macro : mem_macros], ca)
-> check_symbols_of_class_members defs type_context (postParseError fun_pos "macro body expected" ca)
_
@@ -989,8 +1021,7 @@ where
fun_arity = length args
(bodies, fun_kind, defs, ca) = collectFunctionBodies name fun_arity prio fun_kind defs ca
(mem_defs, mem_macros, ca) = check_symbols_of_class_members defs type_context ca
-// MW4 was: macro = MakeNewFunction name fun_arity [{ pb_args = args, pb_rhs = rhs } : bodies] FK_Macro prio No fun_pos
- macro = MakeNewFunction name fun_arity [{ pb_args = args, pb_rhs = rhs, pb_position = fun_pos } : bodies] FK_Macro prio No fun_pos
+ macro = MakeNewImpOrDefFunction icl_module name fun_arity [{ pb_args = args, pb_rhs = rhs, pb_position = fun_pos } : bodies] FK_Macro prio No fun_pos
= (mem_defs, [macro : mem_macros], ca)
check_symbols_of_class_members [def : _] type_context ca
= abort "postparse.check_symbols_of_class_members: unknown def" // <<- def
@@ -1024,8 +1055,7 @@ where
prio = if is_infix (Prio NoAssoc 9) NoPrio
(bodies, fun_kind, defs, ca) = collectFunctionBodies name fun_arity prio fun_kind defs ca
(fun_defs, ca) = collect_member_instances defs ca
-// MW4 was: fun = MakeNewFunction name fun_arity [{ pb_args = args, pb_rhs = rhs } : bodies ] fun_kind prio No pos
- fun = MakeNewFunction name fun_arity [{ pb_args = args, pb_rhs = rhs, pb_position = pos } : bodies ] fun_kind prio No pos
+ fun = MakeNewImpOrDefFunction icl_module name fun_arity [{ pb_args = args, pb_rhs = rhs, pb_position = pos } : bodies ] fun_kind prio No pos
= ([ fun : fun_defs ], ca)
collect_member_instances [PD_TypeSpec fun_pos fun_name prio type specials : defs] ca
= case defs of
@@ -1034,7 +1064,7 @@ where
# fun_arity = determineArity args type
(bodies, fun_kind, defs, ca) = collectFunctionBodies name fun_arity prio fun_kind defs ca
(fun_defs, ca) = collect_member_instances defs ca
- fun = MakeNewFunction name fun_arity bodies fun_kind prio type pos
+ fun = MakeNewImpOrDefFunction icl_module name fun_arity bodies fun_kind prio type pos
-> ([ fun : fun_defs ], ca)
_
-> collect_member_instances defs (postParseError fun_pos "function body expected" ca)
@@ -1055,38 +1085,6 @@ reorganiseDefinitions icl_module [] _ _ _ ca
= ([], { def_types = [], def_constructors = [], def_selectors = [], def_macros = [], def_classes = [], def_members = [],
def_instances = [], def_funtypes = [] }, [], [], ca)
-reorganiseLocalDefinitions :: [ParsedDefinition] *CollectAdmin -> ([FunDef],[(Optional SymbolType,NodeDef ParsedExpr)],*CollectAdmin)
-reorganiseLocalDefinitions [PD_NodeDef pos pattern {rhs_alts,rhs_locals} : defs] ca
- # (fun_defs, node_defs, ca) = reorganiseLocalDefinitions defs ca
- = (fun_defs, [(No, { nd_dst = pattern, nd_alts = rhs_alts, nd_locals = rhs_locals, nd_position = pos }) : node_defs], ca)
-reorganiseLocalDefinitions [PD_Function pos name is_infix args rhs fun_kind : defs] ca
- # prio = if is_infix (Prio NoAssoc 9) NoPrio
- fun_arity = length args
- (bodies, fun_kind, defs, ca) = collectFunctionBodies name fun_arity prio fun_kind defs ca
- (fun_defs, node_defs, ca) = reorganiseLocalDefinitions defs ca
-// MW4 was: fun = MakeNewFunction name fun_arity [{ pb_args = args, pb_rhs = rhs } : bodies ] fun_kind prio No pos
- fun = MakeNewFunction name fun_arity [{ pb_args = args, pb_rhs = rhs, pb_position = pos } : bodies ] fun_kind prio No pos
- = ([ fun : fun_defs ], node_defs, ca)
-reorganiseLocalDefinitions [PD_TypeSpec pos1 name1 prio type specials : defs] ca
- = case defs of
- [PD_Function pos name is_infix args rhs fun_kind : _]
- | belongsToTypeSpec name1 prio name is_infix
- # fun_arity = determineArity args type
- # (bodies, fun_kind, defs, ca) = collectFunctionBodies name1 fun_arity prio fun_kind defs ca
- (fun_defs, node_defs, ca) = reorganiseLocalDefinitions defs ca
- fun = MakeNewFunction name fun_arity bodies fun_kind prio type pos
- -> ([fun : fun_defs], node_defs, ca)
- -> reorganiseLocalDefinitions defs (postParseError pos "function body expected" ca)
- [PD_NodeDef pos pattern=:(PE_Ident id) {rhs_alts,rhs_locals} : defs]
- | belongsToTypeSpec name1 prio id False
- # (fun_defs, node_defs, ca) = reorganiseLocalDefinitions defs ca
- -> (fun_defs, [(type, { nd_dst = pattern, nd_alts = rhs_alts, nd_locals = rhs_locals, nd_position = pos }) : node_defs], ca)
- -> reorganiseLocalDefinitions defs (postParseError pos "function body expected" ca)
- _
- -> reorganiseLocalDefinitions defs (postParseError pos1 "function body expected" ca)
-reorganiseLocalDefinitions [] ca
- = ([], [], ca)
-
belongsToTypeSpec name prio new_name is_infix :==
name == new_name && sameFixity prio is_infix
diff --git a/frontend/syntax.dcl b/frontend/syntax.dcl
index 57465ba..3cbb47a 100644
--- a/frontend/syntax.dcl
+++ b/frontend/syntax.dcl
@@ -135,7 +135,10 @@ cIsNotAFunction :== False
| PD_ImportedObjects [ImportedObject]
| PD_Erroneous
-:: FunKind = FK_Function !Bool | FK_Macro | FK_Caf | FK_Unknown
+:: FunKind = FK_Function !Bool | FK_Macro | FK_Caf | FK_Unknown
+
+:: DefOrImpFunKind = FK_DefFunction !Bool| FK_ImpFunction !Bool | FK_DefMacro | FK_ImpMacro | FK_ImpCaf | FK_DefOrImpUnknown
+
cNameNotLocationDependent :== False
cNameLocationDependent :== True
@@ -419,7 +422,7 @@ cIsNonCoercible :== 2
, fun_type :: !Optional SymbolType
, fun_pos :: !Position
, fun_index :: !Int
- , fun_kind :: !FunKind
+ , fun_kind :: !DefOrImpFunKind
, fun_lifted :: !Int
// , fun_type_ptr :: !TypeVarInfoPtr
, fun_info :: !FunInfo
@@ -545,8 +548,6 @@ cNonRecursiveAppl :== False
| SK_GeneratedFunction !FunctionInfoPtr !Index
| SK_TypeCode
-// MW2 moved some type definitions
-
/* Some auxiliary type definitions used during fusion. Actually, these definitions
should have been given in seperate module. Unfortunately, Clean's module system
forbids cyclic dependencies between def modules.
diff --git a/frontend/syntax.icl b/frontend/syntax.icl
index ba2056d..0738d89 100644
--- a/frontend/syntax.icl
+++ b/frontend/syntax.icl
@@ -1,8 +1,6 @@
implementation module syntax
-import StdEnv, compare_constructor
-
-import RWSDebug
+import StdEnv, compare_constructor // ,RWSDebug
import scanner, general, Heap, typeproperties, utilities
@@ -76,7 +74,6 @@ where toString {import_module} = toString import_module
:: ParsedModule :== Module [ParsedDefinition]
:: ScannedModule :== Module (CollectedDefinitions (ParsedInstance FunDef) IndexRange)
-
:: ModuleKind = MK_Main | MK_Module | MK_System | MK_None
:: RhsDefsOfType = ConsList ![ParsedConstructor]
@@ -84,7 +81,6 @@ where toString {import_module} = toString import_module
| TypeSpec !AType
| EmptyRhs !BITVECT
-
:: CollectedDefinitions instance_kind macro_defs =
{ def_types :: ![TypeDef TypeRhs]
, def_constructors :: ![ConsDef]
@@ -140,6 +136,9 @@ cIsNotAFunction :== False
| PD_Erroneous
:: FunKind = FK_Function !Bool | FK_Macro | FK_Caf | FK_Unknown
+
+:: DefOrImpFunKind = FK_DefFunction !Bool| FK_ImpFunction !Bool | FK_DefMacro | FK_ImpMacro | FK_ImpCaf | FK_DefOrImpUnknown
+
cNameNotLocationDependent :== False
cNameLocationDependent :== True
@@ -269,8 +268,6 @@ cNameLocationDependent :== True
| ID_Record !ImportedIdent !(Optional [ImportedIdent])
| ID_Instance !ImportedIdent !Ident !(![Type],![TypeContext])
-// MW2 moved some type definitions
-
cIsImportedLibrary :== True
cIsImportedObject :== False
:: ImportedObject =
@@ -396,7 +393,7 @@ cMayBeNonCoercible :== 4
, fun_type :: !Optional SymbolType
, fun_pos :: !Position
, fun_index :: !Int
- , fun_kind :: !FunKind
+ , fun_kind :: !DefOrImpFunKind
, fun_lifted :: !Int
// , fun_type_ptr :: !TypeVarInfoPtr
, fun_info :: !FunInfo
@@ -1563,17 +1560,17 @@ where
instance <<< FunDef
where
- (<<<) file {fun_symb,fun_index,fun_body=ParsedBody bodies} = file <<< fun_symb <<< '.' <<< fun_index <<< ' ' <<< bodies
- (<<<) file {fun_symb,fun_index,fun_body=CheckedBody {cb_args,cb_rhs},fun_info={fi_free_vars,fi_def_level,fi_calls}} = file <<< fun_symb <<< '.'
- <<< fun_index <<< "C " <<< cb_args <<< " = " <<< cb_rhs
-// <<< fun_index <<< '.' <<< fi_def_level <<< ' ' <<< '[' <<< fi_free_vars <<< ']' <<< cb_args <<< " = " <<< cb_rhs
- (<<<) file {fun_symb,fun_index,fun_body=TransformedBody {tb_args,tb_rhs},fun_info={fi_free_vars,fi_def_level,fi_calls}} = file <<< fun_symb <<< '.'
- <<< fun_index <<< "T " <<< tb_args <<< '[' <<< fi_calls <<< ']' <<< " = " <<< tb_rhs
-// <<< fun_index <<< '.' <<< fi_def_level <<< ' ' <<< '[' <<< fi_free_vars <<< ']' <<< tb_args <<< " = " <<< tb_rhs
- (<<<) file {fun_symb,fun_index,fun_body=BackendBody body,fun_type=Yes type} = file <<< type <<< '\n' <<< fun_symb <<< '.'
- <<< fun_index <<< body <<< '\n'
- (<<<) file {fun_symb,fun_index,fun_body=NoBody,fun_type=Yes type} = file <<< type <<< '\n' <<< fun_symb <<< '.'
- <<< fun_index <<< "Array function\n"
+ (<<<) file {fun_symb,fun_body=ParsedBody bodies} = file <<< fun_symb <<< '.' <<< ' ' <<< bodies
+ (<<<) file {fun_symb,fun_body=CheckedBody {cb_args,cb_rhs},fun_info={fi_free_vars,fi_def_level,fi_calls}} = file <<< fun_symb <<< '.'
+ <<< "C " <<< cb_args <<< " = " <<< cb_rhs
+// <<< '.' <<< fi_def_level <<< ' ' <<< '[' <<< fi_free_vars <<< ']' <<< cb_args <<< " = " <<< cb_rhs
+ (<<<) file {fun_symb,fun_body=TransformedBody {tb_args,tb_rhs},fun_info={fi_free_vars,fi_def_level,fi_calls}} = file <<< fun_symb <<< '.'
+ <<< "T " <<< tb_args <<< '[' <<< fi_calls <<< ']' <<< " = " <<< tb_rhs
+// <<< '.' <<< fi_def_level <<< ' ' <<< '[' <<< fi_free_vars <<< ']' <<< tb_args <<< " = " <<< tb_rhs
+ (<<<) file {fun_symb,fun_body=BackendBody body,fun_type=Yes type} = file <<< type <<< '\n' <<< fun_symb <<< '.'
+ <<< body <<< '\n'
+ (<<<) file {fun_symb,fun_body=NoBody,fun_type=Yes type} = file <<< type <<< '\n' <<< fun_symb <<< '.'
+ <<< "Array function\n"
instance <<< FunCall
where
diff --git a/frontend/trans.icl b/frontend/trans.icl
index a4460cb..68c7a9f 100644
--- a/frontend/trans.icl
+++ b/frontend/trans.icl
@@ -2,9 +2,7 @@ implementation module trans
import StdEnv
-import syntax, transform, checksupport, StdCompare, check, utilities
-
-import RWSDebug
+import syntax, transform, checksupport, StdCompare, check, utilities //,RWSDebug
:: PartitioningInfo =
{ pi_marks :: !.{# Int}
@@ -693,7 +691,7 @@ instance transform DynamicExpr where
= ({dyn & dyn_expr = dyn_expr}, ti)
unfold_state_to_ti us ti
- :== { ti & ti_var_heap = us.us_var_heap, ti_symbol_heap = us.us_symbol_heap, ti_cleanup_info=us.us_cleanup_info }
+ :== { ti & ti_var_heap = us.us_var_heap, ti_symbol_heap = us.us_symbol_heap,ti_cleanup_info=us.us_cleanup_info }
transformCase this_case=:{case_expr,case_guards,case_default,case_ident,case_info_ptr} ro ti
| SwitchFusion False True
@@ -851,9 +849,9 @@ transformCase this_case=:{case_expr,case_guards,case_default,case_ident,case_inf
# (guard_expr, ti) = transformCase {outer_case & case_expr = guard_expr} ro ti
= ([guard_expr], ti)
lift_patterns_2 default_exists [guard_expr : guard_exprs] outer_case ro ti
- # us = { us_var_heap = ti.ti_var_heap, us_symbol_heap = ti.ti_symbol_heap, us_opt_type_heaps = No,
- us_cleanup_info=ti.ti_cleanup_info, us_handle_aci_free_vars = LeaveThem }
- (outer_guards, us=:{us_cleanup_info}) = unfold outer_case.case_guards us
+ # us = { us_var_heap = ti.ti_var_heap, us_symbol_heap = ti.ti_symbol_heap, us_opt_type_heaps = No,us_cleanup_info=ti.ti_cleanup_info}
+ ui = {ui_handle_aci_free_vars = LeaveThem, ui_convert_module_n= -1,ui_conversion_table=No }
+ (outer_guards, us=:{us_cleanup_info}) = unfold outer_case.case_guards ui us
(expr_info, ti_symbol_heap) = readPtr outer_case.case_info_ptr us.us_symbol_heap
(new_info_ptr, ti_symbol_heap) = newPtr expr_info ti_symbol_heap
new_cleanup_info = case expr_info of
@@ -884,9 +882,9 @@ transformCase this_case=:{case_expr,case_guards,case_default,case_ident,case_inf
non_unfoldable_args = filterWith not_unfoldable zipped
ti_var_heap = foldSt (\({fv_info_ptr}, arg) -> writeVarInfo fv_info_ptr (VI_Expression arg)) unfoldable_args ti.ti_var_heap
(new_expr, ti_symbol_heap) = possibly_add_let non_unfoldable_args ap_expr not_unfoldable glob_module ds_index ro ti.ti_symbol_heap
- unfold_state = { us_var_heap = ti_var_heap, us_symbol_heap = ti_symbol_heap, us_opt_type_heaps = No,
- us_cleanup_info=ti.ti_cleanup_info, us_handle_aci_free_vars = LeaveThem }
- (unfolded_expr, unfold_state) = unfold new_expr unfold_state
+ unfold_state = { us_var_heap = ti_var_heap, us_symbol_heap = ti_symbol_heap, us_opt_type_heaps = No,us_cleanup_info=ti.ti_cleanup_info}
+ ui= {ui_handle_aci_free_vars = LeaveThem, ui_convert_module_n= -1,ui_conversion_table=No }
+ (unfolded_expr, unfold_state) = unfold new_expr ui unfold_state
(final_expr, ti) = transform unfolded_expr { ro & ro_root_case_mode = NotRootCase } (unfold_state_to_ti unfold_state ti)
= (Yes final_expr, ti)
= match_and_instantiate linearities cons_index app_args guards case_default ro ti
@@ -1002,9 +1000,11 @@ possibly_generate_case_function kees=:{case_info_ptr} aci=:{aci_free_vars} ro ti
(fresh_arg_types, ti_type_heaps) = substitute arg_types { th_vars = th_vars, th_attrs = th_attrs }
(fresh_result_type, ti_type_heaps) = substitute ct_result_type ti_type_heaps
us = { us_var_heap = ti_var_heap, us_symbol_heap = ti_symbol_heap, us_opt_type_heaps = Yes ti_type_heaps,
- us_cleanup_info=ti.ti_cleanup_info, us_handle_aci_free_vars = SubstituteThem }
+ us_cleanup_info=ti.ti_cleanup_info }
+ ui = {ui_handle_aci_free_vars = SubstituteThem, ui_convert_module_n= -1,ui_conversion_table=No }
(copied_expr, {us_var_heap=ti_var_heap, us_symbol_heap=ti_symbol_heap, us_cleanup_info=ti_cleanup_info,
- us_opt_type_heaps = Yes ti_type_heaps}) = unfold new_expr us
+ us_opt_type_heaps = Yes ti_type_heaps})
+ = unfold new_expr ui us
fun_type = { st_vars = fresh_type_vars, st_args = fresh_arg_types, st_arity = fun_arity, st_result = fresh_result_type,
st_context = [], st_attr_vars = [], st_attr_env = [] }
fun_def = { fun_symb = ro_fun.symb_name
@@ -1014,7 +1014,7 @@ possibly_generate_case_function kees=:{case_info_ptr} aci=:{aci_free_vars} ro ti
, fun_type = Yes fun_type
, fun_pos = NoPos
, fun_index = fun_index
- , fun_kind = FK_Function cNameNotLocationDependent
+ , fun_kind = FK_ImpFunction cNameNotLocationDependent
, fun_lifted = undeff
, fun_info = { fi_calls = []
, fi_group_index = outer_fun_def.fun_info.fi_group_index
@@ -1032,8 +1032,8 @@ possibly_generate_case_function kees=:{case_info_ptr} aci=:{aci_free_vars} ro ti
gf = { gf_fun_def = fun_def, gf_instance_info = II_Empty, gf_cons_args = new_cons_args, gf_fun_index = fun_index}
ti_fun_heap = writePtr fun_info_ptr (FI_Function gf) ti.ti_fun_heap
ti = { ti & ti_new_functions = [fun_info_ptr:ti.ti_new_functions], ti_var_heap = ti_var_heap, ti_fun_heap = ti_fun_heap,
- ti_symbol_heap = ti_symbol_heap, ti_type_heaps = ti_type_heaps, ti_cleanup_info = ti_cleanup_info,
- ti_recursion_introduced = old_ti_recursion_introduced }
+ ti_symbol_heap = ti_symbol_heap, ti_type_heaps = ti_type_heaps,
+ ti_cleanup_info = ti_cleanup_info, ti_recursion_introduced = old_ti_recursion_introduced }
= ( App { app_symb = { ro_fun & symb_kind = SK_GeneratedFunction fun_info_ptr fun_index},
app_args = map free_var_to_bound_var ro_fun_args, app_info_ptr = nilPtr }
, ti
@@ -1247,14 +1247,15 @@ generateFunction fd=:{fun_body = TransformedBody {tb_args,tb_rhs},fun_info = {fi
new_fun_type = Yes { st_vars = fresh_type_vars, st_args = fresh_arg_types, st_arity = fun_arity,
st_result = fresh_result_type, st_context = [], st_attr_vars = [], st_attr_env = [] }
- new_fd_expanding = { fd & fun_body = Expanding new_fun_args, fun_arity = fun_arity,fun_type=new_fun_type, fun_index = ti_next_fun_nr,
+ new_fd_expanding = { fd & fun_body = Expanding new_fun_args, fun_arity = fun_arity,fun_type=new_fun_type, fun_index=ti_next_fun_nr,
fun_info.fi_group_index = fi_group_index}
new_gen_fd = { gf_fun_def = new_fd_expanding, gf_instance_info = II_Empty, gf_fun_index = ti_next_fun_nr,
gf_cons_args = {cc_args = new_cons_args, cc_size = length new_cons_args, cc_linear_bits=new_linear_bits} }
ti_fun_heap = writePtr fun_def_ptr (FI_Function new_gen_fd) ti_fun_heap
us = { us_var_heap = ti_var_heap, us_symbol_heap = ti_symbol_heap, us_opt_type_heaps = Yes ti_type_heaps,
- us_cleanup_info=ti_cleanup_info, us_handle_aci_free_vars = RemoveThem }
- (tb_rhs, {us_var_heap,us_symbol_heap,us_opt_type_heaps=Yes type_heaps, us_cleanup_info}) = unfold tb_rhs us
+ us_cleanup_info=ti_cleanup_info }
+ ui = {ui_handle_aci_free_vars = RemoveThem, ui_convert_module_n= -1,ui_conversion_table=No }
+ (tb_rhs, {us_var_heap,us_symbol_heap,us_opt_type_heaps=Yes type_heaps, us_cleanup_info}) = unfold tb_rhs ui us
ro = { ro & ro_root_case_mode = case tb_rhs of
Case _
-> RootCase
@@ -1267,7 +1268,7 @@ generateFunction fd=:{fun_body = TransformedBody {tb_args,tb_rhs},fun_info = {fi
= undef
# (new_fun_rhs, ti) = transform tb_rhs ro { ti & ti_var_heap = us_var_heap, ti_fun_heap = ti_fun_heap, ti_symbol_heap = us_symbol_heap,
ti_next_fun_nr = inc ti_next_fun_nr, ti_new_functions = [fun_def_ptr : ti_new_functions],
- ti_fun_defs = ti_fun_defs, ti_type_heaps = type_heaps, ti_cleanup_info = us_cleanup_info, ti_trace=ti_trace }
+ ti_type_heaps = type_heaps, ti_fun_defs=ti_fun_defs,ti_cleanup_info = us_cleanup_info, ti_trace=ti_trace }
new_fd = { new_fd_expanding & fun_body = TransformedBody {tb_args = new_fun_args, tb_rhs = new_fun_rhs} }
// | (False--->("generated function", new_fd, '\n', new_fd.fun_type))
// = undef
diff --git a/frontend/transform.dcl b/frontend/transform.dcl
index 299e5f2..1d290a3 100644
--- a/frontend/transform.dcl
+++ b/frontend/transform.dcl
@@ -15,13 +15,18 @@ partitionateMacros :: !IndexRange !Index !PredefinedSymbol !*{# FunDef} !*{# Dcl
:: UnfoldState =
{ us_var_heap :: !.VarHeap
, us_symbol_heap :: !.ExpressionHeap
- , us_opt_type_heaps :: !.Optional .TypeHeaps
- , us_cleanup_info :: ![ExprInfoPtr]
- , us_handle_aci_free_vars :: !AciFreeVarHandleMode
+ , us_opt_type_heaps :: !.Optional .TypeHeaps,
+ us_cleanup_info :: ![ExprInfoPtr]
}
-
+
+:: UnfoldInfo =
+ { ui_handle_aci_free_vars :: !AciFreeVarHandleMode,
+ ui_convert_module_n :: !Int, // -1 if no conversion
+ ui_conversion_table :: !Optional ConversionTable
+ }
+
:: AciFreeVarHandleMode = LeaveThem | RemoveThem | SubstituteThem
-class unfold a :: !a !*UnfoldState -> (!a, !*UnfoldState)
+class unfold a :: !a !UnfoldInfo !*UnfoldState -> (!a, !*UnfoldState)
instance unfold Expression, CasePatterns
diff --git a/frontend/transform.icl b/frontend/transform.icl
index 56a2d13..3d216b1 100644
--- a/frontend/transform.icl
+++ b/frontend/transform.icl
@@ -1,10 +1,9 @@
implementation module transform
-import syntax, check, StdCompare, utilities, RWSDebug
+import syntax, check, StdCompare, utilities; //, RWSDebug
:: LiftState =
{ ls_var_heap :: !.VarHeap
-// , ls_fun_defs :: !.{#FunDef}
, ls_x :: !.LiftStateX
, ls_expr_heap :: !.ExpressionHeap
}
@@ -209,30 +208,19 @@ where
:: UnfoldState =
{ us_var_heap :: !.VarHeap
, us_symbol_heap :: !.ExpressionHeap
- , us_opt_type_heaps :: !.Optional .TypeHeaps
- , us_cleanup_info :: ![ExprInfoPtr]
- , us_handle_aci_free_vars :: !AciFreeVarHandleMode
+ , us_opt_type_heaps :: !.Optional .TypeHeaps,
+ us_cleanup_info :: ![ExprInfoPtr]
}
-
-:: AciFreeVarHandleMode = LeaveThem | RemoveThem | SubstituteThem
-
-class unfold a :: !a !*UnfoldState -> (!a, !*UnfoldState)
-instance unfold [a] | unfold a
-where
- unfold l us = mapSt unfold l us
+:: UnfoldInfo =
+ { ui_handle_aci_free_vars :: !AciFreeVarHandleMode,
+ ui_convert_module_n :: !Int, // -1 if no conversion
+ ui_conversion_table :: !Optional ConversionTable
+ }
-instance unfold (a,b) | unfold a & unfold b
-where
- unfold t us = app2St (unfold,unfold) t us
+:: AciFreeVarHandleMode = LeaveThem | RemoveThem | SubstituteThem
-instance unfold (Optional a) | unfold a
-where
- unfold (Yes x) us
- # (x, us) = unfold x us
- = (Yes x, us)
- unfold no us
- = (no, us)
+class unfold a :: !a !UnfoldInfo !*UnfoldState -> (!a, !*UnfoldState)
unfoldVariable :: !BoundVar !*UnfoldState -> (!Expression, !*UnfoldState)
unfoldVariable var=:{var_name,var_info_ptr} us
@@ -277,60 +265,59 @@ writeVarInfo var_info_ptr new_var_info var_heap
instance unfold Expression
where
- unfold (Var var) us
+ unfold (Var var) ui us
= unfoldVariable var us
- unfold (App app) us
- # (app, us) = unfold app us
+ unfold (App app) ui us
+ # (app, us) = unfold app ui us
= (App app, us)
- unfold (expr @ exprs) us
- # ((expr,exprs), us) = unfold (expr,exprs) us
+ unfold (expr @ exprs) ui us
+ # ((expr,exprs), us) = unfold (expr,exprs) ui us
= (expr @ exprs, us)
- unfold (Let lad) us
- # (lad, us) = unfold lad us
+ unfold (Let lad) ui us
+ # (lad, us) = unfold lad ui us
= (Let lad, us)
- unfold (Case case_expr) us
- # (case_expr, us) = unfold case_expr us
+ unfold (Case case_expr) ui us
+ # (case_expr, us) = unfold case_expr ui us
= (Case case_expr, us)
- unfold (Selection is_unique expr selectors) us
- # ((expr, selectors), us) = unfold (expr, selectors) us
+ unfold (Selection is_unique expr selectors) ui us
+ # ((expr, selectors), us) = unfold (expr, selectors) ui us
= (Selection is_unique expr selectors, us)
- unfold (Update expr1 selectors expr2) us
- # (((expr1, expr2), selectors), us) = unfold ((expr1, expr2), selectors) us
+ unfold (Update expr1 selectors expr2) ui us
+ # (((expr1, expr2), selectors), us) = unfold ((expr1, expr2), selectors) ui us
= (Update expr1 selectors expr2, us)
- unfold (RecordUpdate cons_symbol expression expressions) us
- # ((expression, expressions), us) = unfold (expression, expressions) us
+ unfold (RecordUpdate cons_symbol expression expressions) ui us
+ # ((expression, expressions), us) = unfold (expression, expressions) ui us
= (RecordUpdate cons_symbol expression expressions, us)
- unfold (TupleSelect symbol argn_nr expr) us
- # (expr, us) = unfold expr us
+ unfold (TupleSelect symbol argn_nr expr) ui us
+ # (expr, us) = unfold expr ui us
= (TupleSelect symbol argn_nr expr, us)
- unfold (Lambda vars expr) us
- # (expr, us) = unfold expr us
+ unfold (Lambda vars expr) ui us
+ # (expr, us) = unfold expr ui us
= (Lambda vars expr, us)
- unfold (MatchExpr opt_tuple cons_symb expr) us
- # (expr, us) = unfold expr us
+ unfold (MatchExpr opt_tuple cons_symb expr) ui us
+ # (expr, us) = unfold expr ui us
= (MatchExpr opt_tuple cons_symb expr, us)
- unfold (DynamicExpr expr) us
- # (expr, us) = unfold expr us
+ unfold (DynamicExpr expr) ui us
+ # (expr, us) = unfold expr ui us
= (DynamicExpr expr, us)
- unfold expr us
+ unfold expr ui us
= (expr, us)
instance unfold DynamicExpr
where
- unfold expr=:{dyn_expr} us
- # (dyn_expr, us) = unfold dyn_expr us
+ unfold expr=:{dyn_expr} ui us
+ # (dyn_expr, us) = unfold dyn_expr ui us
= ({ expr & dyn_expr = dyn_expr }, us)
-/* Sjaak ... */
instance unfold Selection
where
- unfold (ArraySelection array_select expr_ptr index_expr) us=:{us_symbol_heap}
+ unfold (ArraySelection array_select expr_ptr index_expr) ui us=:{us_symbol_heap}
# (new_ptr, us_symbol_heap) = newPtr EI_Empty us_symbol_heap
- (index_expr, us) = unfold index_expr { us & us_symbol_heap = us_symbol_heap}
+ (index_expr, us) = unfold index_expr ui { us & us_symbol_heap = us_symbol_heap}
= (ArraySelection array_select new_ptr index_expr, us)
- unfold (DictionarySelection var selectors expr_ptr index_expr) us=:{us_symbol_heap}
+ unfold (DictionarySelection var selectors expr_ptr index_expr) ui us=:{us_symbol_heap}
# (new_ptr, us_symbol_heap) = newPtr EI_Empty us_symbol_heap
- (index_expr, us) = unfold index_expr { us & us_symbol_heap = us_symbol_heap}
+ (index_expr, us) = unfold index_expr ui { us & us_symbol_heap = us_symbol_heap}
(var_expr, us) = unfoldVariable var us
= case var_expr of
App {app_symb={symb_kind= SK_Constructor _ }, app_args}
@@ -340,43 +327,58 @@ where
new_ptr index_expr, us)
Var var
-> (DictionarySelection var selectors new_ptr index_expr, us)
- unfold record_selection ls
- = (record_selection, ls)
-/* ... Sjaak */
+ unfold record_selection ui us
+ = (record_selection, us)
instance unfold FreeVar
where
- unfold fv=:{fv_info_ptr,fv_name} us=:{us_var_heap}
+ unfold fv=:{fv_info_ptr,fv_name} ui us=:{us_var_heap}
# (new_info_ptr, us_var_heap) = newPtr VI_Empty us_var_heap
= ({ fv & fv_info_ptr = new_info_ptr }, { us & us_var_heap = writePtr fv_info_ptr (VI_Variable fv_name new_info_ptr) us_var_heap })
instance unfold App
where
- unfold app=:{app_symb, app_args, app_info_ptr} us
- # (new_info_ptr, us)
- = case is_function_or_macro app_symb.symb_kind of
- True # (new_ptr, us_symbol_heap) = newPtr EI_Empty us.us_symbol_heap
- -> (new_ptr, { us & us_symbol_heap = us_symbol_heap })
- _ -> case (app_symb.symb_kind, isNilPtr app_info_ptr) of
- (SK_Constructor _, False)
- # (app_info, us_symbol_heap) = readPtr app_info_ptr us.us_symbol_heap
- (new_app_info, us_opt_type_heaps) = substitute_EI_DictionaryType app_info us.us_opt_type_heaps
- (new_ptr, us_symbol_heap) = newPtr new_app_info us_symbol_heap
- -> (new_ptr, { us & us_symbol_heap = us_symbol_heap, us_opt_type_heaps = us_opt_type_heaps })
- _ -> (nilPtr, us)
- (app_args, us) = unfold app_args us
- = ({ app & app_args = app_args, app_info_ptr = new_info_ptr}, us)
+ unfold app=:{app_symb={symb_kind}, app_args, app_info_ptr} ui=:{ui_convert_module_n,ui_conversion_table} us
+ = case symb_kind of
+ SK_Function {glob_module,glob_object}
+ | ui_convert_module_n==glob_module
+ # (Yes conversion_table) = ui_conversion_table
+ # app={app & app_symb.symb_kind=SK_Function {glob_module=glob_module,glob_object=conversion_table.[cFunctionDefs].[glob_object]}}
+ -> unfold_function_app app ui us
+ -> unfold_function_app app ui us
+ SK_Macro {glob_module,glob_object}
+ | ui_convert_module_n==glob_module
+ # (Yes conversion_table) = ui_conversion_table
+ # app={app & app_symb.symb_kind=SK_Macro {glob_module=glob_module,glob_object=conversion_table.[cMacroDefs].[glob_object]}}
+ -> unfold_function_app app ui us
+ -> unfold_function_app app ui us
+ SK_OverloadedFunction {glob_module,glob_object}
+ | ui_convert_module_n==glob_module
+ # (Yes conversion_table) = ui_conversion_table
+ # app={app & app_symb.symb_kind=SK_OverloadedFunction {glob_module=glob_module,glob_object=conversion_table.[cFunctionDefs].[glob_object]}}
+ -> unfold_function_app app ui us
+ -> unfold_function_app app ui us
+ SK_LocalMacroFunction _
+ -> unfold_function_app app ui us
+ SK_Constructor _
+ | not (isNilPtr app_info_ptr)
+ # (app_info, us_symbol_heap) = readPtr app_info_ptr us.us_symbol_heap
+ (new_app_info, us_opt_type_heaps) = substitute_EI_DictionaryType app_info us.us_opt_type_heaps
+ (new_info_ptr, us_symbol_heap) = newPtr new_app_info us_symbol_heap
+ us={ us & us_symbol_heap = us_symbol_heap, us_opt_type_heaps = us_opt_type_heaps }
+ (app_args, us) = unfold app_args ui us
+ -> ({ app & app_args = app_args, app_info_ptr = new_info_ptr}, us)
+ # (app_args, us) = unfold app_args ui us
+ -> ({ app & app_args = app_args}, us)
+ _
+ # (app_args, us) = unfold app_args ui us
+ -> ({ app & app_args = app_args, app_info_ptr = nilPtr}, us)
where
- is_function_or_macro (SK_Function _)
- = True
- is_function_or_macro (SK_LocalMacroFunction _)
- = True
- is_function_or_macro (SK_Macro _)
- = True
- is_function_or_macro (SK_OverloadedFunction _)
- = True
- is_function_or_macro _
- = False
+ unfold_function_app app=:{app_args, app_info_ptr} ui us
+ # (new_info_ptr, us_symbol_heap) = newPtr EI_Empty us.us_symbol_heap
+ # us={ us & us_symbol_heap = us_symbol_heap }
+ # (app_args, us) = unfold app_args ui us
+ = ({ app & app_args = app_args, app_info_ptr = new_info_ptr}, us)
substitute_EI_DictionaryType (EI_DictionaryType class_type) (Yes type_heaps)
# (new_class_type, type_heaps) = substitute class_type type_heaps
@@ -386,19 +388,19 @@ where
instance unfold LetBind
where
- unfold bind=:{lb_src} us
- # (lb_src, us) = unfold lb_src us
+ unfold bind=:{lb_src} ui us
+ # (lb_src, us) = unfold lb_src ui us
= ({ bind & lb_src = lb_src }, us)
instance unfold (Bind a b) | unfold a
where
- unfold bind=:{bind_src} us
- # (bind_src, us) = unfold bind_src us
+ unfold bind=:{bind_src} ui us
+ # (bind_src, us) = unfold bind_src ui us
= ({ bind & bind_src = bind_src }, us)
instance unfold Case
where
- unfold kees=:{ case_expr,case_guards,case_default,case_info_ptr} us=:{us_cleanup_info}
+ unfold kees=:{ case_expr,case_guards,case_default,case_info_ptr} ui us=:{us_cleanup_info}
# (old_case_info, us_symbol_heap) = readPtr case_info_ptr us.us_symbol_heap
(new_case_info, us_opt_type_heaps) = substitute_let_or_case_type old_case_info us.us_opt_type_heaps
(new_info_ptr, us_symbol_heap) = newPtr new_case_info us_symbol_heap
@@ -406,16 +408,16 @@ where
EI_Extended _ _ -> [new_info_ptr:us_cleanup_info]
_ -> us_cleanup_info
us = { us & us_symbol_heap = us_symbol_heap, us_opt_type_heaps = us_opt_type_heaps, us_cleanup_info=us_cleanup_info }
- ((case_guards,case_default), us) = unfold (case_guards,case_default) us
+ ((case_guards,case_default), us) = unfold (case_guards,case_default) ui us
(case_expr, us) = update_active_case_info_and_unfold case_expr new_info_ptr us
= ({ kees & case_expr = case_expr,case_guards = case_guards, case_default = case_default, case_info_ptr = new_info_ptr}, us)
where
- update_active_case_info_and_unfold case_expr=:(Var {var_info_ptr}) case_info_ptr us=:{us_handle_aci_free_vars}
+ update_active_case_info_and_unfold case_expr=:(Var {var_info_ptr}) case_info_ptr us
# (case_info, us_symbol_heap) = readPtr case_info_ptr us.us_symbol_heap
us = { us & us_symbol_heap = us_symbol_heap }
= case case_info of
EI_Extended (EEI_ActiveCase aci=:{aci_free_vars}) ei
- #!(new_aci_free_vars, us) = case us_handle_aci_free_vars of
+ #!(new_aci_free_vars, us) = case ui.ui_handle_aci_free_vars of
LeaveThem -> (aci_free_vars, us)
RemoveThem -> (No, us)
SubstituteThem -> case aci_free_vars of
@@ -429,7 +431,7 @@ where
# tb_args_ptrs = [ fv_info_ptr \\ {fv_info_ptr}<-tb_args ]
(original_bindings, us_var_heap) = mapSt readPtr tb_args_ptrs us.us_var_heap
us_var_heap = fold2St bind tb_args_ptrs new_aci_params us_var_heap
- (tb_rhs, us) = unfold tb_rhs { us & us_var_heap = us_var_heap }
+ (tb_rhs, us) = unfold tb_rhs ui { us & us_var_heap = us_var_heap }
us_var_heap = fold2St writePtr tb_args_ptrs original_bindings us.us_var_heap
new_aci = { aci & aci_params = new_aci_params, aci_opt_unfolder = Yes fun_symb, aci_free_vars = new_aci_free_vars }
new_eei = (EI_Extended (EEI_ActiveCase new_aci) ei)
@@ -437,8 +439,8 @@ where
-> (tb_rhs, { us & us_var_heap = us_var_heap, us_symbol_heap = us_symbol_heap })
_ # new_eei = EI_Extended (EEI_ActiveCase { aci & aci_free_vars = new_aci_free_vars }) ei
us_symbol_heap = writePtr case_info_ptr new_eei us.us_symbol_heap
- -> unfold case_expr { us & us_symbol_heap = us_symbol_heap }
- _ -> unfold case_expr us
+ -> unfold case_expr ui { us & us_symbol_heap = us_symbol_heap }
+ _ -> unfold case_expr ui us
where
// XXX consider to store BoundVars in VI_Body
bind fv_info_ptr {fv_name=name, fv_info_ptr=info_ptr} var_heap
@@ -460,21 +462,20 @@ where
_ -> unfold case_expr us
*/
update_active_case_info_and_unfold case_expr _ us
- = unfold case_expr us
+ = unfold case_expr ui us
unfoldBoundVar {var_info_ptr} us
# (VI_Expression (Var act_var), us_var_heap) = readPtr var_info_ptr us.us_var_heap
= (act_var, { us & us_var_heap = us_var_heap })
-
instance unfold Let
where
- unfold lad=:{let_strict_binds, let_lazy_binds, let_expr, let_info_ptr} us
+ unfold lad=:{let_strict_binds, let_lazy_binds, let_expr, let_info_ptr} ui us
# (let_strict_binds, us) = copy_bound_vars let_strict_binds us
# (let_lazy_binds, us) = copy_bound_vars let_lazy_binds us
- # (let_strict_binds, us) = unfold let_strict_binds us
- # (let_lazy_binds, us) = unfold let_lazy_binds us
- # (let_expr, us) = unfold let_expr us
+ # (let_strict_binds, us) = unfold let_strict_binds ui us
+ # (let_lazy_binds, us) = unfold let_lazy_binds ui us
+ # (let_expr, us) = unfold let_expr ui us
(old_let_info, us_symbol_heap) = readPtr let_info_ptr us.us_symbol_heap
(new_let_info, us_opt_type_heaps) = substitute_let_or_case_type old_let_info us.us_opt_type_heaps
(new_info_ptr, us_symbol_heap) = newPtr new_let_info us_symbol_heap
@@ -482,7 +483,7 @@ where
{ us & us_symbol_heap = us_symbol_heap, us_opt_type_heaps = us_opt_type_heaps })
where
copy_bound_vars [bind=:{lb_dst} : binds] us
- # (lb_dst, us) = unfold lb_dst us
+ # (lb_dst, us) = unfold lb_dst ui us
(binds, us) = copy_bound_vars binds us
= ([ {bind & lb_dst = lb_dst} : binds ], us)
copy_bound_vars [] us
@@ -503,36 +504,66 @@ substitute_let_or_case_type (EI_LetType let_type) (Yes type_heaps)
instance unfold CasePatterns
where
- unfold (AlgebraicPatterns type patterns) us
- # (patterns, us) = unfold patterns us
+ unfold (AlgebraicPatterns type patterns) ui us
+ # (patterns, us) = unfold patterns ui us
= (AlgebraicPatterns type patterns, us)
- unfold (BasicPatterns type patterns) us
- # (patterns, us) = unfold patterns us
+ unfold (BasicPatterns type patterns) ui us
+ # (patterns, us) = unfold patterns ui us
= (BasicPatterns type patterns, us)
- unfold (DynamicPatterns patterns) us
- # (patterns, us) = unfold patterns us
+ unfold (DynamicPatterns patterns) ui us
+ # (patterns, us) = unfold patterns ui us
= (DynamicPatterns patterns, us)
instance unfold BasicPattern
where
- unfold guard=:{bp_expr} us
- # (bp_expr, us) = unfold bp_expr us
+ unfold guard=:{bp_expr} ui us
+ # (bp_expr, us) = unfold bp_expr ui us
= ({ guard & bp_expr = bp_expr }, us)
instance unfold AlgebraicPattern
where
- unfold guard=:{ap_vars,ap_expr} us
- # (ap_vars, us) = unfold ap_vars us
- (ap_expr, us) = unfold ap_expr us
+ unfold guard=:{ap_vars,ap_expr} ui us
+ # (ap_vars, us) = unfold ap_vars ui us
+ (ap_expr, us) = unfold ap_expr ui us
= ({ guard & ap_vars = ap_vars, ap_expr = ap_expr }, us)
instance unfold DynamicPattern
where
- unfold guard=:{dp_var,dp_rhs} us
- # (dp_var, us) = unfold dp_var us
- (dp_rhs, us) = unfold dp_rhs us
+ unfold guard=:{dp_var,dp_rhs} ui us
+ # (dp_var, us) = unfold dp_var ui us
+ (dp_rhs, us) = unfold dp_rhs ui us
= ({ guard & dp_var = dp_var, dp_rhs = dp_rhs }, us)
+instance unfold [a] | unfold a
+where
+ unfold l ui us
+ // = mapSt unfold l ui us
+ = map_st l us
+ where
+ map_st [x : xs] s
+ # (x, s) = unfold x ui s
+ (xs, s) = map_st xs s
+ #! s = s
+ = ([x : xs], s)
+ map_st [] s
+ = ([], s)
+
+instance unfold (a,b) | unfold a & unfold b
+where
+// unfold t ui us = app2St (unfold,unfold) t ui us
+ unfold (a,b) ui us
+ # (a,us) = unfold a ui us
+ # (b,us) = unfold b ui us
+ = ((a,b),us)
+
+instance unfold (Optional a) | unfold a
+where
+ unfold (Yes x) ui us
+ # (x, us) = unfold x ui us
+ = (Yes x, us)
+ unfold no ui us
+ = (no, us)
+
updateFunctionCalls :: ![FunCall] ![FunCall] !*{# FunDef} !*SymbolTable
-> (![FunCall], !*{# FunDef}, !*SymbolTable)
updateFunctionCalls calls collected_calls fun_defs symbol_table
@@ -555,17 +586,28 @@ examineFunctionCall {id_info} fc=:{fc_index} (calls, symbol_table)
(id_info, { ste_kind = STE_Called [fc_index], ste_index = NoIndex, ste_def_level = NotALevel, ste_previous = entry }))
unfoldMacro :: !FunDef ![Expression] !*ExpandInfo -> (!Expression, !*ExpandInfo)
-unfoldMacro {fun_body = TransformedBody {tb_args,tb_rhs}, fun_info = {fi_calls}} args (calls, es=:{es_var_heap,es_symbol_heap, es_symbol_table,es_fun_defs})
+unfoldMacro {fun_body = TransformedBody {tb_args,tb_rhs}, fun_info = {fi_calls},fun_kind,fun_symb} args (calls, es=:{es_var_heap,es_symbol_heap, es_symbol_table,es_fun_defs,es_expand_in_imp_module, es_main_dcl_module_n,es_dcl_modules})
# (let_binds, var_heap) = bind_expressions tb_args args [] es_var_heap
- us = { us_symbol_heap = es_symbol_heap, us_var_heap = var_heap, us_opt_type_heaps = No, us_cleanup_info = [],
- us_handle_aci_free_vars = RemoveThem }
- (result_expr, {us_symbol_heap,us_var_heap}) = unfold tb_rhs us
- (calls, fun_defs, es_symbol_table) = updateFunctionCalls fi_calls calls es_fun_defs es_symbol_table
+ # us = { us_symbol_heap = es_symbol_heap, us_var_heap = var_heap, us_opt_type_heaps = No,us_cleanup_info = []}
+ # (result_expr,dcl_modules,us_symbol_heap,us_var_heap) = unfold_and_convert tb_rhs es_dcl_modules us
+ with
+ unfold_and_convert tb_rhs dcl_modules us
+ # is_def_macro=case fun_kind of FK_DefMacro->True; _->False
+ | es_expand_in_imp_module && is_def_macro
+ # (dcl_mod,dcl_modules) = dcl_modules![es_main_dcl_module_n]
+ # ui = {ui_handle_aci_free_vars = RemoveThem, ui_convert_module_n = es_main_dcl_module_n, ui_conversion_table=dcl_mod.dcl_conversions }
+ # (result_expr,{us_symbol_heap,us_var_heap})= unfold tb_rhs ui us
+ = (result_expr,dcl_modules,us_symbol_heap,us_var_heap)
+
+ # ui = {ui_handle_aci_free_vars = RemoveThem, ui_convert_module_n = -1 ,ui_conversion_table=No }
+ # (result_expr,{us_symbol_heap,us_var_heap})= unfold tb_rhs ui us
+ = (result_expr,dcl_modules,us_symbol_heap,us_var_heap)
+ # (calls, fun_defs, es_symbol_table) = updateFunctionCalls fi_calls calls es_fun_defs es_symbol_table
| isEmpty let_binds
- = (result_expr, (calls, { es & es_var_heap = us_var_heap, es_symbol_heap = us_symbol_heap, es_symbol_table = es_symbol_table, es_fun_defs=fun_defs }))
+ = (result_expr, (calls, { es & es_var_heap = us_var_heap, es_symbol_heap = us_symbol_heap, es_symbol_table = es_symbol_table, es_fun_defs=fun_defs,es_dcl_modules=dcl_modules }))
# (new_info_ptr, us_symbol_heap) = newPtr EI_Empty us_symbol_heap
= (Let { let_strict_binds = [], let_lazy_binds = let_binds, let_expr = result_expr, let_info_ptr = new_info_ptr, let_expr_position = NoPos },
- (calls, { es & es_var_heap = us_var_heap, es_symbol_heap = us_symbol_heap, es_symbol_table = es_symbol_table,es_fun_defs=fun_defs }))
+ (calls, { es & es_var_heap = us_var_heap, es_symbol_heap = us_symbol_heap, es_symbol_table = es_symbol_table,es_fun_defs=fun_defs,es_dcl_modules=dcl_modules }))
where
bind_expressions [var : vars] [expr : exprs] binds var_heap
# (binds, var_heap) = bind_expressions vars exprs binds var_heap
@@ -625,7 +667,8 @@ where
pationate_macro mod_index max_fun_nr macro_index (macro_defs, modules, pi)
# (macro_def, macro_defs) = macro_defs![macro_index]
- | macro_def.fun_kind == FK_Macro
+// | macro_def.fun_kind == FK_Macro
+ | case macro_def.fun_kind of FK_DefMacro->True ; FK_ImpMacro->True; _ -> False
= case macro_def.fun_body of
CheckedBody body
# macros_modules_pi = foldSt (visit_macro mod_index max_fun_nr) macro_def.fun_info.fi_calls
@@ -641,15 +684,17 @@ where
visit_macro mod_index max_fun_nr {fc_index} macros_modules_pi
= pationate_macro mod_index max_fun_nr fc_index macros_modules_pi
- expand_simple_macro mod_index macro_index macro=:{fun_body = CheckedBody body, fun_info, fun_symb, fun_pos}
+ expand_simple_macro mod_index macro_index macro=:{fun_body = CheckedBody body, fun_info, fun_symb, fun_pos,fun_kind}
(macro_defs, modules, pi=:{pi_symbol_table,pi_symbol_heap,pi_var_heap,pi_error})
| macros_are_simple fun_info.fi_calls macro_defs
# identPos = newPosition fun_symb fun_pos
+ # expand_in_imp_module=case fun_kind of FK_ImpMacro->True; _ -> False
es = { es_symbol_table = pi_symbol_table, es_var_heap = pi_var_heap,
es_symbol_heap = pi_symbol_heap, es_error = setErrorAdmin identPos pi_error,
- es_fun_defs=macro_defs, es_module_n = mod_index, es_dcl_modules=modules
+ es_fun_defs=macro_defs, es_main_dcl_module_n = mod_index, es_dcl_modules=modules,
+ es_expand_in_imp_module=expand_in_imp_module
}
- (tb_args, tb_rhs, local_vars, fi_calls, {es_symbol_table, es_var_heap, es_symbol_heap, es_error,es_dcl_modules,es_fun_defs})
+ # (tb_args, tb_rhs, local_vars, fi_calls, {es_symbol_table, es_var_heap, es_symbol_heap, es_error,es_dcl_modules,es_fun_defs})
= expandMacrosInBody [] body alias_dummy es
macro = { macro & fun_body = TransformedBody { tb_args = tb_args, tb_rhs = tb_rhs},
fun_info = { fun_info & fi_calls = fi_calls, fi_local_vars = local_vars }}
@@ -664,7 +709,9 @@ where
# {fun_kind,fun_body} = macro_defs.[fc_index]
= is_a_pattern_macro fun_kind fun_body && macros_are_simple calls macro_defs
where
- is_a_pattern_macro FK_Macro (TransformedBody {tb_args})
+ is_a_pattern_macro FK_DefMacro (TransformedBody {tb_args})
+ = True
+ is_a_pattern_macro FK_ImpMacro (TransformedBody {tb_args})
= True
is_a_pattern_macro _ _
= False
@@ -673,14 +720,31 @@ partitionateAndLiftFunctions :: ![IndexRange] !Index !PredefinedSymbol !*{# FunD
-> (!*{! Group}, !*{# FunDef}, !.{# DclModule}, !*VarHeap, !*ExpressionHeap, !*SymbolTable, !*ErrorAdmin )
partitionateAndLiftFunctions ranges main_dcl_module_n alias_dummy fun_defs modules var_heap symbol_heap symbol_table error
#! max_fun_nr = size fun_defs
- # partitioning_info = { pi_var_heap = var_heap, pi_symbol_heap = symbol_heap, pi_symbol_table = symbol_table,
- pi_error = error, pi_deps = [], pi_next_num = 0, pi_next_group = 0, pi_groups = [] }
+ # partitioning_info = { pi_var_heap = var_heap, pi_symbol_heap = symbol_heap, pi_symbol_table = symbol_table,
+ pi_error = error, pi_deps = [], pi_next_num = 0, pi_next_group = 0, pi_groups = [] }
(fun_defs, modules, {pi_groups, pi_symbol_table, pi_var_heap, pi_symbol_heap, pi_error})
= foldSt (partitionate_functions main_dcl_module_n max_fun_nr) ranges (fun_defs, modules, partitioning_info)
- groups = { {group_members = group} \\ group <- reverse pi_groups }
+ # (reversed_pi_groups,fun_defs) = remove_macros_from_groups_and_reverse pi_groups fun_defs []
+ # groups = { {group_members = group} \\ group <- reversed_pi_groups }
+// # groups = { {group_members = group} \\ group <- reverse pi_groups }
= (groups, fun_defs, modules, pi_var_heap, pi_symbol_heap, pi_symbol_table, pi_error)
where
-
+ remove_macros_from_groups_and_reverse [group:groups] fun_defs result_groups
+ # (group,fun_defs) = remove_macros_from_group group fun_defs
+ = case group of
+ [] -> remove_macros_from_groups_and_reverse groups fun_defs result_groups
+ _ -> remove_macros_from_groups_and_reverse groups fun_defs [group:result_groups]
+ where
+ remove_macros_from_group [fun:funs] fun_defs
+ # (funs,fun_defs)=remove_macros_from_group funs fun_defs
+ | fun_defs.[fun].fun_info.fi_group_index<NoIndex
+ = (funs,fun_defs)
+ = ([fun:funs],fun_defs)
+ remove_macros_from_group [] fun_defs
+ = ([],fun_defs);
+ remove_macros_from_groups_and_reverse [] fun_defs result_groups
+ = (result_groups,fun_defs);
+
partitionate_functions mod_index max_fun_nr {ir_from,ir_to} funs_modules_pi
= iFoldSt (partitionate_global_function mod_index max_fun_nr) ir_from ir_to funs_modules_pi
@@ -702,11 +766,12 @@ where
TransformedBody _
| fun_def.fun_info.fi_group_index == NoIndex
# (fun_defs, pi) = add_called_macros fun_def.fun_info.fi_calls (fun_defs, pi)
- -> (max_fun_nr, ({ fun_defs & [fun_index] = {fun_def & fun_info.fi_group_index = pi.pi_next_group }}, modules,
- {pi & pi_next_group = inc pi.pi_next_group, pi_groups = [ [fun_index] : pi.pi_groups]}))
+// -> (max_fun_nr, ({ fun_defs & [fun_index] = {fun_def & fun_info.fi_group_index = pi.pi_next_group }}, modules,
+ -> (max_fun_nr, ({ fun_defs & [fun_index] = {fun_def & fun_info.fi_group_index = -2-pi.pi_next_group }}, modules,
+ {pi & pi_next_group = inc pi.pi_next_group, pi_groups = [ [fun_index] : pi.pi_groups]}
+// {pi & pi_next_group = pi.pi_next_group}
+ ))
-> (max_fun_nr, (fun_defs, modules, pi))
- BackendBody _
- -> abort "partitionate_function BackendBody"
visit_function mod_index max_fun_nr {fc_index} (min_dep, funs_modules_pi)
# (next_min, funs_modules_pi) = partitionate_function mod_index max_fun_nr fc_index funs_modules_pi
@@ -715,46 +780,52 @@ where
try_to_close_group mod_index max_fun_nr fun_index fun_number min_dep def_level (fun_defs, modules,
pi=:{pi_symbol_table, pi_var_heap, pi_symbol_heap, pi_deps, pi_groups, pi_next_group, pi_error})
| fun_number <= min_dep
- # (pi_deps, group_without_macros, group_without_funs, fun_defs)
+ # (pi_deps, functions_in_group, macros_in_group, fun_defs)
= close_group fun_index pi_deps [] [] max_fun_nr pi_next_group fun_defs
-// (fun_defs, pi_var_heap, pi_symbol_heap)
{ls_x={x_fun_defs=fun_defs}, ls_var_heap=pi_var_heap, ls_expr_heap=pi_symbol_heap}
-// = liftFunctions def_level (group_without_macros ++ group_without_funs) pi_next_group cIclModIndex fun_defs pi_var_heap pi_symbol_heap
- = liftFunctions def_level (group_without_macros ++ group_without_funs) pi_next_group main_dcl_module_n fun_defs pi_var_heap pi_symbol_heap
- es
- = expand_macros_in_group group_without_funs
+ = liftFunctions def_level (functions_in_group ++ macros_in_group) pi_next_group main_dcl_module_n fun_defs pi_var_heap pi_symbol_heap
+ es
+ = expand_macros_in_group macros_in_group
{ es_symbol_table = pi_symbol_table, es_var_heap = pi_var_heap, es_symbol_heap = pi_symbol_heap,
- es_fun_defs=fun_defs, es_module_n=mod_index, es_dcl_modules=modules,
+ es_fun_defs=fun_defs, es_main_dcl_module_n=mod_index, es_dcl_modules=modules,
+ es_expand_in_imp_module=False, // function expand_macros fills in correct value
es_error = pi_error }
{es_symbol_table, es_var_heap, es_symbol_heap, es_error,es_dcl_modules,es_fun_defs}
- = expand_macros_in_group group_without_macros es
+ = expand_macros_in_group functions_in_group es
= (max_fun_nr, (es_fun_defs, es_dcl_modules, { pi & pi_deps = pi_deps, pi_var_heap = es_var_heap,
pi_symbol_table = es_symbol_table, pi_error = es_error, pi_symbol_heap = es_symbol_heap,
- pi_next_group = inc pi_next_group, pi_groups = [ group_without_macros ++ group_without_funs : pi_groups ] }))
+ pi_next_group = inc pi_next_group,
+ pi_groups = [ functions_in_group ++ macros_in_group : pi_groups ] }))
+// pi_groups = if (isEmpty functions_in_group) pi_groups [ functions_in_group : pi_groups ] }))
= (min_dep, (fun_defs, modules, pi))
where
- close_group fun_index [d:ds] group_without_macros group_without_funs nr_of_fun_defs group_number fun_defs
+ close_group fun_index [d:ds] functions_in_group macros_in_group nr_of_fun_defs group_number fun_defs
# (fun_def, fun_defs) = fun_defs![d]
- fun_defs = { fun_defs & [d] = { fun_def & fun_info.fi_group_index = group_number }}
- | fun_def.fun_kind == FK_Macro
- # group_without_funs = [d : group_without_funs]
+// fun_defs = { fun_defs & [d] = { fun_def & fun_info.fi_group_index = group_number }}
+// | fun_def.fun_kind == FK_Macro
+ | case fun_def.fun_kind of FK_DefMacro->True ; FK_ImpMacro->True; _ -> False
+ # fun_defs = { fun_defs & [d] = { fun_def & fun_info.fi_group_index = -2-group_number }}
+ # macros_in_group = [d : macros_in_group]
| d == fun_index
- = (ds, group_without_macros, group_without_funs, fun_defs)
- = close_group fun_index ds group_without_macros group_without_funs nr_of_fun_defs group_number fun_defs
- # group_without_macros = [d : group_without_macros]
+ = (ds, functions_in_group, macros_in_group, fun_defs)
+ = close_group fun_index ds functions_in_group macros_in_group nr_of_fun_defs group_number fun_defs
+ # fun_defs = { fun_defs & [d] = { fun_def & fun_info.fi_group_index = group_number }}
+ # functions_in_group = [d : functions_in_group]
| d == fun_index
- = (ds, group_without_macros, group_without_funs, fun_defs)
- = close_group fun_index ds group_without_macros group_without_funs nr_of_fun_defs group_number fun_defs
+ = (ds, functions_in_group, macros_in_group, fun_defs)
+ = close_group fun_index ds functions_in_group macros_in_group nr_of_fun_defs group_number fun_defs
expand_macros_in_group group es
= foldSt expand_macros group es
expand_macros fun_index es
# (fun_def,es) = es!es_fun_defs.[fun_index]
- {fun_symb,fun_body = PartioningFunction body _, fun_info, fun_pos} = fun_def
+ {fun_symb,fun_body = PartioningFunction body _, fun_info, fun_pos,fun_kind} = fun_def
identPos = newPosition fun_symb fun_pos
- (tb_args, tb_rhs, fi_local_vars, fi_calls, es)
- = expandMacrosInBody fun_info.fi_calls body alias_dummy { es & es_error = setErrorAdmin identPos es.es_error }
+ # expand_in_imp_module=case fun_kind of FK_ImpFunction _->True; FK_ImpMacro->True; FK_ImpCaf->True; _ -> False
+ es={ es & es_expand_in_imp_module=expand_in_imp_module, es_error = setErrorAdmin identPos es.es_error }
+ # (tb_args, tb_rhs, fi_local_vars, fi_calls, es)
+ = expandMacrosInBody fun_info.fi_calls body alias_dummy es
fun_def = { fun_def & fun_body = TransformedBody { tb_args = tb_args, tb_rhs = tb_rhs},
fun_info = { fun_info & fi_calls = fi_calls, fi_local_vars = fi_local_vars }}
= {es & es_fun_defs.[fun_index] = fun_def }
@@ -768,27 +839,32 @@ where
TransformedBody _
| macro_def.fun_info.fi_group_index == NoIndex
# (macro_defs, pi) = add_called_macros macro_def.fun_info.fi_calls (macro_defs, pi)
- -> ({ macro_defs & [fc_index] = {macro_def & fun_info.fi_group_index = pi.pi_next_group }},
- {pi & pi_next_group = inc pi.pi_next_group, pi_groups = [ [fc_index] : pi.pi_groups]})
+// -> ({ macro_defs & [fc_index] = {macro_def & fun_info.fi_group_index = pi.pi_next_group }},
+ -> ({ macro_defs & [fc_index] = {macro_def & fun_info.fi_group_index = -2-pi.pi_next_group }},
+ {pi & pi_next_group = inc pi.pi_next_group,pi_groups = [ [fc_index] : pi.pi_groups]}
+// {pi & pi_next_group = pi.pi_next_group}
+ )
-> (macro_defs, pi)
-
-
addFunctionCallsToSymbolTable calls fun_defs symbol_table
= foldSt add_function_call_to_symbol_table calls ([], fun_defs, symbol_table)
where
add_function_call_to_symbol_table fc=:{fc_index} (collected_calls, fun_defs, symbol_table)
# ({fun_symb = { id_info }, fun_kind}, fun_defs) = fun_defs![fc_index]
- | fun_kind == FK_Macro
- = (collected_calls, fun_defs, symbol_table)
- # (entry, symbol_table) = readPtr id_info symbol_table
- = ([fc : collected_calls], fun_defs,
+// | fun_kind == FK_Macro
+ = case fun_kind of
+ FK_DefMacro
+ -> (collected_calls, fun_defs, symbol_table)
+ FK_ImpMacro
+ -> (collected_calls, fun_defs, symbol_table)
+ _
+ # (entry, symbol_table) = readPtr id_info symbol_table
+ -> ([fc : collected_calls], fun_defs,
symbol_table <:= (id_info, { ste_kind = STE_Called [fc_index], ste_index = NoIndex, ste_def_level = NotALevel, ste_previous = entry }))
removeFunctionCallsFromSymbolTable calls fun_defs symbol_table
= foldSt remove_function_call_from_symbol_table calls (fun_defs, symbol_table)
where
-
remove_function_call_from_symbol_table {fc_index} (fun_defs, symbol_table)
# ({fun_symb = { id_info }}, fun_defs) = fun_defs![fc_index]
(entry, symbol_table) = readPtr id_info symbol_table
@@ -928,9 +1004,9 @@ where
= DynamicPatterns (map (\dynpattern -> { dynpattern & dp_rhs = expr_fun dynpattern.dp_rhs }) patterns)
replace_variables_in_expression expr var_heap symbol_heap
- # us = { us_var_heap = var_heap, us_symbol_heap = symbol_heap, us_opt_type_heaps = No,
- us_cleanup_info = [], us_handle_aci_free_vars = RemoveThem }
- (expr, us) = unfold expr us
+ # us = { us_var_heap = var_heap, us_symbol_heap = symbol_heap, us_opt_type_heaps = No,us_cleanup_info = []}
+ ui = {ui_handle_aci_free_vars = RemoveThem, ui_convert_module_n = -1, ui_conversion_table = No}
+ (expr, us) = unfold expr ui us
= (expr, us.us_var_heap, us.us_symbol_heap)
new_variable fv=:{fv_name, fv_info_ptr} var_heap
@@ -1027,9 +1103,9 @@ where
= ([ pattern : patterns ], var_heap, symbol_heap, error)
where
replace_variables vars expr ap_vars var_heap symbol_heap
- # us = { us_var_heap = build_aliases vars ap_vars var_heap, us_symbol_heap = symbol_heap, us_opt_type_heaps = No,
- us_cleanup_info=[], us_handle_aci_free_vars = RemoveThem }
- (expr, us) = unfold expr us
+ # us = { us_var_heap = build_aliases vars ap_vars var_heap, us_symbol_heap = symbol_heap, us_opt_type_heaps = No,us_cleanup_info=[]}
+ ui = {ui_handle_aci_free_vars = RemoveThem, ui_convert_module_n= -1, ui_conversion_table=No}
+ (expr, us) = unfold expr ui us
= (expr, us.us_var_heap, us.us_symbol_heap)
build_aliases [var1 : vars1] [ {fv_name,fv_info_ptr} : vars2 ] var_heap
@@ -1074,7 +1150,6 @@ liftFunctions min_level group group_index main_dcl_module_n fun_defs var_heap ex
// = (fun_defs, var_heap, expr_heap)
= {ls_x={x_fun_defs=fun_defs,x_main_dcl_module_n=main_dcl_module_n},ls_var_heap=var_heap, ls_expr_heap=expr_heap}
where
-
add_free_vars_of_non_recursive_calls_to_function group_index fun (contains_free_vars, lifted_function_called, fun_defs)
# (fun_def=:{fun_info}, fun_defs) = fun_defs![fun]
{ fi_free_vars,fi_def_level,fi_calls } = fun_info
@@ -1085,7 +1160,8 @@ where
where
add_free_vars_of_non_recursive_call fun_def_level group_index {fc_index} (lifted_function_called, free_vars, fun_defs)
# ({fun_info = {fi_free_vars,fi_group_index}}, fun_defs) = fun_defs![fc_index]
- | fi_group_index == group_index
+// | fi_group_index == group_index
+ | if (fi_group_index>=NoIndex) (fi_group_index==group_index) (-2-fi_group_index==group_index)
= (lifted_function_called, free_vars, fun_defs)
| isEmpty fi_free_vars
= (lifted_function_called, free_vars, fun_defs)
@@ -1104,7 +1180,8 @@ where
where
add_free_vars_of_recursive_call fun_def_level group_index {fc_index} (free_vars_added, free_vars, fun_defs)
# ({fun_info = {fi_free_vars,fi_group_index}}, fun_defs) = fun_defs![fc_index]
- | fi_group_index == group_index
+// | fi_group_index == group_index
+ | if (fi_group_index>=NoIndex) (fi_group_index==group_index) (-2-fi_group_index==group_index)
# (free_vars_added, free_vars) = add_free_variables fun_def_level fi_free_vars (free_vars_added, free_vars)
= (free_vars_added, free_vars, fun_defs)
= (free_vars_added, free_vars, fun_defs)
@@ -1165,8 +1242,9 @@ where
, es_symbol_heap :: !.ExpressionHeap
, es_error :: !.ErrorAdmin,
es_fun_defs :: !.{#FunDef},
- es_module_n :: !Int,
- es_dcl_modules :: !.{# DclModule}
+ es_main_dcl_module_n :: !Int,
+ es_dcl_modules :: !.{# DclModule},
+ es_expand_in_imp_module :: !Bool
}
class expand a :: !a !*ExpandInfo -> (!a, !*ExpandInfo)
@@ -1177,11 +1255,13 @@ where
# (app_args, (calls, es)) = expand app_args ei
# (macro, es) = es!es_fun_defs.[glob_object]
| macro.fun_arity == symb_arity
- # (expr, ei) = unfoldMacro macro app_args (calls, es)
- = (expr, ei)
+ = unfoldMacro macro app_args (calls, es)
# (calls, es_symbol_table) = examineFunctionCall macro.fun_symb {fc_index = glob_object, fc_level = NotALevel} (calls, es.es_symbol_table)
- = (App { app & app_symb = { symb & symb_kind = SK_Function {glob_object = glob_object, glob_module = glob_module} }, app_args = app_args },
- (calls, { es & es_symbol_table = es_symbol_table }))
+ | macro.fun_info.fi_group_index<NoIndex
+ # macro = {macro & fun_info.fi_group_index= -2-macro.fun_info.fi_group_index}
+ # es= {es & es_fun_defs.[glob_object]=macro}
+ = (App { app & app_symb = { symb & symb_kind = SK_Function {glob_object = glob_object, glob_module = glob_module} }, app_args = app_args },(calls, { es & es_symbol_table = es_symbol_table }))
+ = (App { app & app_symb = { symb & symb_kind = SK_Function {glob_object = glob_object, glob_module = glob_module} }, app_args = app_args },(calls, { es & es_symbol_table = es_symbol_table }))
expand (App app=:{app_args}) ei
# (app_args, ei) = expand app_args ei
= (App { app & app_args = app_args }, ei)
@@ -1590,7 +1670,7 @@ where
-> (var, [{fv_name = var_name, fv_info_ptr = var_info_ptr, fv_def_level = NotALevel, fv_count = 0} : free_vars ],
{ cos & cos_var_heap = writePtr var_info_ptr (VI_Count 1 is_global) cos.cos_var_heap })
_
- -> abort "collectVariables [BoundVar] (transform, 1227)" <<- (var_info ---> (var_name, ptrToInt var_info_ptr))
+ -> abort "collectVariables [BoundVar] (transform, 1227)" // <<- (var_info ---> (var_name, ptrToInt var_info_ptr))
instance <<< (Ptr a)
where
diff --git a/frontend/type.icl b/frontend/type.icl
index d925719..b93a962 100644
--- a/frontend/type.icl
+++ b/frontend/type.icl
@@ -1,8 +1,7 @@
implementation module type
import StdEnv
-import syntax, typesupport, check, analtypes, overloading, unitype, refmark, predef, utilities, compare_constructor
-import RWSDebug
+import syntax, typesupport, check, analtypes, overloading, unitype, refmark, predef, utilities, compare_constructor // , RWSDebug
:: TypeInput =
{ ti_common_defs :: !{# CommonDefs }
@@ -1056,7 +1055,6 @@ storeAttribute No type_attribute symbol_heap
= symbol_heap
getSymbolType ti=:{ti_functions,ti_common_defs,ti_main_dcl_module_n} {symb_kind = SK_Function {glob_module,glob_object}, symb_arity, symb_name} ts
-// | glob_module == cIclModIndex
| glob_module == ti_main_dcl_module_n
| glob_object>=size ts.ts_fun_env
= abort symb_name.id_name;
@@ -1075,7 +1073,8 @@ getSymbolType ti=:{ti_functions,ti_common_defs,ti_main_dcl_module_n} {symb_kind
(fun_type_copy,ts) = currySymbolType fun_type_copy symb_arity ts
-> (fun_type_copy, cons_variables, [], ts)
_
- -> abort "getSymbolType (type.icl)" ---> (symb_name, glob_object, fun_type)
+ -> abort ("getSymbolType "+++toString symb_name+++toString glob_object)
+// -> abort "getSymbolType (type.icl)" ---> (symb_name, glob_object, fun_type)
# {ft_type,ft_type_ptr,ft_specials} = ti_functions.[glob_module].[glob_object]
| glob_module>=size ti_functions || glob_object>=size ti_functions.[glob_module]
= abort (toString glob_module+++" "+++toString glob_object+++" "+++toString ti_main_dcl_module_n+++" "+++symb_name.id_name);
@@ -1105,7 +1104,8 @@ getSymbolType ti=:{ti_functions,ti_common_defs,ti_main_dcl_module_n} {symb_kind
(fun_type_copy,ts) = currySymbolType fun_type_copy symb_arity ts
-> (fun_type_copy, cons_variables, [], ts)
_
- -> abort "getSymbolType (type.icl)" ---> (symb_name, glob_object, fun_type)
+ -> abort ("getSymbolType "+++toString symb_name+++toString glob_object)
+// -> abort "getSymbolType (type.icl)" ---> (symb_name, glob_object, fun_type)
getSymbolType ti=:{ti_common_defs} {symb_kind = SK_OverloadedFunction {glob_module,glob_object}, symb_arity} ts
# {me_symb, me_type,me_type_ptr} = ti_common_defs.[glob_module].com_member_defs.[glob_object]
(fun_type_copy, cons_variables, ts) = determineSymbolTypeOfFunction me_symb symb_arity me_type me_type_ptr ti_common_defs ts
@@ -1122,7 +1122,7 @@ where
VI_Type type _
-> type
_
- -> abort ("requirements BoundVar" ---> (var_name <<- var_info))
+ -> abort "requirements BoundVar" // ---> (var_name <<- var_info))
, Yes var_expr_ptr, (reqs, ts))
instance requirements App
@@ -2316,8 +2316,8 @@ where
, fun_body = NoBody
, fun_type = Yes instance_type
, fun_pos = me_pos
- , fun_index = member_index
- , fun_kind = FK_Unknown
+ , fun_index = member_index
+ , fun_kind = FK_DefOrImpUnknown
, fun_lifted = 0
, fun_info = EmptyFunInfo
}