detect self_address when not at top level

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

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

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

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

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

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.