From c74e2846dfed3b80fa2a7296e8be1e7c292f1fc8 Mon Sep 17 00:00:00 2001
From: Galfour <gabriel.alfour@gmail.com>
Date: Wed, 17 Apr 2019 22:02:11 +0000
Subject: [PATCH] fix free_variables bug

---
 src/ligo/ast_typed.ml  | 18 +++++++++++++-----
 src/ligo/transpiler.ml |  5 +++--
 2 files changed, 16 insertions(+), 7 deletions(-)

diff --git a/src/ligo/ast_typed.ml b/src/ligo/ast_typed.ml
index 39223f1ee..ada7a2d61 100644
--- a/src/ligo/ast_typed.ml
+++ b/src/ligo/ast_typed.ml
@@ -267,10 +267,15 @@ module Free_variables = struct
     match e with
     | E_lambda l ->
         let b' = union (singleton l.binder) b in
-        union (annotated_expression b' l.result) (block b' l.body)
+        let (b'', frees) = block' b' l.body in
+        union (annotated_expression b'' l.result) frees
     | E_literal _ -> empty
     | E_constant (_ , lst) -> unions @@ List.map self lst
-    | E_variable name -> if mem name b then empty else singleton name
+    | E_variable name -> (
+        match mem name b with
+        | true -> empty
+        | false -> singleton name
+      )
     | E_application (a, b) -> unions @@ List.map self [ a ; b ]
     | E_tuple lst -> unions @@ List.map self lst
     | E_constructor (_ , a) -> self a
@@ -278,7 +283,7 @@ module Free_variables = struct
     | E_record_accessor (a, _) -> self a
     | E_tuple_accessor (a, _) -> self a
     | E_list lst -> unions @@ List.map self lst
-    | E_map m -> unions @@ List.map self @@ List.concat  @@ List.map (fun (a, b) -> [ a ; b ]) m
+    | E_map m -> unions @@ List.map self @@ List.concat @@ List.map (fun (a, b) -> [ a ; b ]) m
     | E_look_up (a , b) -> unions @@ List.map self [ a ; b ]
     | E_matching (a , cs) -> union (self a) (matching_expression b cs)
 
@@ -295,11 +300,14 @@ module Free_variables = struct
     | I_patch (_ , _ , a) -> b , annotated_expression b a
     | I_matching (a , cs) -> b , union (annotated_expression b a) (matching_block b cs)
 
-  and block : bindings -> block -> bindings = fun b bl ->
+  and block' : bindings -> block -> (bindings * bindings) = fun b bl ->
     let aux = fun (binds, frees) cur ->
       let (binds', frees') = instruction' binds cur in
       (binds', union frees frees') in
-    let (_, frees) = List.fold_left aux (b , []) bl in
+    List.fold_left aux (b , []) bl
+
+  and block : bindings -> block -> bindings = fun b bl ->
+    let (_ , frees) = block' b bl in
     frees
 
   and matching : type a . (bindings -> a -> bindings) -> bindings -> a matching -> bindings = fun f b m ->
diff --git a/src/ligo/transpiler.ml b/src/ligo/transpiler.ml
index 08dd414ac..bfcd7da7a 100644
--- a/src/ligo/transpiler.ml
+++ b/src/ligo/transpiler.ml
@@ -343,9 +343,10 @@ and translate_lambda env l tv =
   let%bind empty_env =
     let%bind input = translate_type input_type in
     ok Environment.(add (binder, input) empty) in
-  let (body_fvs, result_fvs) = AST.Free_variables.(
+  let ((_body_bounds , body_fvs) , result_fvs) = AST.Free_variables.(
       let bindings = singleton binder in
-      block bindings body , annotated_expression bindings result
+      let ((body_bounds , _) as b) = block' bindings body in
+      b , annotated_expression body_bounds result
     ) in
   match (body_fvs, result_fvs) with
   | [] , [] -> (