Commit 2d11cd98 authored by John van Groningen's avatar John van Groningen
Browse files

added fusion of unboxed lists of records, moved

FI_IsNonRecursive from partition.icl and trans.icl
to syntax.dcl, added FI_IsUnboxedListOfRecordsConsOrNil
to mark instances of unboxed lists of records generated
in type.icl
parent dc5efc6d
......@@ -609,10 +609,6 @@ dummy_predef_symbols =
, predef_or = dummy_predef_symbol
}
///// FI_IsNonRecursive
FI_IsNonRecursive :== 4
set_rec_prop non_recursive fi_properties
= case non_recursive of
True -> fi_properties bitor FI_IsNonRecursive
......
......@@ -500,10 +500,10 @@ NoGlobalIndex :== {gi_module=NoIndex,gi_index=NoIndex}
:: FunCall = FunCall !Index !Level | MacroCall !ModuleIndex !Index Level | DclFunCall !ModuleIndex !DclFunctionIndex;
/* Sjaak 19-3-2001 ... */
FI_IsMacroFun :== 1 // whether the function is a local function of a macro
FI_HasTypeSpec :== 2 // whether the function has u user defined type
FI_IsNonRecursive :== 4 // used in trans.icl and partition.icl
FI_IsUnboxedListOfRecordsConsOrNil :== 8
:: FunInfo =
{ fi_calls :: ![FunCall]
......@@ -514,7 +514,6 @@ FI_HasTypeSpec :== 2 // whether the function has u user defined type
, fi_dynamics :: ![ExprInfoPtr]
, fi_properties :: !BITVECT
}
/* ... Sjaak 19-3-2001 */
:: ParsedBody =
{ pb_args :: ![ParsedExpr]
......
......@@ -377,7 +377,7 @@ where
= (No, ti)
possiblyFoldOuterCase final guard_expr outer_case ro ti
| SwitchAutoFoldCaseInCase (isFoldExpression guard_expr) False // otherwise GOTO next alternative
| SwitchAutoFoldCaseInCase (isFoldExpression guard_expr ti.ti_fun_defs ti.ti_cons_args) False // otherwise GOTO next alternative
| False -!-> ("possiblyFoldOuterCase","Case",bef < 0 || act < 0,ro.ro_fun_args,aci.aci_params) = undef
| bef < 0 || act < 0
= possiblyFoldOuterCase` final guard_expr outer_case ro ti //abort "possiblyFoldOuterCase: unexpected!\n"
......@@ -393,21 +393,26 @@ where
// = transformApplication { app_symb = folder, app_args = folder_args, app_info_ptr = nilPtr } [] ro ti
// where
isFoldExpression (App app) = isFoldSymbol app.app_symb.symb_kind
isFoldExpression (App app) ti_fun_defs ti_cons_args = isFoldSymbol app.app_symb.symb_kind
where
isFoldSymbol (SK_Function {glob_module,glob_object})
| glob_module==ro.ro_stdStrictLists_module_n
# type_arity = ro.ro_imported_funs.[glob_module].[glob_object].ft_type.st_arity
| type_arity==0 || (type_arity==2 && case app.app_args of [_:_] -> True; _ -> False)
= False
= True
= True
| glob_module==ro.ro_main_dcl_module_n && glob_object>=size ti_cons_args &&
(ti_fun_defs.[glob_object].fun_info.fi_properties bitand FI_IsUnboxedListOfRecordsConsOrNil<>0) &&
(case ti_fun_defs.[glob_object].fun_type of
Yes type ->(type.st_arity==0 || (type.st_arity==2 && case app.app_args of [_:_] -> True; _ -> False)))
= False
= True
isFoldSymbol (SK_LocalMacroFunction _) = True
isFoldSymbol (SK_GeneratedFunction _ _) = True
isFoldSymbol _ = False
isFoldExpression (Var _) = True
// isFoldExpression (Case _) = True
isFoldExpression _ = False
isFoldExpression (Var _) ti_fun_defs ti_cons_args = True
// isFoldExpression (Case _) ti_fun_defs ti_cons_args = True
isFoldExpression _ ti_fun_defs ti_cons_args = False
folder = ro.ro_fun_orig
folder_args = f_a_before` ++ [guard_expr:f_a_after`]
......@@ -453,14 +458,13 @@ transCase is_active opt_aci this_case=:{case_expr = case_expr=:(App app=:{app_sy
(let type = ro.ro_imported_funs.[glob_module].[glob_object].ft_type
in (type.st_arity==0 || (type.st_arity==2 && case app_args of [_:_] -> True; _ -> False)))
# type = ro.ro_imported_funs.[glob_module].[glob_object].ft_type
| type.st_arity==0
# (may_be_match_expr, ti) = match_and_instantiate_overloaded_nil case_guards case_default ro ti
-> expr_or_never_matching_case may_be_match_expr case_ident ti
# aci_linearity_of_patterns = case opt_aci of
Yes aci -> aci.aci_linearity_of_patterns
(may_be_match_expr, ti) = match_and_instantiate_overloaded_cons type aci_linearity_of_patterns app_args case_guards case_default ro ti
-> expr_or_never_matching_case may_be_match_expr case_ident ti
-> trans_case_of_overloaded_nil_or_cons type ti
| glob_module==ro.ro_main_dcl_module_n && glob_object>=size ti.ti_cons_args &&
(ti.ti_fun_defs.[glob_object].fun_info.fi_properties bitand FI_IsUnboxedListOfRecordsConsOrNil)<>0 && is_active &&
(case ti.ti_fun_defs.[glob_object].fun_type of
Yes type ->(type.st_arity==0 || (type.st_arity==2 && case app_args of [_:_] -> True; _ -> False)))
# (Yes type,ti) = ti!ti_fun_defs.[glob_object].fun_type
-> trans_case_of_overloaded_nil_or_cons type ti
// otherwise it's a function application
_ -> case opt_aci of
Yes aci=:{ aci_params, aci_opt_unfolder }
......@@ -578,75 +582,84 @@ where
match_and_instantiate_overloaded_list _ cons_index app_args [] case_default ro ti
= transform case_default { ro & ro_root_case_mode = NotRootCase } ti
match_and_instantiate_overloaded_nil (OverloadedListPatterns _ _ algebraicPatterns) case_default ro ti
= match_and_instantiate_nil algebraicPatterns case_default ro ti
match_and_instantiate_overloaded_nil (AlgebraicPatterns _ algebraicPatterns) case_default ro ti
= match_and_instantiate_nil algebraicPatterns case_default ro ti
match_and_instantiate_nil [{ap_symbol={glob_module,glob_object={ds_index}},ap_expr} : guards] case_default ro ti
| glob_module==cPredefinedModuleIndex
# index=ds_index+FirstConstructorPredefinedSymbolIndex
| index==PD_NilSymbol || index==PD_StrictNilSymbol || index==PD_TailStrictNilSymbol || index==PD_StrictTailStrictNilSymbol ||
index==PD_OverloadedNilSymbol || index==PD_UnboxedNilSymbol || index==PD_UnboxedTailStrictNilSymbol
= instantiate [] [] [] ap_expr NotStrict [] ti
= match_and_instantiate_nil guards case_default ro ti
match_and_instantiate_nil [] case_default ro ti
= transform case_default { ro & ro_root_case_mode = NotRootCase } ti
match_and_instantiate_overloaded_cons cons_function_type linearities app_args (AlgebraicPatterns _ algebraicPatterns) case_default ro ti
= match_and_instantiate_overloaded_cons_boxed_match linearities app_args algebraicPatterns case_default ro ti
where
match_and_instantiate_overloaded_cons_boxed_match [linearity:linearities] app_args
[{ap_symbol={glob_module,glob_object={ds_index}}, ap_vars, ap_expr} : guards]
case_default ro ti
| glob_module==cPredefinedModuleIndex
# index=ds_index+FirstConstructorPredefinedSymbolIndex
| index==PD_ConsSymbol || index==PD_StrictConsSymbol || index==PD_TailStrictConsSymbol || index==PD_StrictTailStrictConsSymbol
# {cons_type} = ro.ro_common_defs.[glob_module].com_cons_defs.[ds_index]
= instantiate linearity app_args ap_vars ap_expr cons_type.st_args_strictness cons_type.st_args ti
// | index==PD_NilSymbol || index==PD_StrictNilSymbol || index==PD_TailStrictNilSymbol || index==PD_StrictTailStrictNilSymbol
= match_and_instantiate_overloaded_cons_boxed_match linearities app_args guards case_default ro ti
// = abort "match_and_instantiate_overloaded_cons_boxed_match"
match_and_instantiate_overloaded_cons_boxed_match _ app_args [] case_default ro ti
= transform case_default { ro & ro_root_case_mode = NotRootCase } ti
match_and_instantiate_overloaded_cons cons_function_type linearities app_args (OverloadedListPatterns _ _ algebraicPatterns) case_default ro ti
= match_and_instantiate_overloaded_cons_overloaded_match linearities app_args algebraicPatterns case_default ro ti
where
match_and_instantiate_overloaded_cons_overloaded_match [linearity:linearities] app_args
[{ap_symbol={glob_module,glob_object={ds_index}}, ap_vars, ap_expr} : guards]
case_default ro ti
| glob_module==cPredefinedModuleIndex
# index=ds_index+FirstConstructorPredefinedSymbolIndex
| index==PD_UnboxedConsSymbol || index==PD_UnboxedTailStrictConsSymbol || index==PD_OverloadedConsSymbol
= instantiate linearity app_args ap_vars ap_expr cons_function_type.st_args_strictness cons_function_type.st_args ti
// | index==PD_UnboxedNilSymbol || index==PD_UnboxedTailStrictNilSymbol || index==PD_OverloadedNilSymbol
= match_and_instantiate_overloaded_cons_overloaded_match linearities app_args guards case_default ro ti
// = abort "match_and_instantiate_overloaded_cons_overloaded_match"
match_and_instantiate_overloaded_cons_overloaded_match _ app_args [] case_default ro ti
= transform case_default { ro & ro_root_case_mode = NotRootCase } ti
/*
match_and_instantiate_overloaded_cons linearities app_args (OverloadedListPatterns _ (App {app_args=[],app_symb={symb_kind=SK_Function {glob_module=decons_module,glob_object=deconsindex}}}) algebraicPatterns) case_default ro ti
= match_and_instantiate_overloaded_cons_overloaded_match linearities app_args algebraicPatterns case_default ro ti
where
match_and_instantiate_overloaded_cons_overloaded_match [linearity:linearities] app_args
[{ap_symbol={glob_module,glob_object={ds_index}}, ap_vars, ap_expr} : guards]
case_default ro ti
| glob_module==cPredefinedModuleIndex
# index=ds_index+FirstConstructorPredefinedSymbolIndex
| index==PD_UnboxedConsSymbol || index==PD_UnboxedTailStrictConsSymbol || index==PD_OverloadedConsSymbol
# (argument_types,strictness) = case ro.ro_imported_funs.[decons_module].[deconsindex].ft_type.st_result.at_type of
TA _ args=:[arg1,arg2] -> (args,NotStrict)
TAS _ args=:[arg1,arg2] strictness -> (args,strictness)
= instantiate linearity app_args ap_vars ap_expr strictness argument_types ti
| index==PD_UnboxedNilSymbol || index==PD_UnboxedTailStrictNilSymbol || index==PD_OverloadedNilSymbol
= match_and_instantiate_overloaded_cons_overloaded_match linearities app_args guards case_default ro ti
= abort "match_and_instantiate_overloaded_cons_overloaded_match"
match_and_instantiate_overloaded_cons_overloaded_match [linearity:linearities] app_args [guard : guards] case_default ro ti
= match_and_instantiate_overloaded_cons_overloaded_match linearities app_args guards case_default ro ti
match_and_instantiate_overloaded_cons_overloaded_match _ app_args [] case_default ro ti
= transform case_default { ro & ro_root_case_mode = NotRootCase } ti
*/
trans_case_of_overloaded_nil_or_cons type ti
| type.st_arity==0
# (may_be_match_expr, ti) = match_and_instantiate_overloaded_nil case_guards case_default ro ti
= expr_or_never_matching_case may_be_match_expr case_ident ti
# aci_linearity_of_patterns = case opt_aci of
Yes aci -> aci.aci_linearity_of_patterns
(may_be_match_expr, ti) = match_and_instantiate_overloaded_cons type aci_linearity_of_patterns app_args case_guards case_default ro ti
= expr_or_never_matching_case may_be_match_expr case_ident ti
where
match_and_instantiate_overloaded_nil (OverloadedListPatterns _ _ algebraicPatterns) case_default ro ti
= match_and_instantiate_nil algebraicPatterns case_default ro ti
match_and_instantiate_overloaded_nil (AlgebraicPatterns _ algebraicPatterns) case_default ro ti
= match_and_instantiate_nil algebraicPatterns case_default ro ti
match_and_instantiate_nil [{ap_symbol={glob_module,glob_object={ds_index}},ap_expr} : guards] case_default ro ti
| glob_module==cPredefinedModuleIndex
# index=ds_index+FirstConstructorPredefinedSymbolIndex
| index==PD_NilSymbol || index==PD_StrictNilSymbol || index==PD_TailStrictNilSymbol || index==PD_StrictTailStrictNilSymbol ||
index==PD_OverloadedNilSymbol || index==PD_UnboxedNilSymbol || index==PD_UnboxedTailStrictNilSymbol
= instantiate [] [] [] ap_expr NotStrict [] ti
= match_and_instantiate_nil guards case_default ro ti
match_and_instantiate_nil [] case_default ro ti
= transform case_default { ro & ro_root_case_mode = NotRootCase } ti
match_and_instantiate_overloaded_cons cons_function_type linearities app_args (AlgebraicPatterns _ algebraicPatterns) case_default ro ti
= match_and_instantiate_overloaded_cons_boxed_match linearities app_args algebraicPatterns case_default ro ti
where
match_and_instantiate_overloaded_cons_boxed_match [linearity:linearities] app_args
[{ap_symbol={glob_module,glob_object={ds_index}}, ap_vars, ap_expr} : guards]
case_default ro ti
| glob_module==cPredefinedModuleIndex
# index=ds_index+FirstConstructorPredefinedSymbolIndex
| index==PD_ConsSymbol || index==PD_StrictConsSymbol || index==PD_TailStrictConsSymbol || index==PD_StrictTailStrictConsSymbol
# {cons_type} = ro.ro_common_defs.[glob_module].com_cons_defs.[ds_index]
= instantiate linearity app_args ap_vars ap_expr cons_type.st_args_strictness cons_type.st_args ti
// | index==PD_NilSymbol || index==PD_StrictNilSymbol || index==PD_TailStrictNilSymbol || index==PD_StrictTailStrictNilSymbol
= match_and_instantiate_overloaded_cons_boxed_match linearities app_args guards case_default ro ti
// = abort "match_and_instantiate_overloaded_cons_boxed_match"
match_and_instantiate_overloaded_cons_boxed_match _ app_args [] case_default ro ti
= transform case_default { ro & ro_root_case_mode = NotRootCase } ti
match_and_instantiate_overloaded_cons cons_function_type linearities app_args (OverloadedListPatterns _ _ algebraicPatterns) case_default ro ti
= match_and_instantiate_overloaded_cons_overloaded_match linearities app_args algebraicPatterns case_default ro ti
where
match_and_instantiate_overloaded_cons_overloaded_match [linearity:linearities] app_args
[{ap_symbol={glob_module,glob_object={ds_index}}, ap_vars, ap_expr} : guards]
case_default ro ti
| glob_module==cPredefinedModuleIndex
# index=ds_index+FirstConstructorPredefinedSymbolIndex
| index==PD_UnboxedConsSymbol || index==PD_UnboxedTailStrictConsSymbol || index==PD_OverloadedConsSymbol
= instantiate linearity app_args ap_vars ap_expr cons_function_type.st_args_strictness cons_function_type.st_args ti
// | index==PD_UnboxedNilSymbol || index==PD_UnboxedTailStrictNilSymbol || index==PD_OverloadedNilSymbol
= match_and_instantiate_overloaded_cons_overloaded_match linearities app_args guards case_default ro ti
// = abort "match_and_instantiate_overloaded_cons_overloaded_match"
match_and_instantiate_overloaded_cons_overloaded_match _ app_args [] case_default ro ti
= transform case_default { ro & ro_root_case_mode = NotRootCase } ti
/*
match_and_instantiate_overloaded_cons linearities app_args (OverloadedListPatterns _ (App {app_args=[],app_symb={symb_kind=SK_Function {glob_module=decons_module,glob_object=deconsindex}}}) algebraicPatterns) case_default ro ti
= match_and_instantiate_overloaded_cons_overloaded_match linearities app_args algebraicPatterns case_default ro ti
where
match_and_instantiate_overloaded_cons_overloaded_match [linearity:linearities] app_args
[{ap_symbol={glob_module,glob_object={ds_index}}, ap_vars, ap_expr} : guards]
case_default ro ti
| glob_module==cPredefinedModuleIndex
# index=ds_index+FirstConstructorPredefinedSymbolIndex
| index==PD_UnboxedConsSymbol || index==PD_UnboxedTailStrictConsSymbol || index==PD_OverloadedConsSymbol
# (argument_types,strictness) = case ro.ro_imported_funs.[decons_module].[deconsindex].ft_type.st_result.at_type of
TA _ args=:[arg1,arg2] -> (args,NotStrict)
TAS _ args=:[arg1,arg2] strictness -> (args,strictness)
= instantiate linearity app_args ap_vars ap_expr strictness argument_types ti
| index==PD_UnboxedNilSymbol || index==PD_UnboxedTailStrictNilSymbol || index==PD_OverloadedNilSymbol
= match_and_instantiate_overloaded_cons_overloaded_match linearities app_args guards case_default ro ti
= abort "match_and_instantiate_overloaded_cons_overloaded_match"
match_and_instantiate_overloaded_cons_overloaded_match [linearity:linearities] app_args [guard : guards] case_default ro ti
= match_and_instantiate_overloaded_cons_overloaded_match linearities app_args guards case_default ro ti
match_and_instantiate_overloaded_cons_overloaded_match _ app_args [] case_default ro ti
= transform case_default { ro & ro_root_case_mode = NotRootCase } ti
*/
instantiate linearity app_args ap_vars ap_expr cons_type_args_strictness cons_type_args ti
# zipped = zip2 ap_vars app_args
......@@ -2327,7 +2340,7 @@ transformFunctionApplication fun_def instances cc=:{cc_size, cc_args, cc_linear_
# is_applied_to_macro_fun = fun_def.fun_info.fi_properties bitand FI_IsMacroFun <> 0
# consumer_is_curried = cc_size <> length app_args
# non_rec_consumer
= (fun_def.fun_info.fi_properties bitand FI_IsNonRecursive) <> 0 with FI_IsNonRecursive = 4
= (fun_def.fun_info.fi_properties bitand FI_IsNonRecursive) <> 0
# safe_args
= isEmpty [arg \\ arg <- app_args & cc_arg <- cc_args | unsafe cc_arg && non_var arg]
with
......@@ -3024,7 +3037,7 @@ determineProducer is_applied_to_macro_fun consumer_is_curried ok_non_rec_consume
-!-> ("Produce1cc_hnr",symb.symb_name)
// NON-REC...
# non_rec_producer
= (fun_info.fi_properties bitand FI_IsNonRecursive) <> 0 with FI_IsNonRecursive = 4
= (fun_info.fi_properties bitand FI_IsNonRecursive) <> 0
# ok_non_rec
= case fun_body of
Expanding _
......@@ -3078,7 +3091,7 @@ determineProducer is_applied_to_macro_fun consumer_is_curried ok_non_rec_consume
-!-> ("Produce2cc_ho",symb.symb_name)
// NON-REC...
# non_rec_producer
= (fun_info.fi_properties bitand FI_IsNonRecursive) <> 0 with FI_IsNonRecursive = 4
= (fun_info.fi_properties bitand FI_IsNonRecursive) <> 0
# ok_non_rec
= case fun_body of
Expanding _
......
......@@ -2768,7 +2768,7 @@ where
, fun_pos = me_pos
, fun_kind = FK_Unknown
, fun_lifted = 0
, fun_info = EmptyFunInfo
, fun_info = {EmptyFunInfo & fi_properties=FI_IsUnboxedListOfRecordsConsOrNil}
}
= ({fun_defs & [fun_index]=fun}, type_heaps, error)
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment