Commit 91f39a06 authored by Diederik van Arkel's avatar Diederik van Arkel
Browse files

add strictness annotations

parent b214320a
...@@ -437,6 +437,7 @@ instance consumerRequirements Case where ...@@ -437,6 +437,7 @@ instance consumerRequirements Case where
_ -> False _ -> False
// use_context_default = not (case_explicit || has_default) // use_context_default = not (case_explicit || has_default)
combine_counts :: !Int !*{#Int} !{#Int} -> *{#Int}
combine_counts 0 accu env combine_counts 0 accu env
= accu = accu
combine_counts i accu env combine_counts i accu env
...@@ -446,10 +447,12 @@ instance consumerRequirements Case where ...@@ -446,10 +447,12 @@ instance consumerRequirements Case where
accu = { accu & [i1] = unify_counts rca rce } accu = { accu & [i1] = unify_counts rca rce }
= combine_counts i1 accu env = combine_counts i1 accu env
where where
unify_counts :: !Int !Int -> Int
unify_counts 0 x = x unify_counts 0 x = x
unify_counts 1 x = if (x==2) 2 (inc x) unify_counts 1 x = if (x==2) 2 (inc x)
unify_counts 2 x = 2 unify_counts 2 x = 2
inspect_patterns :: !{#.CommonDefs} !.Bool !.CasePatterns ![.Bool] -> (!.Bool,!Bool)
inspect_patterns common_defs has_default (AlgebraicPatterns {glob_object, glob_module} algebraic_patterns) unsafe_bits inspect_patterns common_defs has_default (AlgebraicPatterns {glob_object, glob_module} algebraic_patterns) unsafe_bits
# type_def = common_defs.[glob_module].com_type_defs.[glob_object] # type_def = common_defs.[glob_module].com_type_defs.[glob_object]
defined_symbols = case type_def.td_rhs of defined_symbols = case type_def.td_rhs of
...@@ -535,6 +538,7 @@ instance consumerRequirements Case where ...@@ -535,6 +538,7 @@ instance consumerRequirements Case where
= True = True
= multimatch_loop has_default (dropWhile (\(ds_index,_,_)->ds_index==cip) constructors_in_pattern) = multimatch_loop has_default (dropWhile (\(ds_index,_,_)->ds_index==cip) constructors_in_pattern)
combine_pattern_counts :: !.Bool !.CasePatterns ![.Bool] ![{#.Int}] !{#Int} -> *{#Int}
combine_pattern_counts has_default patterns unsafe_bits guard_counts default_counts combine_pattern_counts has_default patterns unsafe_bits guard_counts default_counts
| not ok_pattern_type | not ok_pattern_type
= createArray (size default_counts) 2 = createArray (size default_counts) 2
...@@ -575,6 +579,7 @@ where ...@@ -575,6 +579,7 @@ where
count_size = size default_counts count_size = size default_counts
zero_array = createArray count_size 0 zero_array = createArray count_size 0
sort3 :: !.[Int] !.[a] !.[b] -> .[(!Int,!Int,!a,!b)]
sort3 constr_indices unsafe_bits counts sort3 constr_indices unsafe_bits counts
= sortBy smaller (zip4 constr_indices [0..] unsafe_bits counts) = sortBy smaller (zip4 constr_indices [0..] unsafe_bits counts)
where where
...@@ -587,7 +592,7 @@ where ...@@ -587,7 +592,7 @@ where
zip4 _ _ _ _ zip4 _ _ _ _
= [] = []
count_loop :: RefCounts RefCounts [(Int,Int,Bool,RefCounts)] -> *RefCounts count_loop :: !RefCounts !RefCounts ![(!Int,!Int,!Bool,!RefCounts)] -> *RefCounts
count_loop default_counts unified_counts [] count_loop default_counts unified_counts []
= {e \\ e <-: unified_counts} = {e \\ e <-: unified_counts}
count_loop default_counts unified_counts [(c_index,p_index,unsafe,counts):patterns] count_loop default_counts unified_counts [(c_index,p_index,unsafe,counts):patterns]
...@@ -597,7 +602,7 @@ where ...@@ -597,7 +602,7 @@ where
_ -> counts _ -> counts
= count_loop default_counts (unify_counts ccount unified_counts) next = count_loop default_counts (unify_counts ccount unified_counts) next
where where
splitWhile :: (a -> .Bool) !u:[a] -> (.[a],v:[a]), [u <= v]; splitWhile :: !(a -> .Bool) !u:[a] -> (!.[a],!v:[a]), [u <= v];
splitWhile f [] splitWhile f []
= ([],[]) = ([],[])
splitWhile f cons=:[a:x] splitWhile f cons=:[a:x]
...@@ -606,7 +611,7 @@ where ...@@ -606,7 +611,7 @@ where
= ([a:t],d) = ([a:t],d)
= ([],cons) = ([],cons)
count_constructor :: RefCounts RefCounts [(Int,Int,Bool,RefCounts)] -> RefCounts count_constructor :: !RefCounts !RefCounts ![(!Int,!Int,!Bool,!RefCounts)] -> RefCounts
count_constructor default_counts combined_counts [] count_constructor default_counts combined_counts []
= combine_counts combined_counts default_counts = combine_counts combined_counts default_counts
count_constructor default_counts combined_counts [(_,_,unsafe,counts):patterns] count_constructor default_counts combined_counts [(_,_,unsafe,counts):patterns]
...@@ -614,7 +619,7 @@ where ...@@ -614,7 +619,7 @@ where
= count_constructor default_counts (combine_counts combined_counts counts) patterns = count_constructor default_counts (combine_counts combined_counts counts) patterns
= combine_counts combined_counts counts = combine_counts combined_counts counts
combine_counts :: RefCounts RefCounts -> RefCounts combine_counts :: !RefCounts !RefCounts -> RefCounts
combine_counts c1 c2 combine_counts c1 c2
= {unify_counts e1 e2 \\ e1 <-: c1 & e2 <-: c2} = {unify_counts e1 e2 \\ e1 <-: c1 & e2 <-: c2}
where where
...@@ -627,10 +632,12 @@ where ...@@ -627,10 +632,12 @@ where
accu = { accu & [i1] = unify_counts rca rce } accu = { accu & [i1] = unify_counts rca rce }
= combine i1 accu env = combine i1 accu env
unify_counts :: !Int !Int -> Int
unify_counts 0 x = x unify_counts 0 x = x
unify_counts 1 x = if (x==2) 2 (inc x) unify_counts 1 x = if (x==2) 2 (inc x)
unify_counts 2 x = 2 unify_counts 2 x = 2
unify_counts :: !RefCounts !RefCounts -> *RefCounts
unify_counts c1 c2 unify_counts c1 c2
= {unify_counts e1 e2 \\ e1 <-: c1 & e2 <-: c2} = {unify_counts e1 e2 \\ e1 <-: c1 & e2 <-: c2}
where where
...@@ -644,11 +651,13 @@ where ...@@ -644,11 +651,13 @@ where
accu = { accu & [i1] = unify_counts rce rca } accu = { accu & [i1] = unify_counts rce rca }
= unify i1 accu env = unify i1 accu env
unify_counts :: !Int !Int -> Int
unify_counts 0 x = x unify_counts 0 x = x
unify_counts 1 x = if (x==0) 1 x unify_counts 1 x = if (x==0) 1 x
unify_counts 2 x = 2 unify_counts 2 x = 2
//consumer_requirements_of_guards :: !CasePatterns ConsumerAnalysisRO !*AnalyseInfo -> (!Int,.[Bool],!*AnalyseInfo) //consumer_requirements_of_guards :: !CasePatterns ConsumerAnalysisRO !*AnalyseInfo -> (!Int,.[Bool],!*AnalyseInfo)
consumer_requirements_of_guards :: !.CasePatterns !.ConsumerAnalysisRO !*AnalyseInfo -> *(!Int,!.[Bool],![{#Int}],!*AnalyseInfo)
consumer_requirements_of_guards (AlgebraicPatterns type patterns) common_defs ai consumer_requirements_of_guards (AlgebraicPatterns type patterns) common_defs ai
# pattern_exprs # pattern_exprs
= [ ap_expr \\ {ap_expr}<-patterns] = [ ap_expr \\ {ap_expr}<-patterns]
...@@ -686,7 +695,7 @@ bindPatternVars [fv=:{fv_info_ptr,fv_count} : vars] next_var next_var_of_fun var ...@@ -686,7 +695,7 @@ bindPatternVars [fv=:{fv_info_ptr,fv_count} : vars] next_var next_var_of_fun var
bindPatternVars [] next_var next_var_of_fun var_heap bindPatternVars [] next_var next_var_of_fun var_heap
= (next_var, next_var_of_fun, var_heap) = (next_var, next_var_of_fun, var_heap)
independentConsumerRequirements :: !.[Expression] ConsumerAnalysisRO !*AnalyseInfo -> (!ConsClass,.[Bool],[RefCounts],!*AnalyseInfo) independentConsumerRequirements :: !.[Expression] !ConsumerAnalysisRO !*AnalyseInfo -> (!ConsClass,!.[Bool],![RefCounts],!*AnalyseInfo)
independentConsumerRequirements exprs info ai independentConsumerRequirements exprs info ai
# ref_counts = ai.ai_cur_ref_counts # ref_counts = ai.ai_cur_ref_counts
# (count_size,ref_counts) = usize ref_counts # (count_size,ref_counts) = usize ref_counts
...@@ -695,6 +704,7 @@ independentConsumerRequirements exprs info ai ...@@ -695,6 +704,7 @@ independentConsumerRequirements exprs info ai
# (counts,unsafe) = unzip counts_unsafe # (counts,unsafe) = unzip counts_unsafe
= (cc,unsafe,counts,{ ai & ai_cur_ref_counts = ref_counts}) = (cc,unsafe,counts,{ ai & ai_cur_ref_counts = ref_counts})
where where
cons_reqs :: !Expression !*(!.Int,!*AnalyseInfo) -> *(!.(!{#Int},!Bool),!*(!Int,!*AnalyseInfo))
cons_reqs expr (cc,ai) cons_reqs expr (cc,ai)
# (cce, unsafe, ai) = consumerRequirements expr info ai # (cce, unsafe, ai) = consumerRequirements expr info ai
# cc = combineClasses cce cc # cc = combineClasses cce cc
...@@ -1214,17 +1224,19 @@ reanalyseFunction fun fun_info_ptr common_defs imported_funs main_dcl_module_n s ...@@ -1214,17 +1224,19 @@ reanalyseFunction fun fun_info_ptr common_defs imported_funs main_dcl_module_n s
= (fun_cons_class,fun_defs,ai.ai_var_heap,ai.ai_fun_heap,ai_cons_class) = (fun_cons_class,fun_defs,ai.ai_var_heap,ai.ai_fun_heap,ai_cons_class)
fresh_variables :: ![.FreeVar] !Int !Int !*(Heap VarInfo) -> *(!.[Int],!Int,!*(Heap VarInfo))
fresh_variables [{fv_info_ptr} : vars] arg_position next_var_number var_heap fresh_variables [{fv_info_ptr} : vars] arg_position next_var_number var_heap
# var_heap
= writePtr fv_info_ptr (VI_AccVar next_var_number arg_position) var_heap
# (fresh_vars, last_var_number, var_heap) # (fresh_vars, last_var_number, var_heap)
= fresh_variables vars (inc arg_position) (inc next_var_number) var_heap = fresh_variables vars (inc arg_position) (inc next_var_number) var_heap
var_heap
= writePtr fv_info_ptr (VI_AccVar next_var_number arg_position) var_heap
= ([next_var_number : fresh_vars], last_var_number, var_heap) = ([next_var_number : fresh_vars], last_var_number, var_heap)
fresh_variables [] _ next_var_number var_heap fresh_variables [] _ next_var_number var_heap
= ([], next_var_number, var_heap) = ([], next_var_number, var_heap)
// count_locals determines number of local variables... // count_locals determines number of local variables...
count_locals :: !Expression !Int -> Int
count_locals (Var _) n count_locals (Var _) n
= n = n
count_locals (App {app_args}) n count_locals (App {app_args}) n
......
This diff is collapsed.
...@@ -923,8 +923,11 @@ unfoldMacro {fun_body =fun_body=: TransformedBody {tb_args,tb_rhs}, fun_info = { ...@@ -923,8 +923,11 @@ unfoldMacro {fun_body =fun_body=: TransformedBody {tb_args,tb_rhs}, fun_info = {
with with
new_fun_defs :: *{!FunDef} new_fun_defs :: *{!FunDef}
new_fun_defs => {fun_def \\ (_,fun_def)<-new_functions} new_fun_defs => {fun_def \\ (_,fun_def)<-new_functions}
-> ({if (i<size_fun_defs) es_fun_defs.[i] new_fun_defs.[i-size_fun_defs] \\ i<-[0..last_function_index]} // inefficient // -> ({if (i<size_fun_defs) es_fun_defs.[i] new_fun_defs.[i-size_fun_defs] \\ i<-[0..last_function_index]} // inefficient
,[size_fun_defs:es_new_fun_def_numbers]) // ,[size_fun_defs:es_new_fun_def_numbers])
// #! new_fun_defs = arrayConcat es_fun_defs new_fun_defs // leads to backend crash!
# new_fun_defs = arrayConcat es_fun_defs new_fun_defs
-> (new_fun_defs, [size_fun_defs:es_new_fun_def_numbers])
# (calls, fun_defs, es_symbol_table) = updateFunctionCalls fi_calls calls es_fun_defs es_symbol_table # (calls, fun_defs, es_symbol_table) = updateFunctionCalls fi_calls calls es_fun_defs es_symbol_table
| isEmpty let_binds | isEmpty let_binds
= (result_expr, (calls, { es & es_symbol_table = es_symbol_table, es_fun_defs=fun_defs,es_new_fun_def_numbers=es_new_fun_def_numbers })) = (result_expr, (calls, { es & es_symbol_table = es_symbol_table, es_fun_defs=fun_defs,es_new_fun_def_numbers=es_new_fun_def_numbers }))
...@@ -1787,7 +1790,7 @@ where ...@@ -1787,7 +1790,7 @@ where
Dynamic administration is rebuilt. Dynamic administration is rebuilt.
*/ */
class collectVariables a :: !a ![FreeVar] ![DynamicPtr] !*CollectState -> (!a, ![FreeVar],[DynamicPtr],!*CollectState) class collectVariables a :: !a ![FreeVar] ![DynamicPtr] !*CollectState -> (!a, ![FreeVar],![DynamicPtr],!*CollectState)
cContainsACycle :== True cContainsACycle :== True
cContainsNoCycle :== False cContainsNoCycle :== False
...@@ -1807,7 +1810,7 @@ where ...@@ -1807,7 +1810,7 @@ where
# (kase,cos) = if_expression e1 (BasicExpr (BVB True)) e2 cos # (kase,cos) = if_expression e1 (BasicExpr (BVB True)) e2 cos
= (kase, free_vars, dynamics, cos) = (kase, free_vars, dynamics, cos)
where where
if_expression :: Expression Expression Expression *CollectState -> (!Expression,!.CollectState); if_expression :: !Expression !Expression !Expression !*CollectState -> (!Expression,!.CollectState);
if_expression e1 e2 e3 cos if_expression e1 e2 e3 cos
// # (new_info_ptr,symbol_heap) = newPtr EI_Empty cos.cos_symbol_heap // # (new_info_ptr,symbol_heap) = newPtr EI_Empty cos.cos_symbol_heap
# case_type = # case_type =
...@@ -1903,6 +1906,7 @@ where ...@@ -1903,6 +1906,7 @@ where
/* Remove all aliases from the list of lazy 'let'-binds. Add a _dummyForStrictAlias /* Remove all aliases from the list of lazy 'let'-binds. Add a _dummyForStrictAlias
function call for the strict aliases. Be careful with cycles! */ function call for the strict aliases. Be careful with cycles! */
detect_cycles_and_handle_alias_binds :: !.Bool !u:[v:(.a,w:LetBind)] !*CollectState -> (!.Bool,!x:[y:(.a,z:LetBind)],!.CollectState), [u <= x,v <= y,w <= z]
detect_cycles_and_handle_alias_binds is_strict [] cos detect_cycles_and_handle_alias_binds is_strict [] cos
= (cContainsNoCycle, [], cos) = (cContainsNoCycle, [], cos)
// detect_cycles_and_handle_alias_binds is_strict [bind=:{bind_dst={fv_info_ptr}} : binds] cos // detect_cycles_and_handle_alias_binds is_strict [bind=:{bind_dst={fv_info_ptr}} : binds] cos
...@@ -1925,6 +1929,7 @@ where ...@@ -1925,6 +1929,7 @@ where
# (is_cyclic, binds, cos) = detect_cycles_and_handle_alias_binds is_strict binds cos # (is_cyclic, binds, cos) = detect_cycles_and_handle_alias_binds is_strict binds cos
-> (is_cyclic, [(type,bind) : binds], cos) -> (is_cyclic, [(type,bind) : binds], cos)
where where
is_cyclic :: !.(Ptr VarInfo) !(Ptr VarInfo) !(Heap VarInfo) -> .Bool
is_cyclic orig_info_ptr info_ptr var_heap is_cyclic orig_info_ptr info_ptr var_heap
| orig_info_ptr == info_ptr | orig_info_ptr == info_ptr
= True = True
...@@ -1935,6 +1940,7 @@ where ...@@ -1935,6 +1940,7 @@ where
_ _
-> False -> False
add_dummy_id_for_strict_alias :: !.Expression !*CollectState -> (!.Expression,!.CollectState)
add_dummy_id_for_strict_alias bind_src cos=:{cos_symbol_heap, cos_predef_symbols_for_transform} add_dummy_id_for_strict_alias bind_src cos=:{cos_symbol_heap, cos_predef_symbols_for_transform}
# (new_app_info_ptr, cos_symbol_heap) = newPtr EI_Empty cos_symbol_heap # (new_app_info_ptr, cos_symbol_heap) = newPtr EI_Empty cos_symbol_heap
{pds_module, pds_def} = cos_predef_symbols_for_transform.predef_alias_dummy {pds_module, pds_def} = cos_predef_symbols_for_transform.predef_alias_dummy
...@@ -1948,12 +1954,14 @@ where ...@@ -1948,12 +1954,14 @@ where
by examining the reference count. by examining the reference count.
*/ */
collect_variables_in_binds :: ![(.a,.b,.LetBind)] !u:[v:(.a,.b,w:LetBind)] ![FreeVar] ![(Ptr ExprInfo)] !*CollectState -> (!x:[y:(.a,.b,z:LetBind)],![FreeVar],![(Ptr ExprInfo)],!.CollectState), [u <= x,v <= y,w <= z]
collect_variables_in_binds binds collected_binds free_vars dynamics cos collect_variables_in_binds binds collected_binds free_vars dynamics cos
# (continue, binds, collected_binds, free_vars, dynamics, cos) = examine_reachable_binds False binds collected_binds free_vars dynamics cos # (continue, binds, collected_binds, free_vars, dynamics, cos) = examine_reachable_binds False binds collected_binds free_vars dynamics cos
| continue | continue
= collect_variables_in_binds binds collected_binds free_vars dynamics cos = collect_variables_in_binds binds collected_binds free_vars dynamics cos
= (collected_binds, free_vars, dynamics, cos) = (collected_binds, free_vars, dynamics, cos)
examine_reachable_binds :: !u:Bool ![v:(.a,.b,w:LetBind)] !x:[y:(.a,.b,z:LetBind)] ![.FreeVar] ![.(Ptr ExprInfo)] !*CollectState -> *(!u0:Bool,![v0:(.a,.b,w0:LetBind)],!x0:[y0:(.a,.b,z0:LetBind)],![FreeVar],![(Ptr ExprInfo)],!*CollectState), [u <= u0,v <= v0,w <= w0,x <= x0,y <= y0,z <= z0]
examine_reachable_binds bind_found [bind=:(is_strict, type, letb=:{lb_dst=fv=:{fv_info_ptr},lb_src}) : binds] collected_binds free_vars dynamics cos examine_reachable_binds bind_found [bind=:(is_strict, type, letb=:{lb_dst=fv=:{fv_info_ptr},lb_src}) : binds] collected_binds free_vars dynamics cos
# (bind_found, binds, collected_binds, free_vars, dynamics, cos) = examine_reachable_binds bind_found binds collected_binds free_vars dynamics cos # (bind_found, binds, collected_binds, free_vars, dynamics, cos) = examine_reachable_binds bind_found binds collected_binds free_vars dynamics cos
# (VI_Count count is_global, cos_var_heap) = readPtr fv_info_ptr cos.cos_var_heap # (VI_Count count is_global, cos_var_heap) = readPtr fv_info_ptr cos.cos_var_heap
......
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