Commit 9ae64839 authored by John van Groningen's avatar John van Groningen
Browse files

added code for OverloadedListPatterns

parent dec3d9c8
......@@ -243,7 +243,9 @@ weightedRefCountOfCase rci=:{rci_depth} this_case=:{case_expr, case_guards, case
rs=:{ rcs_var_heap, rcs_expr_heap, rcs_imports }
# (local_vars, vars_and_heaps) = weighted_ref_count_in_case_patterns {rci & rci_depth=rci_depth+1} case_guards rcs_imports rcs_var_heap rcs_expr_heap
(default_vars, (all_vars, rcs_imports, var_heap, expr_heap)) = weighted_ref_count_in_default {rci & rci_depth=rci_depth+1} case_default vars_and_heaps
rs = weightedRefCount rci case_expr { rs & rcs_var_heap = var_heap, rcs_expr_heap = expr_heap, rcs_imports = rcs_imports }
rs = { rs & rcs_var_heap = var_heap, rcs_expr_heap = expr_heap, rcs_imports = rcs_imports }
rs = weighted_ref_count_of_decons_expr rci case_guards rs
rs = weightedRefCount rci case_expr rs
(rcs_free_vars, rcs_var_heap) = foldSt (addPatternVariable rci_depth) all_vars (rs.rcs_free_vars, rs.rcs_var_heap)
rcs_expr_heap = rs.rcs_expr_heap <:= (case_info_ptr, EI_CaseTypeAndRefCounts case_type
{ rcc_all_variables = all_vars, rcc_default_variables = default_vars, rcc_pattern_variables = local_vars })
......@@ -257,28 +259,34 @@ weightedRefCountOfCase rci=:{rci_depth} this_case=:{case_expr, case_guards, case
weighted_ref_count_in_case_patterns rci (AlgebraicPatterns type patterns) collected_imports var_heap expr_heap
= mapSt (weighted_ref_count_in_algebraic_pattern rci) patterns ([], collected_imports, var_heap, expr_heap)
where
weighted_ref_count_in_algebraic_pattern rci=:{rci_imported} {ap_expr,ap_symbol} wrcs_state
# (free_vars_with_rc, (all_free_vars, collected_imports, var_heap, expr_heap))
= weightedRefCountInPatternExpr rci ap_expr wrcs_state
(collected_imports, var_heap)
= check_symbol rci_imported ap_symbol collected_imports var_heap
= (free_vars_with_rc, (all_free_vars, collected_imports, var_heap, expr_heap))
where
check_symbol {cii_main_dcl_module_n, cii_common_defs} {glob_module, glob_object={ds_index}} collected_imports var_heap
| glob_module <> cii_main_dcl_module_n
# {cons_type_ptr} = cii_common_defs.[glob_module].com_cons_defs.[ds_index]
(collected_imports, var_heap) = checkImportedSymbol (SK_Constructor {glob_module = glob_module, glob_object = ds_index})
cons_type_ptr (collected_imports, var_heap)
= (collected_imports, var_heap)
// otherwise
= (collected_imports, var_heap)
weighted_ref_count_in_case_patterns rci (BasicPatterns type patterns) collected_imports var_heap expr_heap
= mapSt (\{bp_expr} -> weightedRefCountInPatternExpr rci bp_expr) patterns ([], collected_imports, var_heap, expr_heap)
weighted_ref_count_in_case_patterns rci (OverloadedListPatterns type _ patterns) collected_imports var_heap expr_heap
= mapSt (weighted_ref_count_in_algebraic_pattern rci) patterns ([], collected_imports, var_heap, expr_heap)
weighted_ref_count_in_case_patterns rci (DynamicPatterns patterns) collected_imports var_heap expr_heap
= mapSt (\{dp_rhs} -> weightedRefCountInPatternExpr rci dp_rhs) patterns ([], collected_imports, var_heap, expr_heap)
weighted_ref_count_in_algebraic_pattern rci=:{rci_imported} {ap_expr,ap_symbol} wrcs_state
# (free_vars_with_rc, (all_free_vars, collected_imports, var_heap, expr_heap))
= weightedRefCountInPatternExpr rci ap_expr wrcs_state
(collected_imports, var_heap)
= check_symbol rci_imported ap_symbol collected_imports var_heap
= (free_vars_with_rc, (all_free_vars, collected_imports, var_heap, expr_heap))
where
check_symbol {cii_main_dcl_module_n, cii_common_defs} {glob_module, glob_object={ds_index}} collected_imports var_heap
| glob_module <> cii_main_dcl_module_n
# {cons_type_ptr} = cii_common_defs.[glob_module].com_cons_defs.[ds_index]
(collected_imports, var_heap) = checkImportedSymbol (SK_Constructor {glob_module = glob_module, glob_object = ds_index})
cons_type_ptr (collected_imports, var_heap)
= (collected_imports, var_heap)
// otherwise
= (collected_imports, var_heap)
weighted_ref_count_of_decons_expr rci (OverloadedListPatterns _ decons_exp _) rs
= weightedRefCount rci decons_exp rs;
weighted_ref_count_of_decons_expr rci case_guards rs
= rs;
weightedRefCountOfCase rci=:{rci_depth} this_case=:{case_expr, case_guards, case_default, case_info_ptr} (EI_CaseTypeAndRefCounts case_type {rcc_all_variables})
rs=:{ rcs_var_heap, rcs_expr_heap, rcs_imports }
# rs = weightedRefCount rci case_expr rs
......@@ -537,12 +545,6 @@ where
distribute_lets_in_patterns depth ref_counts (AlgebraicPatterns conses patterns) ds
# (patterns, ds) = mapSt (distribute_lets_in_alg_pattern depth) (exactZip ref_counts patterns) ds
= (AlgebraicPatterns conses patterns, ds)
where
distribute_lets_in_alg_pattern depth (ref_counts,pattern) ds=:{ds_var_heap}
# (ap_vars, ds_var_heap) = mapSt refresh_variable pattern.ap_vars ds_var_heap
ds = {ds & ds_var_heap = ds_var_heap}
(ap_expr, ds) = distribute_lets_in_pattern_expr depth ref_counts pattern.ap_expr ds
= ({ pattern & ap_vars = ap_vars, ap_expr = ap_expr }, ds)
distribute_lets_in_patterns depth ref_counts (BasicPatterns type patterns) ds
# (patterns, ds) = mapSt (distribute_lets_in_basic_pattern depth) (exactZip ref_counts patterns) ds
= (BasicPatterns type patterns, ds)
......@@ -550,6 +552,15 @@ where
distribute_lets_in_basic_pattern depth (ref_counts,pattern) ds
# (bp_expr, ds) = distribute_lets_in_pattern_expr depth ref_counts pattern.bp_expr ds
= ({ pattern & bp_expr = bp_expr }, ds)
distribute_lets_in_patterns depth ref_counts (OverloadedListPatterns conses decons_expr patterns) heaps
# (patterns, heaps) = mapSt (distribute_lets_in_alg_pattern depth) (exactZip ref_counts patterns) heaps
= (OverloadedListPatterns conses decons_expr patterns, heaps)
distribute_lets_in_alg_pattern depth (ref_counts,pattern) ds=:{ds_var_heap}
# (ap_vars, ds_var_heap) = mapSt refresh_variable pattern.ap_vars ds_var_heap
ds = {ds & ds_var_heap = ds_var_heap}
(ap_expr, ds) = distribute_lets_in_pattern_expr depth ref_counts pattern.ap_expr ds
= ({ pattern & ap_vars = ap_vars, ap_expr = ap_expr }, ds)
distribute_lets_in_default depth ref_counts_in_default (Yes expr) ds
# (expr, ds) = distribute_lets_in_pattern_expr depth ref_counts_in_default expr ds
......@@ -751,29 +762,7 @@ where
, cs_expr_heap :: !.ExpressionHeap
, cs_next_fun_nr :: !Index
}
/*
class caseFree a :: !a -> Bool
instance caseFree [a] | caseFree a where
caseFree l
= and (map caseFree l)
instance caseFree (Optional a) | caseFree a where
caseFree No
= True
caseFree (Yes a)
= caseFree a
instance caseFree BasicPattern where
caseFree {bp_expr}
= caseFree bp_expr
instance caseFree Expression where
caseFree (Case _)
= False
caseFree _
= True
*/
markLocalLetVar :: LetBind *VarHeap -> *VarHeap
markLocalLetVar {lb_dst={fv_info_ptr}} varHeap
= varHeap <:= (fv_info_ptr, VI_LocalLetVar)
......@@ -889,18 +878,16 @@ instance convertRootCases Expression where
VI_LocalLetVar
-> convertCases ci caseExpr cs // -*-> "convertRootCases, no guards"
_
// | True <<- ("convertRootCases",varInfo)
// | True <<- ("convertRootCases",varInfo)
# (case_expr, cs) = convertCases ci case_expr cs
# (case_guards, cs) = convertRootCasesCasePatterns ci case_guards case_type.ct_cons_types cs
# (case_default, cs)= convertRootCases ci case_default cs
-> (Case {kees & case_expr=case_expr, case_guards=case_guards, case_default=case_default}, cs)
// otherwise
-> convertNonRootCase ci kees cs
expr
// -> convertCases ci caseExpr cs // -*-> "convertRootCases, no guards"
-> convertNonRootCase ci kees cs
where
isTruePattern [{bp_value=BVB True}:_]
= True
......@@ -912,7 +899,7 @@ instance convertRootCases Expression where
# (guard, cs) = convert_guard guard ci cs
// # (EI_CaseTypeAndRefCounts case_type _, cs_expr_heap) = readPtr case_info_ptr cs.cs_expr_heap
// # {cs &cs_expr_heap=cs_expr_heap}
# (then_part, cs) = convertRootCases {ci & ci_case_level = CaseLevelAfterGuardRoot} bp_expr cs
# (then_part, cs) = convertRootCases {ci & ci_case_level=CaseLevelAfterGuardRoot} bp_expr cs
# (opt_else_part, cs) = convert_to_else_part ci sign_of_then_part alts case_default cs
= (build_conditional sign_of_then_part guard then_part opt_else_part, cs)
where
......@@ -952,18 +939,22 @@ convertRootCasesCasePatterns ci (AlgebraicPatterns gi patterns) arg_types cs
# (patterns, cs)
= convertRootCasesAlgebraicPatterns ci (exactZip patterns arg_types) cs
= (AlgebraicPatterns gi patterns, cs)
where
convertRootCasesAlgebraicPatterns :: ConvertInfo [(AlgebraicPattern, [AType])] *ConvertState -> ([AlgebraicPattern], *ConvertState)
convertRootCasesAlgebraicPatterns ci l cs
= mapSt (convertRootCasesAlgebraicPattern ci) l cs
convertRootCasesAlgebraicPattern :: ConvertInfo (AlgebraicPattern, [AType]) *ConvertState -> (AlgebraicPattern, *ConvertState)
convertRootCasesAlgebraicPattern ci (pattern=:{ap_expr, ap_vars}, arg_types) cs
# ci
= {ci & ci_bound_vars= exactZip ap_vars arg_types ++ ci.ci_bound_vars}
# (ap_expr, cs)
= convertRootCases ci ap_expr cs
= ({pattern & ap_expr=ap_expr}, cs)
convertRootCasesCasePatterns ci (OverloadedListPatterns type decons_expr patterns) arg_types cs
# (patterns, cs)
= convertRootCasesAlgebraicPatterns ci (exactZip patterns arg_types) cs
= (OverloadedListPatterns type decons_expr patterns, cs)
convertRootCasesAlgebraicPatterns :: ConvertInfo [(AlgebraicPattern, [AType])] *ConvertState -> ([AlgebraicPattern], *ConvertState)
convertRootCasesAlgebraicPatterns ci l cs
= mapSt (convertRootCasesAlgebraicPattern ci) l cs
where
convertRootCasesAlgebraicPattern :: ConvertInfo (AlgebraicPattern, [AType]) *ConvertState -> (AlgebraicPattern, *ConvertState)
convertRootCasesAlgebraicPattern ci (pattern=:{ap_expr, ap_vars}, arg_types) cs
# ci
= {ci & ci_bound_vars= exactZip ap_vars arg_types ++ ci.ci_bound_vars}
# (ap_expr, cs)
= convertRootCases ci ap_expr cs
= ({pattern & ap_expr=ap_expr}, cs)
instance convertRootCases (Optional a) | convertRootCases a where
convertRootCases ci (Yes expr) cs
......@@ -1172,6 +1163,8 @@ splitGuards (AlgebraicPatterns index patterns)
= [AlgebraicPatterns index [pattern] \\ pattern <- patterns]
splitGuards (BasicPatterns basicType patterns)
= [BasicPatterns basicType [pattern] \\ pattern <- patterns]
splitGuards (OverloadedListPatterns type decons_expr patterns)
= [OverloadedListPatterns type decons_expr [pattern] \\ pattern <- patterns]
makeCase :: Expression CasePatterns -> Expression
makeCase expr guard
......@@ -1330,6 +1323,10 @@ where
copy (BasicPatterns type patterns) cp_info
# (patterns, cp_info) = copy patterns cp_info
= (BasicPatterns type patterns, cp_info)
copy (OverloadedListPatterns type decons_expr patterns) cp_info
# (patterns, cp_info) = copy patterns cp_info
# (decons_expr, cp_info) = copy decons_expr cp_info
= (OverloadedListPatterns type decons_expr patterns, cp_info)
instance copy AlgebraicPattern
where
......@@ -1338,7 +1335,6 @@ where
# (ap_expr, cp_info) = copy ap_expr { cp_info & cp_local_vars = cp_local_vars, cp_var_heap = cp_var_heap}
= ({ pattern & ap_expr = ap_expr }, cp_info)
where
bind_pattern_var pattern_var=:{fv_info_ptr} (local_vars, var_heap)
= ([pattern_var : local_vars], var_heap <:= (fv_info_ptr, VI_LocalVar))
......@@ -1668,6 +1664,3 @@ mergeCases (case_expr=:(Case first_case=:{case_default, case_default_pos}), case
var_heap, symbol_heap, error)
mergeCases expr_and_pos _ var_heap symbol_heap error
= (expr_and_pos, var_heap, symbol_heap, /* checkWarning "" " alternative will never match" */ error)
......@@ -78,6 +78,17 @@ where
No
-> (No, var_heap, symbol_heap)
OverloadedListPatterns type decons_expr [overloaded_list_pattern]
# (split_result, var_heap, symbol_heap) = split_case split_var_info_ptr overloaded_list_pattern.ap_expr var_heap symbol_heap
-> case split_result of
Yes split_case
# (cees,symbol_heap) = push_expression_into_guards_and_default
( \ guard_expr -> { this_case & case_guards = OverloadedListPatterns type decons_expr [{ overloaded_list_pattern & ap_expr = guard_expr }] } )
split_case symbol_heap
-> (Yes cees, var_heap, symbol_heap)
No
-> (No, var_heap, symbol_heap)
DynamicPatterns [dynamic_pattern]
# (split_result, var_heap, symbol_heap) = split_case split_var_info_ptr dynamic_pattern.dp_rhs var_heap symbol_heap
-> case split_result of
......@@ -121,14 +132,7 @@ where
= var_heap <:= (fv_info_ptr, VI_Alias var)
set_alias _ var_heap
= var_heap
/*
push_expression_into_guards expr_fun (AlgebraicPatterns type patterns)
= AlgebraicPatterns type (map (\algpattern -> { algpattern & ap_expr = expr_fun algpattern.ap_expr }) patterns)
push_expression_into_guards expr_fun (BasicPatterns type patterns)
= BasicPatterns type (map (\baspattern -> { baspattern & bp_expr = expr_fun baspattern.bp_expr }) patterns)
push_expression_into_guards expr_fun (DynamicPatterns patterns)
= DynamicPatterns (map (\dynpattern -> { dynpattern & dp_rhs = expr_fun dynpattern.dp_rhs }) patterns)
*/
push_expression_into_guards_and_default expr_fun split_case symbol_heap
= push_expression_into_guards_and_default split_case symbol_heap
where
......@@ -144,6 +148,9 @@ where
push_expression_into_guards split_case=:{case_guards=BasicPatterns type patterns} symbol_heap
# (new_patterns,symbol_heap) = push_expression_into_patterns patterns symbol_heap
= ({split_case & case_guards=BasicPatterns type new_patterns},symbol_heap)
push_expression_into_guards split_case=:{case_guards=OverloadedListPatterns type decons_expr patterns} symbol_heap
# (new_patterns,symbol_heap) = push_expression_into_patterns patterns symbol_heap
= ({split_case & case_guards=OverloadedListPatterns type decons_expr new_patterns},symbol_heap)
push_expression_into_guards split_case=:{case_guards=DynamicPatterns patterns} symbol_heap
# (new_patterns,symbol_heap) = push_expression_into_patterns patterns symbol_heap
= ({split_case & case_guards=DynamicPatterns new_patterns},symbol_heap)
......@@ -192,13 +199,6 @@ where
push_let_expression_into_guards lad (AlgebraicPatterns type patterns) var_heap expr_heap
# (patterns, var_heap, expr_heap) = push_let_expression_into_algebraic_pattern lad patterns var_heap expr_heap
= (AlgebraicPatterns type patterns, var_heap, expr_heap)
where
push_let_expression_into_algebraic_pattern lad [pattern=:{ap_expr}] var_heap expr_heap
= ([{ pattern & ap_expr = Let { lad & let_expr = ap_expr}}], var_heap, expr_heap)
push_let_expression_into_algebraic_pattern lad [pattern=:{ap_expr}:patterns] var_heap expr_heap
# (ap_expr, var_heap, expr_heap) = rebuild_let_expression lad ap_expr var_heap expr_heap
(patterns, var_heap, expr_heap) = push_let_expression_into_algebraic_pattern lad patterns var_heap expr_heap
= ([{pattern & ap_expr = ap_expr} : patterns], var_heap, expr_heap)
push_let_expression_into_guards lad (BasicPatterns type patterns) var_heap expr_heap
# (patterns, var_heap, expr_heap) = push_let_expression_into_basic_pattern lad patterns var_heap expr_heap
= (BasicPatterns type patterns, var_heap, expr_heap)
......@@ -209,6 +209,9 @@ where
# (bp_expr, var_heap, expr_heap) = rebuild_let_expression lad bp_expr var_heap expr_heap
(patterns, var_heap, expr_heap) = push_let_expression_into_basic_pattern lad patterns var_heap expr_heap
= ([{pattern & bp_expr = bp_expr} : patterns], var_heap, expr_heap)
push_let_expression_into_guards lad (OverloadedListPatterns type decons_expr patterns) var_heap expr_heap
# (patterns, var_heap, expr_heap) = push_let_expression_into_algebraic_pattern lad patterns var_heap expr_heap
= (OverloadedListPatterns type decons_expr patterns, var_heap, expr_heap)
push_let_expression_into_guards lad (DynamicPatterns patterns) var_heap expr_heap
# (patterns, var_heap, expr_heap) = push_let_expression_into_dynamic_pattern lad patterns var_heap expr_heap
= (DynamicPatterns patterns, var_heap, expr_heap)
......@@ -220,27 +223,104 @@ where
(patterns, var_heap, expr_heap) = push_let_expression_into_dynamic_pattern lad patterns var_heap expr_heap
= ([{pattern & dp_rhs = dp_rhs} : patterns], var_heap, expr_heap)
push_let_expression_into_algebraic_pattern lad [pattern=:{ap_expr}] var_heap expr_heap
= ([{ pattern & ap_expr = Let { lad & let_expr = ap_expr}}], var_heap, expr_heap)
push_let_expression_into_algebraic_pattern lad [pattern=:{ap_expr}:patterns] var_heap expr_heap
# (ap_expr, var_heap, expr_heap) = rebuild_let_expression lad ap_expr var_heap expr_heap
(patterns, var_heap, expr_heap) = push_let_expression_into_algebraic_pattern lad patterns var_heap expr_heap
= ([{pattern & ap_expr = ap_expr} : patterns], var_heap, expr_heap)
merge_guards guards=:(AlgebraicPatterns type1 patterns1) (AlgebraicPatterns type2 patterns2) var_heap symbol_heap error
| type1 == type2
# (merged_patterns, var_heap, symbol_heap, error) = merge_algebraic_patterns patterns1 patterns2 var_heap symbol_heap error
= (AlgebraicPatterns type1 merged_patterns, var_heap, symbol_heap, error)
= (guards, var_heap, symbol_heap, checkError "" "incompatible patterns in case" error)
= merge_algebraic_patterns type1 patterns1 patterns2 var_heap symbol_heap error
= (guards, var_heap, symbol_heap, incompatible_patterns_in_case_error error)
merge_guards guards=:(BasicPatterns basic_type1 patterns1) (BasicPatterns basic_type2 patterns2) var_heap symbol_heap error
| basic_type1 == basic_type2
# (merged_patterns, var_heap, symbol_heap, error) = merge_basic_patterns patterns1 patterns2 var_heap symbol_heap error
= (BasicPatterns basic_type1 merged_patterns, var_heap, symbol_heap, error)
= (guards, var_heap, symbol_heap, checkError "" "incompatible patterns in case" error)
= (guards, var_heap, symbol_heap, incompatible_patterns_in_case_error error)
merge_guards guards=:(OverloadedListPatterns type1 decons_expr1 patterns1) (OverloadedListPatterns type2 decons_expr2 patterns2) var_heap symbol_heap error
| type1 == type2
= merge_overloaded_list_patterns type1 decons_expr1 patterns1 patterns2 var_heap symbol_heap error
= case (type1,type2) of
(OverloadedList _ _ _ _,UnboxedList type_symbol stdStrictLists_index decons_index nil_index)
# patterns1=replace_overloaded_symbols_in_patterns patterns1 PD_UnboxedConsSymbol PD_UnboxedNilSymbol
-> merge_overloaded_list_patterns type2 decons_expr2 patterns1 patterns2 var_heap symbol_heap error
(OverloadedList _ _ _ _,UnboxedTailStrictList type_symbol stdStrictLists_index decons_index nil_index)
# patterns1=replace_overloaded_symbols_in_patterns patterns1 PD_UnboxedTailStrictConsSymbol PD_UnboxedTailStrictNilSymbol
-> merge_overloaded_list_patterns type2 decons_expr2 patterns1 patterns2 var_heap symbol_heap error
(UnboxedList type_symbol stdStrictLists_index decons_index nil_index,OverloadedList _ _ _ _)
# patterns2=replace_overloaded_symbols_in_patterns patterns2 PD_UnboxedConsSymbol PD_UnboxedNilSymbol
-> merge_overloaded_list_patterns type1 decons_expr1 patterns1 patterns2 var_heap symbol_heap error
(UnboxedTailStrictList type_symbol stdStrictLists_index decons_index nil_index,OverloadedList _ _ _ _)
# patterns2=replace_overloaded_symbols_in_patterns patterns2 PD_UnboxedTailStrictConsSymbol PD_UnboxedTailStrictNilSymbol
-> merge_overloaded_list_patterns type1 decons_expr1 patterns1 patterns2 var_heap symbol_heap error
_
-> (guards, var_heap, symbol_heap, incompatible_patterns_in_case_error error)
merge_guards guards=:(DynamicPatterns patterns1) (DynamicPatterns patterns2) var_heap symbol_heap error
# (merged_patterns, var_heap, symbol_heap, error) = merge_dynamic_patterns patterns1 patterns2 var_heap symbol_heap error
= (DynamicPatterns merged_patterns, var_heap, symbol_heap, error)
merge_guards guards=:(AlgebraicPatterns type1 patterns1) (OverloadedListPatterns type2 decons_expr2 patterns2) var_heap symbol_heap error
| type1.glob_module==cPredefinedModuleIndex
# index=type1.glob_object+FirstTypePredefinedSymbolIndex
| index==PD_ListType
# patterns2=replace_overloaded_symbols_in_patterns patterns2 PD_ConsSymbol PD_NilSymbol
= merge_algebraic_patterns type1 patterns1 patterns2 var_heap symbol_heap error
| index==PD_StrictListType
# patterns2=replace_overloaded_symbols_in_patterns patterns2 PD_StrictConsSymbol PD_StrictNilSymbol
= merge_algebraic_patterns type1 patterns1 patterns2 var_heap symbol_heap error
| index==PD_TailStrictListType
# patterns2=replace_overloaded_symbols_in_patterns patterns2 PD_TailStrictConsSymbol PD_TailStrictNilSymbol
= merge_algebraic_patterns type1 patterns1 patterns2 var_heap symbol_heap error
| index==PD_StrictTailStrictListType
# patterns2=replace_overloaded_symbols_in_patterns patterns2 PD_StrictTailStrictConsSymbol PD_StrictTailStrictNilSymbol
= merge_algebraic_patterns type1 patterns1 patterns2 var_heap symbol_heap error
= (guards, var_heap, symbol_heap, incompatible_patterns_in_case_error error)
merge_guards guards=:(OverloadedListPatterns type1 decons_expr1 patterns1) (AlgebraicPatterns type2 patterns2) var_heap symbol_heap error
| type2.glob_module==cPredefinedModuleIndex
# index=type2.glob_object+FirstTypePredefinedSymbolIndex
| index==PD_ListType
# patterns1=replace_overloaded_symbols_in_patterns patterns1 PD_ConsSymbol PD_NilSymbol
= merge_algebraic_patterns type2 patterns1 patterns2 var_heap symbol_heap error
| index==PD_StrictListType
# patterns1=replace_overloaded_symbols_in_patterns patterns1 PD_StrictConsSymbol PD_StrictNilSymbol
= merge_algebraic_patterns type2 patterns1 patterns2 var_heap symbol_heap error
| index==PD_TailStrictListType
# patterns1=replace_overloaded_symbols_in_patterns patterns1 PD_TailStrictConsSymbol PD_TailStrictNilSymbol
= merge_algebraic_patterns type2 patterns1 patterns2 var_heap symbol_heap error
| index==PD_StrictTailStrictListType
# patterns1=replace_overloaded_symbols_in_patterns patterns1 PD_StrictTailStrictConsSymbol PD_StrictTailStrictNilSymbol
= merge_algebraic_patterns type2 patterns1 patterns2 var_heap symbol_heap error
= (guards, var_heap, symbol_heap, incompatible_patterns_in_case_error error)
merge_guards patterns1 patterns2 var_heap symbol_heap error
= (patterns1, var_heap, symbol_heap, checkError "" "incompatible patterns in case" error)
= (patterns1, var_heap, symbol_heap, incompatible_patterns_in_case_error error)
merge_algebraic_patterns patterns [alg_pattern : alg_patterns] var_heap symbol_heap error
# (patterns, var_heap, symbol_heap, error) = merge_algebraic_pattern_with_patterns alg_pattern patterns var_heap symbol_heap error
= merge_algebraic_patterns patterns alg_patterns var_heap symbol_heap error
merge_algebraic_patterns patterns [] var_heap symbol_heap error
merge_algebraic_patterns type patterns1 patterns2 var_heap symbol_heap error
# (merged_patterns, var_heap, symbol_heap, error) = merge_algebraic_or_overloaded_list_patterns patterns1 patterns2 var_heap symbol_heap error
= (AlgebraicPatterns type merged_patterns, var_heap, symbol_heap, error)
merge_overloaded_list_patterns type decons_expr patterns1 patterns2 var_heap symbol_heap error
# (merged_patterns, var_heap, symbol_heap, error) = merge_algebraic_or_overloaded_list_patterns patterns1 patterns2 var_heap symbol_heap error
= (OverloadedListPatterns type decons_expr merged_patterns, var_heap, symbol_heap, error)
merge_algebraic_or_overloaded_list_patterns patterns [] var_heap symbol_heap error
= (patterns, var_heap, symbol_heap, error)
merge_algebraic_or_overloaded_list_patterns patterns [alg_pattern : alg_patterns] var_heap symbol_heap error
# (patterns, var_heap, symbol_heap, error) = merge_algebraic_pattern_with_patterns alg_pattern patterns var_heap symbol_heap error
= merge_algebraic_or_overloaded_list_patterns patterns alg_patterns var_heap symbol_heap error
where
merge_algebraic_pattern_with_patterns new_pattern [pattern=:{ap_symbol,ap_vars,ap_expr} : patterns] var_heap symbol_heap error
| new_pattern.ap_symbol == ap_symbol
| isEmpty new_pattern.ap_vars
# ((ap_expr, _), var_heap, symbol_heap, error) = mergeCases (ap_expr, NoPos) [(new_pattern.ap_expr, NoPos)] var_heap symbol_heap error
= ([{ pattern & ap_expr = ap_expr} : patterns], var_heap, symbol_heap, error)
# (new_expr, var_heap, symbol_heap) = replace_variables new_pattern.ap_vars new_pattern.ap_expr ap_vars var_heap symbol_heap
((ap_expr, _), var_heap, symbol_heap, error) = mergeCases (ap_expr, NoPos) [(new_expr, NoPos)] var_heap symbol_heap error
= ([{ pattern & ap_expr = ap_expr} : patterns], var_heap, symbol_heap, error)
# (patterns, var_heap, symbol_heap, error) = merge_algebraic_pattern_with_patterns new_pattern patterns var_heap symbol_heap error
= ([ pattern : patterns ], var_heap, symbol_heap, error)
merge_algebraic_pattern_with_patterns new_pattern [] var_heap symbol_heap error
= ([new_pattern], var_heap, symbol_heap, error)
merge_basic_patterns patterns [alg_pattern : alg_patterns] var_heap symbol_heap error
# (patterns, var_heap, symbol_heap, error) = merge_basic_pattern_with_patterns alg_pattern patterns var_heap symbol_heap error
......@@ -248,35 +328,21 @@ where
merge_basic_patterns patterns [] var_heap symbol_heap error
= (patterns, var_heap, symbol_heap, error)
merge_dynamic_patterns patterns1 patterns2 var_heap symbol_heap error
= (patterns1 ++ patterns2, var_heap, symbol_heap, error)
merge_algebraic_pattern_with_patterns new_pattern [pattern=:{ap_symbol,ap_vars,ap_expr} : patterns] var_heap symbol_heap error
| new_pattern.ap_symbol == ap_symbol
| isEmpty new_pattern.ap_vars
# ((ap_expr, _), var_heap, symbol_heap, error) = mergeCases (ap_expr, NoPos) [(new_pattern.ap_expr, NoPos)] var_heap symbol_heap error
= ([{ pattern & ap_expr = ap_expr} : patterns], var_heap, symbol_heap, error)
# (new_expr, var_heap, symbol_heap) = replace_variables new_pattern.ap_vars new_pattern.ap_expr ap_vars var_heap symbol_heap
((ap_expr, _), var_heap, symbol_heap, error) = mergeCases (ap_expr, NoPos) [(new_expr, NoPos)] var_heap symbol_heap error
= ([{ pattern & ap_expr = ap_expr} : patterns], var_heap, symbol_heap, error)
# (patterns, var_heap, symbol_heap, error) = merge_algebraic_pattern_with_patterns new_pattern patterns var_heap symbol_heap error
= ([ pattern : patterns ], var_heap, symbol_heap, error)
replace_variables vars expr ap_vars var_heap symbol_heap
# var_heap = build_aliases vars ap_vars var_heap
# us = { us_var_heap = var_heap, us_symbol_heap = symbol_heap, us_opt_type_heaps = No,us_cleanup_info=[], us_local_macro_functions = No }
ui = {ui_handle_aci_free_vars = RemoveThem, ui_convert_module_n= -1, ui_conversion_table=No }
(expr, us) = unfold expr ui us
= (expr, us.us_var_heap, us.us_symbol_heap)
where
replace_variables vars expr ap_vars var_heap symbol_heap
# var_heap = build_aliases vars ap_vars var_heap
# us = { us_var_heap = var_heap, us_symbol_heap = symbol_heap, us_opt_type_heaps = No,us_cleanup_info=[], us_local_macro_functions = No }
ui = {ui_handle_aci_free_vars = RemoveThem, ui_convert_module_n= -1, ui_conversion_table=No }
(expr, us) = unfold expr ui us
= (expr, us.us_var_heap, us.us_symbol_heap)
build_aliases [var1 : vars1] [ {fv_name,fv_info_ptr} : vars2 ] var_heap
= build_aliases vars1 vars2 (writePtr var1.fv_info_ptr (VI_Variable fv_name fv_info_ptr) var_heap)
build_aliases [] [] var_heap
= var_heap
merge_algebraic_pattern_with_patterns new_pattern [] var_heap symbol_heap error
= ([new_pattern], var_heap, symbol_heap, error)
merge_dynamic_patterns patterns1 patterns2 var_heap symbol_heap error
= (patterns1 ++ patterns2, var_heap, symbol_heap, error)
merge_basic_pattern_with_patterns new_pattern [pattern=:{bp_value,bp_expr} : patterns] var_heap symbol_heap error
| new_pattern.bp_value == bp_value
# ((bp_expr, _), var_heap, symbol_heap, error) = mergeCases (bp_expr, NoPos) [(new_pattern.bp_expr, NoPos)] var_heap symbol_heap error
......@@ -286,6 +352,31 @@ where
merge_basic_pattern_with_patterns new_pattern [] var_heap symbol_heap error
= ([new_pattern], var_heap, symbol_heap, error)
replace_overloaded_symbols_in_patterns [] pd_cons_symbol pd_nil_symbol
= []
replace_overloaded_symbols_in_patterns [pattern=:{ap_symbol={glob_module,glob_object}}:patterns] pd_cons_symbol pd_nil_symbol
# pattern = replace_overloaded_symbol_in_pattern pattern pd_cons_symbol pd_nil_symbol
# patterns = replace_overloaded_symbols_in_patterns patterns pd_cons_symbol pd_nil_symbol
= [pattern:patterns]
where
replace_overloaded_symbol_in_pattern pattern=:{ap_symbol={glob_module,glob_object}} pd_cons_symbol pd_nil_symbol
| glob_module==cPredefinedModuleIndex
# index=glob_object.ds_index+FirstConstructorPredefinedSymbolIndex
| index==PD_OverloadedConsSymbol
# new_cons_index=pd_cons_symbol-FirstConstructorPredefinedSymbolIndex
# new_cons_ident=cons_and_nil_idents.[new_cons_index]
# glob_object = {glob_object & ds_index=new_cons_index,ds_ident=new_cons_ident}
= {pattern & ap_symbol.glob_object=glob_object}
| index==PD_OverloadedNilSymbol
# new_nil_index=pd_nil_symbol-FirstConstructorPredefinedSymbolIndex
# new_nil_ident=cons_and_nil_idents.[new_nil_index]
# glob_object = {glob_object & ds_index=new_nil_index,ds_ident=new_nil_ident}
= {pattern & ap_symbol.glob_object=glob_object}
= abort "replace_overloaded_symbol_in_pattern"
incompatible_patterns_in_case_error error
= checkError "" "incompatible patterns in case" error
mergeCases (case_expr=:(Case first_case=:{case_default, case_default_pos}), case_pos) [expr : exprs] var_heap symbol_heap error
= case case_default of
Yes default_expr
......
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