aboutsummaryrefslogtreecommitdiff
path: root/frontend/convertcases.icl
diff options
context:
space:
mode:
authorjohnvg2002-02-07 12:45:50 +0000
committerjohnvg2002-02-07 12:45:50 +0000
commit7c16ac1e2890a4e49899cd88666997b3006d5afd (patch)
tree6d82005fea85b2d389bd188452d04ebd8c7dbb85 /frontend/convertcases.icl
parentinitialise st_args_strictness in unused function for Clean 2.0 (diff)
fix bug for boolean cases with then or else expressions that
can fail and also have a default expression git-svn-id: https://svn.cs.ru.nl/repos/clean-compiler/trunk@1005 1f8540f1-abd5-4d5b-9d24-4c5ce8603e2d
Diffstat (limited to 'frontend/convertcases.icl')
-rw-r--r--frontend/convertcases.icl10
1 files changed, 4 insertions, 6 deletions
diff --git a/frontend/convertcases.icl b/frontend/convertcases.icl
index 442c7c8..b483004 100644
--- a/frontend/convertcases.icl
+++ b/frontend/convertcases.icl
@@ -770,8 +770,12 @@ markLocalLetVar :: LetBind *VarHeap -> *VarHeap
markLocalLetVar {lb_dst={fv_info_ptr}} varHeap
= varHeap <:= (fv_info_ptr, VI_LocalLetVar)
+is_guard_case [{bp_value=BVB True,bp_expr},{bp_value=BVB False,bp_expr=false_expr}] (Yes _) False
+ = is_then_or_else bp_expr && is_then_or_else false_expr
is_guard_case [{bp_value=BVB True,bp_expr}:patterns] case_default False
= has_no_rooted_case bp_expr
+is_guard_case [{bp_value=BVB False,bp_expr},{bp_value=BVB True,bp_expr=true_expr}] (Yes _) False
+ = is_then_or_else bp_expr && is_then_or_else true_expr
is_guard_case [{bp_value=BVB False,bp_expr}:patterns] case_default False
= then_part_exists_and_has_no_rooted_case patterns case_default
where
@@ -866,7 +870,6 @@ instance convertRootCases Expression where
= case case_guards of // -*-> "convertRootCases, guards???" of
BasicPatterns BT_Bool patterns
| is_guard_case patterns case_default case_explicit
-// | caseFree patterns && (isTruePattern patterns || caseFree case_default)
-> convert_boolean_case_into_guard ci case_expr patterns case_default case_info_ptr cs
_
-> case case_expr of
@@ -892,11 +895,6 @@ instance convertRootCases Expression where
// -> convertCases ci caseExpr cs // -*-> "convertRootCases, no guards"
-> convertNonRootCase ci kees cs
where
- isTruePattern [{bp_value=BVB True}:_]
- = True
- isTruePattern _
- = False
-
convert_boolean_case_into_guard ci guard [ alt=:{bp_value=BVB sign_of_then_part,bp_expr} : alts ] case_default case_info_ptr cs
// # (guard, cs) = convertCases ci guard cs
# (guard, cs) = convert_guard guard ci cs