diff options
| author | Thomas Bauereiss | 2018-01-16 16:56:46 +0000 |
|---|---|---|
| committer | Thomas Bauereiss | 2018-01-16 17:31:56 +0000 |
| commit | 3b252c7e6b37f0d8be7fbeba75331f7299072b1d (patch) | |
| tree | ac346306d49facda1d4934c639db35aa61e638d7 /src | |
| parent | c1cea9e24e2722b0e7376fbe1339564f96d29961 (diff) | |
Fix problem with let-bindings in pattern guards
Monomorphisation sometimes produces pattern guard with let-bindings, e.g.
| ... if (let regsize = size_itself(regsize) in eq(regsize, 32)) -> ...
Previously, the rewriting pass for let-bindings (and pattern guards) pulled
these out of the guard condition and into the same scope as the case
expression, which potentially clashed with let-bindings for the same variables
in that case expression. The rewriter now leaves let-bindings in place within
pure if-conditions, solving this problem.
Diffstat (limited to 'src')
| -rw-r--r-- | src/monomorphise.ml | 2 | ||||
| -rw-r--r-- | src/rewrites.ml | 16 |
2 files changed, 10 insertions, 8 deletions
diff --git a/src/monomorphise.ml b/src/monomorphise.ml index 1e2a5cf4..dd1b4aa3 100644 --- a/src/monomorphise.ml +++ b/src/monomorphise.ml @@ -1877,7 +1877,7 @@ let rewrite_size_parameters env (Defs defs) = let body = List.fold_left add_var_rebind body vars in let guard = match guard with | None -> None - | Some exp -> Some (List.fold_left add_var_rebind body vars) + | Some exp -> Some (List.fold_left add_var_rebind exp vars) in pat,guard,body | exception Not_found -> pat,guard,body diff --git a/src/rewrites.ml b/src/rewrites.ml index 950013ff..7e852092 100644 --- a/src/rewrites.ml +++ b/src/rewrites.ml @@ -2313,13 +2313,15 @@ let rewrite_defs_letbind_effects = n_exp_nameL exps (fun exps -> k (rewrap (E_tuple exps))) | E_if (exp1,exp2,exp3) -> - n_exp_name exp1 (fun exp1 -> - let (E_aux (_,annot2)) = exp2 in - let (E_aux (_,annot3)) = exp3 in - let newreturn = effectful exp2 || effectful exp3 in - let exp2 = n_exp_term newreturn exp2 in - let exp3 = n_exp_term newreturn exp3 in - k (rewrap (E_if (exp1,exp2,exp3)))) + let e_if exp1 = + let (E_aux (_,annot2)) = exp2 in + let (E_aux (_,annot3)) = exp3 in + let newreturn = effectful exp2 || effectful exp3 in + let exp2 = n_exp_term newreturn exp2 in + let exp3 = n_exp_term newreturn exp3 in + k (rewrap (E_if (exp1,exp2,exp3))) + in + if value exp1 then e_if (n_exp_term false exp1) else n_exp_name exp1 e_if | E_for (id,start,stop,by,dir,body) -> n_exp_name start (fun start -> n_exp_name stop (fun stop -> |