Commit b7f4349a authored by John van Groningen's avatar John van Groningen
Browse files

renumber icl function and macro indices when unfolding

dcl macros in icl functions and macros
removed expanded macros from groups (s.c.components)
parent 81f00dff
......@@ -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
......
......@@ -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
......
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
......
......@@ -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}
......
......@@ -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
......
This diff is collapsed.
......@@ -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.
......
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
......
......@@ -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
......
......@@ -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
This diff is collapsed.
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)