Commit b7a59339 authored by Martin Wierich's avatar Martin Wierich
Browse files

lots of changes in module trans to make fusion work.

parent edc0429e
......@@ -596,6 +596,7 @@ where
, ef_member_defs :: !.{# MemberDef}
, ef_class_defs :: !.{# ClassDef}
, ef_modules :: !.{# DclModule}
, ef_is_macro_fun :: !Bool
}
:: ExpressionState =
......@@ -2048,7 +2049,7 @@ where
checkFunction :: !Index !Index !Level !*{#FunDef} !*ExpressionInfo !*Heaps !*CheckState -> (!*{#FunDef},!*ExpressionInfo, !*Heaps, !*CheckState);
checkFunction mod_index fun_index def_level fun_defs
e_info=:{ef_type_defs,ef_modules,ef_class_defs} heaps=:{hp_var_heap,hp_expression_heap,hp_type_heaps} cs=:{cs_error}
e_info=:{ef_type_defs,ef_modules,ef_class_defs,ef_is_macro_fun} heaps=:{hp_var_heap,hp_expression_heap,hp_type_heaps} cs=:{cs_error}
#! fun_def = fun_defs.[fun_index]
# {fun_symb,fun_pos,fun_body,fun_type} = fun_def
position = newPosition fun_symb fun_pos
......@@ -2065,7 +2066,8 @@ checkFunction mod_index fun_index def_level fun_defs
(ef_type_defs, ef_modules, es_type_heaps, es_expression_heap, cs) =
checkDynamicTypes mod_index es_dynamics fun_type e_info.ef_type_defs e_info.ef_modules es_type_heaps es_expression_heap cs
cs = { cs & cs_error = popErrorAdmin cs.cs_error }
fun_info = { fun_def.fun_info & fi_calls = es_calls, fi_def_level = def_level, fi_free_vars = free_vars, fi_dynamics = es_dynamics }
fun_info = { fun_def.fun_info & fi_calls = es_calls, fi_def_level = def_level, fi_free_vars = free_vars, fi_dynamics = es_dynamics,
fi_is_macro_fun = ef_is_macro_fun }
fun_defs = { es_fun_defs & [fun_index] = { fun_def & fun_body = fun_body, fun_index = fun_index, fun_info = fun_info, fun_type = fun_type}}
(fun_defs, cs_symbol_table) = remove_calls_from_symbol_table fun_index def_level es_calls fun_defs cs.cs_symbol_table
= (fun_defs,
......@@ -2106,9 +2108,10 @@ checkFunctions mod_index level from_index to_index fun_defs e_info heaps cs
checkMacros :: !Index !IndexRange !*{#FunDef} !*ExpressionInfo !*Heaps !*CheckState
-> (!*{#FunDef}, !*ExpressionInfo, !*Heaps, !*CheckState);
checkMacros mod_index range fun_defs e_info heaps cs
# (fun_defs, e_info=:{ef_modules}, heaps=:{hp_var_heap, hp_expression_heap}, cs=:{cs_symbol_table,cs_error})
= checkFunctions mod_index cGlobalScope range.ir_from range.ir_to fun_defs e_info heaps cs
checkMacros mod_index range fun_defs e_info=:{ef_is_macro_fun=ef_is_macro_fun_old} heaps cs
# (fun_defs, e_info, heaps=:{hp_var_heap, hp_expression_heap}, cs=:{cs_symbol_table,cs_error})
= checkFunctions mod_index cGlobalScope range.ir_from range.ir_to fun_defs { e_info & ef_is_macro_fun=True } heaps cs
(e_info=:{ef_modules}) = { e_info & ef_is_macro_fun=ef_is_macro_fun_old }
(fun_defs, ef_modules, hp_var_heap, hp_expression_heap, cs_symbol_table, cs_error)
= partitionateMacros range mod_index fun_defs ef_modules hp_var_heap hp_expression_heap cs_symbol_table cs_error
= (fun_defs, { e_info & ef_modules = ef_modules }, {heaps & hp_var_heap = hp_var_heap, hp_expression_heap = hp_expression_heap},
......@@ -2375,7 +2378,8 @@ checkModule {mod_type,mod_name,mod_imports,mod_imported_objects,mod_defs = cdefs
heaps = { heaps & hp_type_heaps = hp_type_heaps, hp_var_heap = hp_var_heap }
e_info = { ef_type_defs = icl_common.com_type_defs, ef_selector_defs = icl_common.com_selector_defs, ef_class_defs = icl_common.com_class_defs,
ef_cons_defs = icl_common.com_cons_defs, ef_member_defs = icl_common.com_member_defs, ef_modules = dcl_modules }
ef_cons_defs = icl_common.com_cons_defs, ef_member_defs = icl_common.com_member_defs, ef_modules = dcl_modules,
ef_is_macro_fun = False }
(icl_functions, e_info, heaps, cs) = checkMacros cIclModIndex cdefs.def_macros icl_functions e_info heaps cs
(icl_functions, e_info, heaps, cs) = checkFunctions cIclModIndex cGlobalScope 0 nr_of_global_funs icl_functions e_info heaps cs
......@@ -2791,7 +2795,8 @@ checkDclModule {mod_name,mod_imports,mod_defs} mod_index modules icl_functions h
reverse rev_special_defs) }
e_info = { ef_type_defs = com_type_defs, ef_selector_defs = dcl_common.com_selector_defs, ef_class_defs = com_class_defs,
ef_cons_defs = dcl_common.com_cons_defs, ef_member_defs = dcl_common.com_member_defs, ef_modules = modules }
ef_cons_defs = dcl_common.com_cons_defs, ef_member_defs = dcl_common.com_member_defs, ef_modules = modules,
ef_is_macro_fun = False }
(icl_functions, e_info, heaps, cs)
= checkMacros mod_index dcl_macros icl_functions e_info heaps { cs & cs_error = cs_error }
......
......@@ -268,7 +268,7 @@ newFunction opt_id fun_bodies arg_types result_type group_index (ci_next_fun_nr,
= ({ symb_name = fun_id, symb_kind = SK_GeneratedFunction fun_def_ptr ci_next_fun_nr, symb_arity = arity },
(inc ci_next_fun_nr, [fun_def_ptr : ci_new_functions],
ci_fun_heap <:= (fun_def_ptr, FI_Function { gf_fun_def = fun_def, gf_instance_info = II_Empty,
gf_fun_index = ci_next_fun_nr, gf_cons_args = {cc_args = [], cc_size=0} })))
gf_fun_index = ci_next_fun_nr, gf_cons_args = {cc_size=0, cc_args = [], cc_linear_bits = []} })))
consOptional (Yes x) xs = [x : xs]
......
......@@ -3,6 +3,8 @@ module main
import scanner, parse, postparse, check, type, trans, convertcases, utilities, convertDynamics
import StdEnv
// XXX
import RWSDebug
Start world
# (std_io, world) = stdio world
......@@ -16,6 +18,15 @@ Start world
(ms.ms_out, ms.ms_files))) world
= fclose ms_out world
CommandLoop proj ms=:{ms_io}
# answer = "c Menu0"
(command, argument) = SplitAtLayoutChar (dropWhile isSpace (fromString answer))
| command == []
= CommandLoop proj { ms & ms_io = ms_io}
# (ready, proj, ms) = DoCommand command argument proj { ms & ms_io = ms_io}
= ms
/*
CommandLoop proj ms=:{ms_io}
# (answer, ms_io) = freadline (ms_io <<< "> ")
(command, argument) = SplitAtLayoutChar (dropWhile isSpace (fromString answer))
......@@ -25,6 +36,7 @@ CommandLoop proj ms=:{ms_io}
| ready
= ms
= CommandLoop proj ms
*/
:: MainStateDefs funs funtypes types conses classes instances members selectors =
{ msd_funs :: !funs
......@@ -165,9 +177,10 @@ loadModule mod_ident predef_symbols hash_table ms=:{ms_files,ms_error,ms_io,ms_o
# (components, fun_defs) = partitionateFunctions (fun_defs ---> "partitionateFunctions") [ { ir_from = 0, ir_to = nr_of_global_funs }, icl_instances, icl_specials]
(components, fun_defs, ms_io) = showTypes components 0 fun_defs ms_io
// (components, fun_defs, ms_out) = showComponents components 0 True fun_defs ms_out
(acc_args, components, fun_defs, var_heap) = analyseGroups (components ---> "Transform") fun_defs heaps.hp_var_heap
(components, fun_defs, dcl_types, used_conses, var_heap, type_heaps, expression_heap)
= transformGroups components fun_defs acc_args common_defs imported_funs var_heap heaps.hp_type_heaps heaps.hp_expression_heap
(cleanup_info, acc_args, components, fun_defs, var_heap, expression_heap)
= analyseGroups (components ---> "Transform") fun_defs heaps.hp_var_heap heaps.hp_expression_heap
# (components, fun_defs, dcl_types, used_conses, var_heap, type_heaps, expression_heap)
= transformGroups cleanup_info components fun_defs acc_args common_defs imported_funs var_heap heaps.hp_type_heaps expression_heap
// (components, fun_defs, ms_error) = showComponents components 0 True fun_defs ms_error
(dcl_types, used_conses, var_heap, type_heaps) = convertIclModule common_defs dcl_types used_conses var_heap type_heaps
(dcl_types, used_conses, var_heap, type_heaps) = convertDclModule dcl_mods common_defs dcl_types used_conses var_heap type_heaps
......
......@@ -392,6 +392,7 @@ cIsNonCoercible :== 2
, fi_free_vars :: ![FreeVar]
, fi_local_vars :: ![FreeVar]
, fi_dynamics :: ![ExprInfoPtr]
, fi_is_macro_fun :: !Bool // whether the function is a local function of a macro
}
:: ParsedBody =
......@@ -417,7 +418,7 @@ cIsNonCoercible :== 2
| RhsMacroBody !CheckedBody
/* macro expansion transforms a CheckedBody into a TransformedBody */
| TransformedBody !TransformedBody
| Expanding
| Expanding ![FreeVar] // the parameters of the newly generated function
| BackendBody ![BackendBody]
:: BackendBody =
......@@ -443,8 +444,9 @@ cIsAGlobalVar :== True
cIsALocalVar :== False
:: ConsClasses =
{ cc_size ::!Int
, cc_args ::![ConsClass]
{ cc_size ::!Int
, cc_args ::![ConsClass] // the lists have the
, cc_linear_bits ::![Bool] // same length
}
:: ConsClass :== Int
......@@ -462,10 +464,10 @@ cIsALocalVar :== False
:: AP_Kind = APK_Constructor !Index | APK_Macro
:: VarInfo = VI_Empty | VI_Type !AType | VI_Occurrence !Occurrence | VI_UsedVar (!Ident, ![Int]) |
:: VarInfo = VI_Empty | VI_Type !AType | VI_Occurrence !Occurrence | VI_UsedVar !Ident |
VI_Expression !Expression | VI_Variable !Ident !VarInfoPtr | VI_LiftedVariable !VarInfoPtr |
VI_Count !Int /* the reference count of a variable */ !Bool /* true if the variable is global, false otherwise */ |
VI_AccVar !ConsClass /* used during fusion to determine accumulating parameters of functions */ |
VI_AccVar !ConsClass !ArgumentPosition /* used during fusion to determine accumulating parameters of functions */ |
VI_Alias !BoundVar /* used for resolving aliases just before type checking (in transform) */ |
/* used during elimination and lifting of cases */
VI_FreeVar !Ident !VarInfoPtr !Int !AType | VI_BoundVar !AType | VI_LocalVar |
......@@ -478,6 +480,8 @@ cIsALocalVar :== False
VI_Pattern !AuxiliaryPattern |
VI_Default !Int /* used during conversion of dynamics; the Int indiacted the refenrence count */
:: ArgumentPosition :== Int
:: VarInfoPtr :== Ptr VarInfo
:: LetVarInfo =
......@@ -562,10 +566,10 @@ cNonRecursiveAppl :== False
:: FunctionInfo = FI_Empty | FI_Function !GeneratedFunction
:: Producer = PR_Empty
| PR_Function !SymbIdent !Index
| PR_Function !SymbIdent !Index !Int // Int: number of actual arguments in application
| PR_Class !App ![BoundVar] ![Type]
// | PR_Constructor !SymbIdent ![Expression]
| PR_GeneratedFunction !SymbIdent !Index
| PR_GeneratedFunction !SymbIdent !Index !Int // Int: number of actual arguments in application
:: InstanceInfo = II_Empty | II_Node !{! Producer} !FunctionInfoPtr !InstanceInfo !InstanceInfo
......@@ -634,6 +638,21 @@ cNonRecursiveAppl :== False
| EI_Default !Expression !AType !ExprInfoPtr
| EI_DefaultFunction !SymbIdent ![Expression]
| EI_Extended ![ExtendedExprInfo] !ExprInfo
:: ExtendedExprInfo
= EEI_ActiveCase !ActiveCaseInfo
:: ActiveCaseInfo =
{ aci_arg_pos :: !Int
, aci_opt_unfolder:: !(Optional SymbIdent)
, aci_free_vars :: !Optional [VarId]
}
:: VarId =
{ v_name :: !Ident
, v_info_ptr :: !VarInfoPtr
}
:: RefCountsInCase =
{ rcc_all_variables :: ![CountedVariable]
......@@ -786,6 +805,7 @@ cNonRecursiveAppl :== False
| TVI_Used /* to administer that this variable is encountered (in checkOpenTypes) */
// | TVI_Clean !Int /* to keep the unique number that has been assigned to this variable during 'clean_up' */
| TVI_TypeCode !TypeCodeExpression
| TVI_FreshTypeVar TypeVar /* auxiliary used during fusion */
:: TypeVarInfoPtr :== Ptr TypeVarInfo
:: TypeVarHeap :== Heap TypeVarInfo
......@@ -1146,7 +1166,7 @@ MakeAttributedType type :== { at_attribute = TA_None, at_annotation = AN_None, a
MakeAttributedTypeVar type_var :== { atv_attribute = TA_None, atv_annotation = AN_None, atv_variable = type_var }
EmptyFunInfo :== { fi_calls = [], fi_group_index = NoIndex, fi_def_level = NotALevel,
fi_free_vars = [], fi_local_vars = [], fi_dynamics = [] }
fi_free_vars = [], fi_local_vars = [], fi_dynamics = [], fi_is_macro_fun=False }
BottomSignClass :== { sc_pos_vect = 0, sc_neg_vect = 0 }
PostiveSignClass :== { sc_pos_vect = bitnot 0, sc_neg_vect = 0 }
......
......@@ -348,6 +348,7 @@ cMayBeNonCoercible :== 4
, fi_free_vars :: ![FreeVar]
, fi_local_vars :: ![FreeVar]
, fi_dynamics :: ![ExprInfoPtr]
, fi_is_macro_fun :: !Bool // whether the function is a local function of a macro
}
:: ParsedBody =
......@@ -373,7 +374,7 @@ cMayBeNonCoercible :== 4
| RhsMacroBody !CheckedBody
/* macro expansion the transforms a CheckedBody into a TransformedBody */
| TransformedBody !TransformedBody
| Expanding
| Expanding ![FreeVar] // the parameters of the newly generated function
| BackendBody ![BackendBody]
:: BackendBody =
......@@ -399,8 +400,9 @@ cIsAGlobalVar :== True
cIsALocalVar :== False
:: ConsClasses =
{ cc_size ::!Int
, cc_args ::![ConsClass]
{ cc_size ::!Int
, cc_args ::![ConsClass] // the lists have the
, cc_linear_bits ::![Bool] // same length
}
:: ConsClass :== Int
......@@ -418,10 +420,10 @@ cIsALocalVar :== False
:: AP_Kind = APK_Constructor !Index | APK_Macro
:: VarInfo = VI_Empty | VI_Type !AType | VI_Occurrence !Occurrence | VI_UsedVar (!Ident, ![Int]) |
:: VarInfo = VI_Empty | VI_Type !AType | VI_Occurrence !Occurrence | VI_UsedVar !Ident |
VI_Expression !Expression | VI_Variable !Ident !VarInfoPtr | VI_LiftedVariable !VarInfoPtr |
VI_Count !Int /* the reference count of a variable */ !Bool /* true if the variable is global, false otherwise */ |
VI_AccVar !ConsClass /* used during fusion to determine accumulating parameters of functions */ |
VI_AccVar !ConsClass !ArgumentPosition /* used during fusion to determine accumulating parameters of functions */ |
VI_Alias !BoundVar /* used for resolving aliases just before type checking (in transform) */ |
/* used during elimination and lifting of cases */
VI_FreeVar !Ident !VarInfoPtr !Int !AType | VI_BoundVar !AType | VI_LocalVar |
......@@ -434,6 +436,8 @@ cIsALocalVar :== False
VI_Pattern !AuxiliaryPattern |
VI_Default !Int /* used during conversion of dynamics; the Int indiacted the refenrence count */
:: ArgumentPosition :== Int
:: VarInfoPtr :== Ptr VarInfo
:: LetVarInfo =
......@@ -508,10 +512,10 @@ cNotVarNumber :== -1
:: FunctionInfo = FI_Empty | FI_Function !GeneratedFunction
:: Producer = PR_Empty
| PR_Function !SymbIdent !Index
| PR_Function !SymbIdent !Index !Int // Int: number of actual arguments in application
| PR_Class !App ![BoundVar] ![Type]
// | PR_Constructor !SymbIdent ![Expression]
| PR_GeneratedFunction !SymbIdent !Index
| PR_GeneratedFunction !SymbIdent !Index !Int // Int: number of actual arguments in application
:: InstanceInfo = II_Empty | II_Node !{! Producer} !FunctionInfoPtr !InstanceInfo !InstanceInfo
......@@ -581,6 +585,21 @@ cNotVarNumber :== -1
| EI_Default !Expression !AType !ExprInfoPtr
| EI_DefaultFunction !SymbIdent ![Expression]
| EI_Extended ![ExtendedExprInfo] !ExprInfo
:: ExtendedExprInfo
= EEI_ActiveCase !ActiveCaseInfo
:: ActiveCaseInfo =
{ aci_arg_pos :: !Int
, aci_opt_unfolder:: !(Optional SymbIdent)
, aci_free_vars :: !Optional [VarId]
}
:: VarId =
{ v_name :: !Ident
, v_info_ptr :: !VarInfoPtr
}
:: RefCountsInCase =
{ rcc_all_variables :: ![CountedVariable]
......@@ -725,6 +744,7 @@ cNotVarNumber :== -1
| TVI_CorrespondenceNumber !Int
| TVI_Used /* to adminster that this variable is encountered (in checkOpenTypes) */
| TVI_TypeCode !TypeCodeExpression
| TVI_FreshTypeVar TypeVar /* auxiliary used during fusion */
:: TypeVarInfoPtr :== Ptr TypeVarInfo
:: TypeVarHeap :== Heap TypeVarInfo
......@@ -1728,7 +1748,7 @@ MakeAttributedType type :== { at_attribute = TA_None, at_annotation = AN_None, a
MakeAttributedTypeVar type_var :== { atv_attribute = TA_None, atv_annotation = AN_None, atv_variable = type_var }
EmptyFunInfo :== { fi_calls = [], fi_group_index = NoIndex, fi_def_level = NotALevel,
fi_free_vars = [], fi_local_vars = [], fi_dynamics = [] }
fi_free_vars = [], fi_local_vars = [], fi_dynamics = [], fi_is_macro_fun=False }
BottomSignClass :== { sc_pos_vect = 0, sc_neg_vect = 0 }
PostiveSignClass :== { sc_pos_vect = bitnot 0, sc_neg_vect = 0 }
......
......@@ -8,9 +8,12 @@ cPassive :== -1
cActive :== -2
cAccumulating :== -3
analyseGroups :: !*{! Group} !*{#FunDef} !*VarHeap -> (!*{! ConsClasses}, !*{! Group}, !*{#FunDef}, !*VarHeap)
:: CleanupInfo
transformGroups :: !*{! Group} !*{#FunDef} !{!.ConsClasses} !{# CommonDefs} !{# {# FunType} } !*VarHeap !*TypeHeaps !*ExpressionHeap
analyseGroups :: !*{! Group} !*{#FunDef} !*VarHeap !*ExpressionHeap
-> (!CleanupInfo, !*{! ConsClasses}, !*{! Group}, !*{#FunDef}, !*VarHeap, !*ExpressionHeap)
transformGroups :: !CleanupInfo !*{! Group} !*{#FunDef} !{!.ConsClasses} !{# CommonDefs} !{# {# FunType} } !*VarHeap !*TypeHeaps !*ExpressionHeap
-> (!*{! Group}, !*{#FunDef}, !*{#{# CheckedTypeDef}}, !ImportedConstructors, !*VarHeap, !*TypeHeaps, !*ExpressionHeap)
partitionateFunctions :: !*{# FunDef} ![IndexRange] -> (!*{! Group}, !*{# FunDef})
......
This diff is collapsed.
......@@ -15,11 +15,12 @@ partitionateMacros :: !IndexRange !Index !*{# FunDef} !u:{# DclModule} !*VarHeap
:: UnfoldState =
{ us_var_heap :: !.VarHeap
, us_symbol_heap :: !.ExpressionHeap
, us_cleanup_info :: ![ExprInfoPtr]
}
class unfold a :: !a !*UnfoldState -> (!a, !*UnfoldState)
instance unfold Expression//, PatternExpression
instance unfold Expression, CasePatterns
......
......@@ -161,6 +161,7 @@ where
:: UnfoldState =
{ us_var_heap :: !.VarHeap
, us_symbol_heap :: !.ExpressionHeap
, us_cleanup_info :: ![ExprInfoPtr]
}
class unfold a :: !a !*UnfoldState -> (!a, !*UnfoldState)
......@@ -281,12 +282,15 @@ where
instance unfold Case
where
unfold kees=:{ case_expr,case_guards,case_default,case_info_ptr} us
unfold kees=:{ case_expr,case_guards,case_default,case_info_ptr} us=:{us_cleanup_info}
# ((case_expr,(case_guards,case_default)), us) = unfold (case_expr,(case_guards,case_default)) us
(old_case_info, us_symbol_heap) = readPtr case_info_ptr us.us_symbol_heap
(new_info_ptr, us_symbol_heap) = newPtr old_case_info us_symbol_heap
= ({ kees & case_expr = case_expr,case_guards = case_guards, case_default = case_default, case_info_ptr = new_info_ptr},
{ us & us_symbol_heap = us_symbol_heap })
us_cleanup_info = case old_case_info of
EI_Extended _ _ -> [new_info_ptr:us_cleanup_info]
_ -> us_cleanup_info
= ({ kees & case_expr = case_expr,case_guards = case_guards, case_default = case_default, case_info_ptr = new_info_ptr},
{ us & us_symbol_heap = us_symbol_heap, us_cleanup_info=us_cleanup_info })
instance unfold Let
where
......@@ -360,7 +364,7 @@ examineFunctionCall {id_info} fc=:{fc_index} (calls, symbol_table)
//unfoldMacro :: !FunDef ![Expression] !*ExpandInfo -> (!Expression, !*ExpandInfo)
unfoldMacro {fun_body = TransformedBody {tb_args,tb_rhs}, fun_info = {fi_calls}} args fun_defs (calls, es=:{es_var_heap,es_symbol_heap, es_symbol_table})
# (let_binds, var_heap) = bind_expressions tb_args args [] es_var_heap
(result_expr, {us_symbol_heap,us_var_heap}) = unfold tb_rhs { us_symbol_heap = es_symbol_heap, us_var_heap = var_heap }
(result_expr, {us_symbol_heap,us_var_heap}) = unfold tb_rhs { us_symbol_heap = es_symbol_heap, us_var_heap = var_heap, us_cleanup_info=[] }
(calls, fun_defs, es_symbol_table) = updateFunctionCalls fi_calls calls fun_defs es_symbol_table
| isEmpty let_binds
= (result_expr, fun_defs, (calls, { es & es_var_heap = us_var_heap, es_symbol_heap = us_symbol_heap, es_symbol_table = es_symbol_table }))
......@@ -721,7 +725,7 @@ where
replace_variables [] expr ap_vars var_heap symbol_heap
= (expr, var_heap, symbol_heap)
replace_variables vars expr ap_vars var_heap symbol_heap
# (expr, us) = unfold expr { us_var_heap = build_aliases vars ap_vars var_heap, us_symbol_heap = symbol_heap }
# (expr, us) = unfold expr { us_var_heap = build_aliases vars ap_vars var_heap, us_symbol_heap = symbol_heap, us_cleanup_info=[] }
= (expr, us.us_var_heap, us.us_symbol_heap)
build_aliases [var1 : vars1] [ {fv_name,fv_info_ptr} : vars2 ] var_heap
......
......@@ -4,6 +4,9 @@ import checksupport, StdCompare
from unitype import Coercions, CoercionTree, AttributePartition
do_fusion :== False
// MW: this switch is used to en(dis)able the fusion algorithm which currently isn't ready
errorHeading :: !String !*ErrorAdmin -> *ErrorAdmin
class (<::) infixl a :: !*File (!Format, !a) -> *File
......
......@@ -3,6 +3,9 @@ implementation module typesupport
import StdEnv, StdCompare
import syntax, parse, check, unitype, utilities, RWSDebug
do_fusion :== False
// MW: this switch is used to en(dis)able the fusion algorithm which currently isn't ready
:: Store :== Int
:: AttrCoercion =
......@@ -341,9 +344,18 @@ where
instance substitute TypeAttribute
where
substitute (TA_Var {av_name, av_info_ptr}) heaps=:{th_attrs}
/* MW: was:
#! av_info = sreadPtr av_info_ptr th_attrs
# (AVI_Attr attr) = av_info
= (attr, heaps)
*/
// XXX this alternative's code can be replaced with the original again, when the fusion algorithm becomes able to
// infer correct type attributes
#! av_info = sreadPtr av_info_ptr th_attrs
= case av_info of
(AVI_Attr attr) -> (attr, heaps)
_ | do_fusion -> (TA_Multi, heaps)
-> abort "compiler bug nr 7689 in module typesupport"
substitute TA_None heaps
= (TA_Multi, heaps)
substitute attr heaps
......
// BLABLABLA
implementation module unitype
import StdEnv
......
......@@ -62,9 +62,9 @@ where
fold_st2 [] [] st
= st
fold_st2 [] ys st
= abort ("fold_st2: second argument list contains more elements" ---> ys)
= abort ("fold_st2: second argument list contains more elements")
fold_st2 xs [] st
= abort ("fold_st2: first argument list contains more elements" ---> xs)
= abort ("fold_st2: first argument list contains more elements")
// foldSt :: !(.a -> .(.st -> .st)) ![.a] !.st -> .st
foldSt op l st :== fold_st l st
......
......@@ -148,9 +148,9 @@ where
fold_st2 [] [] st
= st
fold_st2 [] ys st
= abort ("fold_st2: second argument list contains more elements" ---> ys)
= abort ("fold_st2: second argument list contains more elements")
fold_st2 xs [] st
= abort ("fold_st2: first argument list contains more elements" ---> xs)
= abort ("fold_st2: first argument list contains more elements")
// foldSt :: !(.a -> .(.st -> .st)) ![.a] !.st -> .st
foldSt op r l :== fold_st r l
......
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