From 57aeb4e9316ca0dcd9d1316a2db71d80dbf612db Mon Sep 17 00:00:00 2001
From: Lesenechal Remi <lesenechal.remi@gmail.com>
Date: Mon, 20 Jan 2020 19:15:09 +0100
Subject: [PATCH] detect self_address when not at top level

---
 src/main/compile/of_mini_c.ml                 |  1 +
 .../self_ast_simplified.ml                    |  8 ------
 src/passes/7-self_mini_c/helpers.ml           |  8 ++++++
 .../7-self_mini_c/michelson_restrictions.ml   | 26 +++++++++++++++++++
 src/passes/7-self_mini_c/self_mini_c.ml       |  5 ++++
 vendors/ligo-utils/simple-utils/trace.ml      |  8 ++++++
 6 files changed, 48 insertions(+), 8 deletions(-)
 create mode 100644 src/passes/7-self_mini_c/michelson_restrictions.ml

diff --git a/src/main/compile/of_mini_c.ml b/src/main/compile/of_mini_c.ml
index 3b48d3921..4d99be97a 100644
--- a/src/main/compile/of_mini_c.ml
+++ b/src/main/compile/of_mini_c.ml
@@ -3,6 +3,7 @@ open Proto_alpha_utils
 open Trace
 
 let compile_contract : expression -> Compiler.compiled_expression result = fun e ->
+  let%bind e = Self_mini_c.contract_check e in
   let%bind (input_ty , _) = get_t_function e.type_value in
   let%bind body = get_function e in
   let%bind body = Compiler.Program.translate_function_body body [] input_ty in
diff --git a/src/passes/3-self_ast_simplified/self_ast_simplified.ml b/src/passes/3-self_ast_simplified/self_ast_simplified.ml
index a1ce4b580..f0ecd5183 100644
--- a/src/passes/3-self_ast_simplified/self_ast_simplified.ml
+++ b/src/passes/3-self_ast_simplified/self_ast_simplified.ml
@@ -6,14 +6,6 @@ let all = [
   Literals.peephole_expression ;
 ]
 
-let rec bind_chain : ('a -> 'a result) list -> 'a -> 'a result = fun fs x ->
-  match fs with
-  | [] -> ok x
-  | hd :: tl -> (
-      let aux : 'a -> 'a result = fun x -> bind (bind_chain tl) (hd x) in
-      bind aux (ok x)
-    )
-
 let all_program =
   let all_p = List.map Helpers.map_program all in
   bind_chain all_p
diff --git a/src/passes/7-self_mini_c/helpers.ml b/src/passes/7-self_mini_c/helpers.ml
index ea7756a35..f5638cbe5 100644
--- a/src/passes/7-self_mini_c/helpers.ml
+++ b/src/passes/7-self_mini_c/helpers.ml
@@ -163,3 +163,11 @@ let rec map_expression : mapper -> expression -> expression result = fun f e ->
       let%bind updates = bind_map_list (fun (p,e) -> let%bind e = self e in ok(p,e)) updates in
       return @@ E_update(r,updates)
   )
+
+let map_sub_level_expression : mapper -> expression -> expression result = fun f e ->
+  match e.content with
+  | E_closure {binder ; body} ->
+    let%bind body = map_expression f body in
+    let content = E_closure {binder; body} in
+    ok @@ { e with content }
+  | _ -> ok e
\ No newline at end of file
diff --git a/src/passes/7-self_mini_c/michelson_restrictions.ml b/src/passes/7-self_mini_c/michelson_restrictions.ml
new file mode 100644
index 000000000..7f9e14169
--- /dev/null
+++ b/src/passes/7-self_mini_c/michelson_restrictions.ml
@@ -0,0 +1,26 @@
+open Mini_c
+open Trace
+
+module Errors = struct
+
+  let bad_self_address cst () =
+    let title = thunk @@
+      Format.asprintf "Wrong %alocation" Mini_c.PP.expression' cst in
+    let message = thunk @@
+      Format.asprintf "%ais only allowed at top-level" Mini_c.PP.expression' cst in
+    error title message ()
+  
+end
+open Errors
+
+let self_in_lambdas : expression -> expression result = 
+  fun e ->
+    match e.content with
+    | E_closure {binder=_ ; body} ->
+      let%bind _self_in_lambdas = Helpers.map_expression
+        (fun e -> match e.content with
+        | E_constant (C_SELF_ADDRESS, _) as c -> fail (bad_self_address c)
+        | _ -> ok e)
+        body in
+      ok e
+    | _ -> ok e
diff --git a/src/passes/7-self_mini_c/self_mini_c.ml b/src/passes/7-self_mini_c/self_mini_c.ml
index 329dad692..da2c66fa6 100644
--- a/src/passes/7-self_mini_c/self_mini_c.ml
+++ b/src/passes/7-self_mini_c/self_mini_c.ml
@@ -250,6 +250,11 @@ let betas : bool ref -> expression -> expression =
   fun changed ->
   map_expression (beta changed)
 
+let contract_check =
+  let all = [Michelson_restrictions.self_in_lambdas] in
+  let all_e = List.map Helpers.map_sub_level_expression all in
+  bind_chain all_e
+
 let rec all_expression : expression -> expression =
   fun e ->
   let changed = ref false in
diff --git a/vendors/ligo-utils/simple-utils/trace.ml b/vendors/ligo-utils/simple-utils/trace.ml
index dc80894d4..969de430d 100644
--- a/vendors/ligo-utils/simple-utils/trace.ml
+++ b/vendors/ligo-utils/simple-utils/trace.ml
@@ -718,6 +718,14 @@ let bind_fold_map_pair f acc (a, b) =
 let bind_map_triple f (a, b, c) =
   bind_and3 (f a, f b, f c)
 
+let rec bind_chain : ('a -> 'a result) list -> 'a -> 'a result = fun fs x ->
+  match fs with
+  | [] -> ok x
+  | hd :: tl -> (
+      let aux : 'a -> 'a result = fun x -> bind (bind_chain tl) (hd x) in
+      bind aux (ok x)
+    )
+
 
 (**
    Wraps a call that might trigger an exception in a result.