Commit 56e2f0df authored by John van Groningen's avatar John van Groningen
Browse files

make generic info lazy to improve fusion results,

change toGenericFrom and fromGenericto to fromGeneric and toGeneric
parent bb9d441d
...@@ -68,23 +68,7 @@ convertGenerics :: ...@@ -68,23 +68,7 @@ convertGenerics ::
, !u:{# DclModule} // dcl modules , !u:{# DclModule} // dcl modules
, !*ErrorAdmin // to report errors , !*ErrorAdmin // to report errors
) )
convertGenerics convertGenerics main_dcl_module_n used_module_numbers modules groups funs td_infos heaps hash_table u_predefs dcl_modules error
main_dcl_module_n
used_module_numbers
modules
groups
funs
td_infos
heaps
hash_table
u_predefs
dcl_modules
error
//#! td_infos = td_infos ---> "************************* generic phase started ******************** "
//#! funs = dump_funs 0 funs
//#! dcl_modules = dump_dcl_modules 0 dcl_modules
#! modules = {x \\ x <-: modules} // unique copy #! modules = {x \\ x <-: modules} // unique copy
#! dcl_modules = { x \\ x <-: dcl_modules } // unique copy #! dcl_modules = { x \\ x <-: dcl_modules } // unique copy
#! size_predefs = size u_predefs #! size_predefs = size u_predefs
...@@ -132,26 +116,21 @@ where ...@@ -132,26 +116,21 @@ where
convert_generics :: !*GenericState -> (![IndexRange], !*GenericState) convert_generics :: !*GenericState -> (![IndexRange], !*GenericState)
convert_generics gs convert_generics gs
#! (iso_range, gs) = buildGenericRepresentations gs #! (iso_range, gs) = buildGenericRepresentations gs
#! (ok, gs) = gs_ok gs #! (ok, gs) = gs!gs_error.ea_ok
| not ok = ([], gs) | not ok = ([], gs)
#! gs = buildClasses gs #! gs = buildClasses gs
#! (ok, gs) = gs_ok gs #! (ok, gs) = gs!gs_error.ea_ok
| not ok = ([], gs) | not ok = ([], gs)
#! (instance_range, gs) = convertGenericCases gs #! (instance_range, gs) = convertGenericCases gs
#! (ok, gs) = gs_ok gs #! (ok, gs) = gs!gs_error.ea_ok
| not ok = ([], gs) | not ok = ([], gs)
#! gs = convertGenericTypeContexts gs #! gs = convertGenericTypeContexts gs
= ([iso_range,instance_range], gs) = ([iso_range,instance_range], gs)
gs_ok :: !*GenericState -> (!Bool, !*GenericState)
gs_ok gs=:{gs_error}
#! ok = gs_error.ea_ok
= (ok, {gs & gs_error = gs_error})
//**************************************************************************************** //****************************************************************************************
// clear stuff that might have been left over // clear stuff that might have been left over
// from compilation of other icl modules // from compilation of other icl modules
...@@ -269,9 +248,7 @@ buildGenericTypeRep :: ...@@ -269,9 +248,7 @@ buildGenericTypeRep ::
, !*GenericState , !*GenericState
) )
buildGenericTypeRep type_index funs_and_groups buildGenericTypeRep type_index funs_and_groups
gs=:{gs_modules, gs_predefs, gs_main_module, gs_error, gs_td_infos, gs=:{gs_modules, gs_predefs, gs_main_module, gs_error, gs_td_infos, gs_exprh, gs_varh, gs_genh, gs_avarh, gs_tvarh}
gs_exprh, gs_varh, gs_genh, gs_avarh, gs_tvarh}
# heaps = # heaps =
{ hp_expression_heap = gs_exprh { hp_expression_heap = gs_exprh
, hp_var_heap = gs_varh , hp_var_heap = gs_varh
...@@ -854,15 +831,11 @@ buildConversionTo :: ...@@ -854,15 +831,11 @@ buildConversionTo ::
buildConversionTo buildConversionTo
type_def_mod type_def_mod
type_def=:{td_rhs, td_ident, td_index, td_pos} type_def=:{td_rhs, td_ident, td_index, td_pos}
main_module_index main_module_index predefs funs_and_groups heaps error
predefs
funs_and_groups
heaps
error
# (arg_expr, arg_var, heaps) = buildVarExpr "x" heaps # (arg_expr, arg_var, heaps) = buildVarExpr "x" heaps
# (body_expr, heaps, error) = # (body_expr, heaps, error) =
build_expr_for_type_rhs type_def_mod td_index td_rhs arg_expr heaps error build_expr_for_type_rhs type_def_mod td_index td_rhs arg_expr heaps error
# fun_name = makeIdent ("fromGenericTo" +++ td_ident.id_name) # fun_name = makeIdent ("toGeneric" +++ td_ident.id_name)
| not error.ea_ok | not error.ea_ok
# (def_sym, funs_and_groups) # (def_sym, funs_and_groups)
= (buildFunAndGroup fun_name [] EE No main_module_index td_pos funs_and_groups) = (buildFunAndGroup fun_name [] EE No main_module_index td_pos funs_and_groups)
...@@ -989,14 +962,10 @@ buildConversionFrom :: ...@@ -989,14 +962,10 @@ buildConversionFrom ::
buildConversionFrom buildConversionFrom
type_def_mod type_def_mod
type_def=:{td_rhs, td_ident, td_index, td_pos} type_def=:{td_rhs, td_ident, td_index, td_pos}
main_module_index main_module_index predefs funs_and_groups heaps error
predefs
funs_and_groups
heaps
error
# (body_expr, arg_var, heaps, error) = # (body_expr, arg_var, heaps, error) =
build_expr_for_type_rhs type_def_mod td_rhs heaps error build_expr_for_type_rhs type_def_mod td_rhs heaps error
# fun_name = makeIdent ("toGenericFrom" +++ td_ident.id_name) # fun_name = makeIdent ("fromGeneric" +++ td_ident.id_name)
| not error.ea_ok | not error.ea_ok
# (def_sym, funs_and_groups) # (def_sym, funs_and_groups)
= (buildFunAndGroup fun_name [] EE No main_module_index td_pos funs_and_groups) = (buildFunAndGroup fun_name [] EE No main_module_index td_pos funs_and_groups)
...@@ -1206,21 +1175,11 @@ where ...@@ -1206,21 +1175,11 @@ where
#! com_gencase_defs = {com_gencase_defs & [index] = gencase} #! com_gencase_defs = {com_gencase_defs & [index] = gencase}
= build_module1 module_index (inc index) com_gencase_defs st gs = build_module1 module_index (inc index) com_gencase_defs st gs
on_gencase :: on_gencase :: !Index !Index
!Index !GenericCaseDef (![ClassDef], ![MemberDef], !Index, Index) !*GenericState
!Index -> (!GenericCaseDef,(![ClassDef], ![MemberDef], !Index, Index), !*GenericState)
!GenericCaseDef on_gencase module_index index
(![ClassDef], ![MemberDef], !Index, Index) gencase=:{gc_ident,gc_generic, gc_type_cons} st gs=:{gs_modules, gs_td_infos}
!*GenericState
-> ( !GenericCaseDef
, (![ClassDef], ![MemberDef], !Index, Index)
, !*GenericState
)
on_gencase
module_index index
gencase=:{gc_ident,gc_generic, gc_type_cons}
st
gs=:{gs_modules, gs_td_infos}
#! (gen_def, gs_modules) = gs_modules ! [gc_generic.gi_module].com_generic_defs.[gc_generic.gi_index] #! (gen_def, gs_modules) = gs_modules ! [gc_generic.gi_module].com_generic_defs.[gc_generic.gi_index]
#! (kind, gs_td_infos) = get_kind_of_type_cons gc_type_cons gs_td_infos #! (kind, gs_td_infos) = get_kind_of_type_cons gc_type_cons gs_td_infos
...@@ -1442,11 +1401,9 @@ where ...@@ -1442,11 +1401,9 @@ where
#! {pds_module, pds_def} = gs_predefs . [PD_GenericInfo] #! {pds_module, pds_def} = gs_predefs . [PD_GenericInfo]
#! pds_ident = predefined_idents . [PD_GenericInfo] #! pds_ident = predefined_idents . [PD_GenericInfo]
#! type_symb = MakeTypeSymbIdent { glob_module = pds_module, glob_object = pds_def } pds_ident 0 #! type_symb = MakeTypeSymbIdent { glob_module = pds_module, glob_object = pds_def } pds_ident 0
#! st = #! st = { st & st_args = [ makeAType (TA type_symb []) TA_Multi : st_args]
{ st
& st_args = [ makeAType (TA type_symb []) TA_Multi : st_args]
, st_arity = st_arity + 1 , st_arity = st_arity + 1
, st_args_strictness = insert_n_strictness_values_at_beginning 1 st_args_strictness , st_args_strictness = insert_n_lazy_values_at_beginning 1 st_args_strictness
} }
= (st, {th & th_vars = th_vars }) = (st, {th & th_vars = th_vars })
...@@ -1958,7 +1915,6 @@ where ...@@ -1958,7 +1915,6 @@ where
fresh_symbol_type st heaps=:{hp_type_heaps} fresh_symbol_type st heaps=:{hp_type_heaps}
# (fresh_st, hp_type_heaps) = freshSymbolType st hp_type_heaps # (fresh_st, hp_type_heaps) = freshSymbolType st hp_type_heaps
= (fresh_st, {heaps & hp_type_heaps = hp_type_heaps}) = (fresh_st, {heaps & hp_type_heaps = hp_type_heaps})
//---> ("fresh_symbol_type")
buildGenericCaseBody :: buildGenericCaseBody ::
!Index // current icl module !Index // current icl module
...@@ -2056,8 +2012,7 @@ where ...@@ -2056,8 +2012,7 @@ where
= buildRecordSelectionExpr bimap_expr PD_map_from 1 predefs = buildRecordSelectionExpr bimap_expr PD_map_from 1 predefs
= (adaptor_expr, (modules, td_infos, heaps, error)) = (adaptor_expr, (modules, td_infos, heaps, error))
where where
{pds_module = bimap_module, pds_def=bimap_index} {pds_module = bimap_module, pds_def=bimap_index} = predefs.[PD_GenericBimap]
= predefs.[PD_GenericBimap]
bimap_ident = predefined_idents.[PD_GenericBimap] bimap_ident = predefined_idents.[PD_GenericBimap]
get_var_kinds gen_info_ptr heaps=:{hp_generic_heap} get_var_kinds gen_info_ptr heaps=:{hp_generic_heap}
...@@ -2109,7 +2064,6 @@ where ...@@ -2109,7 +2064,6 @@ where
build_body_expr adaptor_expr specialized_expr original_arg_exprs build_body_expr adaptor_expr specialized_expr original_arg_exprs
= (adaptor_expr @ [specialized_expr]) @ original_arg_exprs = (adaptor_expr @ [specialized_expr]) @ original_arg_exprs
//buildGenericCaseBody main_module_index {gc_ident,gc_pos, gc_generic, gc_type_cons=TypeConsSymb {type_index}} st predefs td_infos modules heaps error //buildGenericCaseBody main_module_index {gc_ident,gc_pos, gc_generic, gc_type_cons=TypeConsSymb {type_index}} st predefs td_infos modules heaps error
buildGenericCaseBody main_module_index {gc_ident,gc_pos} st predefs td_infos modules heaps error buildGenericCaseBody main_module_index {gc_ident,gc_pos} st predefs td_infos modules heaps error
# error = reportError gc_ident gc_pos "cannot specialize to this type" error # error = reportError gc_ident gc_pos "cannot specialize to this type" 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