separate declaration from assignment at mini_c and ast_typed level

src/ligo/ast_typed.ml

@@ -90,6 +90,7 @@ and block = instruction list
 and b = block
 
 and instruction =
+  | I_declaration of named_expression
   | I_assignment of named_expression
   | I_matching of ae * matching_instr
   | I_loop of ae * b
@@ -227,6 +228,8 @@ module PP = struct
     | I_skip -> fprintf ppf "skip"
     | I_fail ae -> fprintf ppf "fail with (%a)" annotated_expression ae
     | I_loop (cond, b) -> fprintf ppf "while (%a) {@;  @[<v>%a@]@;}" annotated_expression cond block b
+    | I_declaration {name;annotated_expression = ae} ->
+        fprintf ppf "let %s = %a" name annotated_expression ae
     | I_assignment {name;annotated_expression = ae} ->
         fprintf ppf "%s := %a" name annotated_expression ae
     | I_matching (ae, m) ->

src/ligo/mini_c/PP.ml

@@ -87,9 +87,12 @@ and function_ ppf ({binder ; input ; output ; body ; result ; capture_type}:anon
     block body
     expression result
 
-and assignment ppf ((n, e):assignment) = fprintf ppf "let %s = %a;" n expression e
+and assignment ppf ((n, e):assignment) = fprintf ppf "%s = %a;" n expression e
+
+and declaration ppf ((n, e):assignment) = fprintf ppf "let %s = %a;" n expression e
 
 and statement ppf ((s, _) : statement) = match s with
+  | S_declaration ass -> declaration ppf ass
   | S_assignment ass -> assignment ppf ass
   | S_cond (expr, i, e) -> fprintf ppf "if (%a) %a %a" expression expr block i block e
   | S_patch (r, path, e) ->

src/ligo/mini_c/combinators.ml

@@ -113,6 +113,7 @@ let statement s' e : statement =
   | S_if_none _ -> s', id_environment_wrap e
   | S_while _ -> s', id_environment_wrap e
   | S_patch _ -> s', id_environment_wrap e
+  | S_declaration (name, (_, t, _)) -> s', environment_wrap e (Compiler_environment.add (name, t) e)
   | S_assignment (name, (_, t, _)) -> s', environment_wrap e (Compiler_environment.add (name, t) e)
 
 let block (statements:statement list) : block result =

src/ligo/mini_c/compiler.ml

@@ -291,13 +291,23 @@ and translate_statement ((s', w_env) as s:statement) : michelson result =
   let error_message () = Format.asprintf "%a" PP.statement s in
   let%bind (code : michelson) =
     trace (fun () -> error (thunk "translating statement") error_message ()) @@ match s' with
-    | S_assignment (s, ((_, tv, _) as expr)) ->
+    | S_declaration (s, ((_, tv, _) as expr)) ->
         let%bind expr = translate_expression expr in
-        let%bind add =
+        let%bind add = Environment.to_michelson_add (s, tv) w_env.pre_environment in
-          if Environment.has s w_env.pre_environment
+        ok (seq [
-          then Environment.to_michelson_set s w_env.pre_environment
+            i_comment "declaration" ;
-          else Environment.to_michelson_add (s, tv) w_env.pre_environment
+            seq [
-        in
+              i_comment "expr" ;
+              i_push_unit ; expr ; i_car ;
+            ] ;
+            seq [
+              i_comment "env <- env . expr" ;
+              add ;
+            ];
+          ])
+    | S_assignment (s, expr) ->
+        let%bind expr = translate_expression expr in
+        let%bind set = Environment.to_michelson_set s w_env.pre_environment in
         ok (seq [
             i_comment "assignment" ;
             seq [
@@ -306,7 +316,7 @@ and translate_statement ((s', w_env) as s:statement) : michelson result =
             ] ;
             seq [
               i_comment "env <- env . expr" ;
-              add ;
+              set ;
             ];
           ])
     | S_cond (expr, a, b) ->

src/ligo/mini_c/compiler_environment.ml

@@ -13,6 +13,25 @@ module Small = struct
   type t' = environment_small'
   type t = environment_small
 
+  let not_in_env' ?source s t' =
+    let title () = match source with
+      | None -> "Not in environment"
+      | Some source -> Format.asprintf "Not in environment' (%s)" source in
+    let content () =
+      Format.asprintf "Variable : %s, Environment' : %a"
+        s PP.environment_small' t' in
+    error title content
+
+  let not_in_env ?source s t =
+    let title () = match source with
+      | None -> "Not in environment"
+      | Some source -> Format.asprintf "Not in environment (%s)" source in
+    let content () =
+      Format.asprintf "Variable : %s, Environment : %a"
+        s PP.environment_small t in
+    error title content
+
+
   let has' s = exists' (fun ((x, _):element) -> x = s)
   let has s = function
     | Empty -> false
@@ -49,7 +68,7 @@ module Small = struct
   let rec get_path' = fun s env' ->
     match env' with
     | Leaf (n, v) when n = s -> ok ([], v)
-    | Leaf _ -> simple_fail "Not in env"
+    | Leaf _ -> fail @@ not_in_env' ~source:"get_path'" s env'
     | Node {a;b} ->
         match%bind bind_lr @@ Tezos_utils.Tuple.map2 (get_path' s) (a,b) with
         | `Left (lst, v) -> ok ((`Left :: lst), v)
@@ -57,12 +76,13 @@ module Small = struct
 
   let get_path = fun s env ->
     match env with
-    | Empty -> simple_fail "Set : No env"
+    | Empty -> fail @@ not_in_env ~source:"get_path" s env
     | Full x -> get_path' s x
 
-  let rec to_michelson_get' s = function
+  let rec to_michelson_get' = fun s env' ->
+    match env' with
     | Leaf (n, tv) when n = s -> ok @@ (seq [], tv)
-    | Leaf _ -> simple_fail "Schema.Small.get : not in env"
+    | Leaf _ -> fail @@ not_in_env' ~source:"to_michelson_get'" s env'
     | Node {a;b} -> (
         match%bind bind_lr @@ Tezos_utils.Tuple.map2 (to_michelson_get' s) (a, b) with
         | `Left (x, tv) -> ok @@ (seq [i_car ; x], tv)
@@ -72,9 +92,10 @@ module Small = struct
     | Empty -> simple_fail "Schema.Small.get : not in env"
     | Full x -> to_michelson_get' s x
 
-  let rec to_michelson_set' s = function
+  let rec to_michelson_set' = fun s env' ->
+    match env' with
     | Leaf (n, tv) when n = s -> ok (dip i_drop, tv)
-    | Leaf _ -> simple_fail "Schema.Small.set : not in env"
+    | Leaf _ -> fail @@ not_in_env' ~source:"Small.to_michelson_set'" s env'
     | Node {a;b} -> (
         match%bind bind_lr @@ Tezos_utils.Tuple.map2 (to_michelson_set' s) (a, b) with
         | `Left (x, tv) -> ok (seq [dip i_unpair ; x ; i_pair], tv)

src/ligo/mini_c/types.ml

@@ -70,6 +70,7 @@ and expression = expression' * type_value * environment (* Environment in which
 and assignment = var_name * expression
 
 and statement' =
+  | S_declaration of assignment (* First assignment *)
   | S_assignment of assignment
   | S_cond of expression * block * block
   | S_patch of string * [`Left | `Right] list * expression

src/ligo/test/compiler_tests.ml

@@ -12,7 +12,7 @@ let run_entry_int (e:anon_function) (n:int) : int result =
 
 let identity () : unit result =
   let e = basic_int_quote_env in
-  let s = statement (S_assignment ("output", e_var_int "input" e)) e in
+  let s = statement (S_declaration ("output", e_var_int "input" e)) e in
   let%bind b = block [s] in
   let%bind f = basic_int_quote b in
   let%bind result = run_entry_int f 42 in
@@ -27,10 +27,10 @@ let multiple_vars () : unit result =
      Yes. One could do a monad. Feel free when we have the time.
    *)
   let ss = statements [
-      (fun e -> statement (S_assignment ("a", e_var_int "input" e)) e) ;
+      (fun e -> statement (S_declaration ("a", e_var_int "input" e)) e) ;
-      (fun e -> statement (S_assignment ("b", e_var_int "input" e)) e) ;
+      (fun e -> statement (S_declaration ("b", e_var_int "input" e)) e) ;
-      (fun e -> statement (S_assignment ("c", e_var_int "a" e)) e) ;
+      (fun e -> statement (S_declaration ("c", e_var_int "a" e)) e) ;
-      (fun e -> statement (S_assignment ("output", e_var_int "c" e)) e) ;
+      (fun e -> statement (S_declaration ("output", e_var_int "c" e)) e) ;
     ] e in
   let%bind b = block ss in
   let%bind f = basic_int_quote b in

src/ligo/transpiler.ml

@@ -120,13 +120,13 @@ let rec translate_block env (b:AST.block) : block result =
 and translate_instruction (env:Environment.t) (i:AST.instruction) : statement option result =
   let return ?(env' = env) x : statement option result = ok (Some (x, environment_wrap env env')) in
   match i with
-  | I_assignment {name;annotated_expression} ->
+  | I_declaration {name;annotated_expression} ->
       let%bind (_, t, _) as expression = translate_annotated_expression env annotated_expression in
-      let env' =
+      let env' = Environment.add (name, t) env in
-        match Environment.has name env with
+      return ~env' (S_declaration (name, expression))
-        | true -> env
+  | I_assignment {name;annotated_expression} ->
-        | false -> Environment.add (name, t) env in
+      let%bind expression = translate_annotated_expression env annotated_expression in
-      return ~env' (S_assignment (name, expression))
+      return (S_assignment (name, expression))
   | I_patch (r, s, v) -> (
       let ty = r.type_value in
       let aux : ((AST.type_value * [`Left | `Right] list) as 'a) -> AST.access -> 'a result =
@@ -424,7 +424,7 @@ let translate_entry (lst:AST.program) (name:string) : anon_function result =
               let (a, b) = functionalize an.annotated_expression in
               Some (acc, a, b)
         ) else (
-          aux ((AST.I_assignment an) :: acc) tl
+          aux ((AST.I_declaration an) :: acc) tl
         )
       )
   in

src/ligo/typer.ml

@@ -148,17 +148,16 @@ and type_instruction (e:environment) : I.instruction -> (environment * O.instruc
       return @@ O.I_loop (cond, body)
   | I_assignment {name;annotated_expression} -> (
       match annotated_expression.type_annotation, Environment.get e name with
-      | None, None -> simple_fail "Initial assignments need type"
+      | None, None -> simple_fail "Initial assignments need type annotation"
       | Some _, None ->
           let%bind annotated_expression = type_annotated_expression e annotated_expression in
           let e' = Environment.add e name annotated_expression.type_annotation in
-          ok (e', [O.I_assignment {name;annotated_expression}])
+          ok (e', [O.I_declaration {name;annotated_expression}])
       | None, Some prev ->
           let%bind annotated_expression = type_annotated_expression e annotated_expression in
-          let e' = Environment.add e name annotated_expression.type_annotation in
           let%bind _ =
             O.assert_type_value_eq (annotated_expression.type_annotation, prev) in
-          ok (e', [O.I_assignment {name;annotated_expression}])
+          ok (e, [O.I_assignment {name;annotated_expression}])
       | Some _, Some prev ->
           let%bind annotated_expression = type_annotated_expression e annotated_expression in
           let%bind _assert = trace (simple_error "Annotation doesn't match environment")
@@ -588,6 +587,9 @@ and untype_instruction (i:O.instruction) : (I.instruction) result =
       let%bind e' = untype_annotated_expression e in
       let%bind b' = untype_block b in
       ok @@ I_loop (e', b')
+  | I_declaration a ->
+      let%bind annotated_expression = untype_annotated_expression a.annotated_expression in
+      ok @@ I_assignment {name = a.name ; annotated_expression}
   | I_assignment a ->
       let%bind annotated_expression = untype_annotated_expression a.annotated_expression in
       ok @@ I_assignment {name = a.name ; annotated_expression}