From 3b252c7e6b37f0d8be7fbeba75331f7299072b1d Mon Sep 17 00:00:00 2001
From: Thomas Bauereiss
Date: Tue, 16 Jan 2018 16:56:46 +0000
Subject: 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.
---
 src/monomorphise.ml |  2 +-
 src/rewrites.ml     | 16 +++++++++-------
 2 files changed, 10 insertions(+), 8 deletions(-)

(limited to 'src')

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 ->
-- 
cgit v1.2.3