tmp

src/lib_utils/x_list.ml

@@ -7,6 +7,8 @@ let map ?(acc = []) f lst =
   in
   aux acc f (List.rev lst)
 
+let fold_right' f init lst = List.fold_left f init (List.rev lst)
+
 let filter_map f =
   let rec aux acc lst = match lst with
     | [] -> List.rev acc

src/ligo/mini_c/compiler.ml

@@ -327,29 +327,17 @@ and translate_statement ((s', w_env) as s:statement) : michelson result =
         let%bind expr = translate_expression expr in
         let%bind a' = translate_regular_block a in
         let%bind b' = translate_regular_block b in
-        let%bind restrict_a =
-          let env_a = (snd a).pre_environment in
-          Environment.to_michelson_restrict env_a in
-        let%bind restrict_b =
-          let env_b = (snd b).pre_environment in
-          Environment.to_michelson_restrict env_b in
         ok @@ (seq [
             i_push_unit ;
             expr ;
             prim I_CAR ;
             dip @@ Environment.to_michelson_extend w_env.pre_environment ;
-            prim ~children:[seq [a' ; restrict_a];seq [b' ; restrict_b]] I_IF ;
+            prim ~children:[seq [a'];seq [b']] I_IF ;
           ])
     | S_if_none (expr, none, (_, some)) ->
         let%bind expr = translate_expression expr in
         let%bind none' = translate_regular_block none in
         let%bind some' = translate_regular_block some in
-        let%bind restrict_none =
-          let env_none = (snd none).pre_environment in
-          Environment.to_michelson_restrict env_none in
-        let%bind restrict_some =
-          let env_some = (snd some).pre_environment in
-          Environment.to_michelson_restrict env_some in
         let%bind add =
           let env = Environment.extend w_env.pre_environment in
           Environment.to_michelson_anonymous_add env in
@@ -357,8 +345,8 @@ and translate_statement ((s', w_env) as s:statement) : michelson result =
             i_push_unit ; expr ; i_car ;
             dip @@ Environment.to_michelson_extend w_env.pre_environment ;
             prim ~children:[
-              seq [none' ; restrict_none] ;
+              seq [none'] ;
-              seq [add ; some' ; restrict_some] ;
+              seq [add ; some'] ;
             ] I_IF_NONE
           ])
     | S_while ((_, _, _) as expr, block) ->

src/ligo/transpiler.ml

@@ -147,11 +147,19 @@ and translate_instruction (env:Environment.t) (i:AST.instruction) : statement li
   | I_matching (expr, m) -> (
       let%bind expr' = translate_annotated_expression env expr in
       let env' = Environment.extend env in
+      let aux : block -> block = fun (lst, wrap) -> (* Takes a block and add a "restrict" statement at its end *)
+        let b_wrap = { wrap with post_environment = env } in
+        let s_wrap = {
+          pre_environment = wrap.post_environment ;
+          post_environment = env ;
+        } in
+        (lst @ [S_environment_restrict, s_wrap], b_wrap)
+      in
       match m with
       | Match_bool {match_true ; match_false} -> (
           let%bind true_branch = translate_block env' match_true in
           let%bind false_branch = translate_block env' match_false in
-          return (S_cond (expr', true_branch, false_branch))
+          return (S_cond (expr', aux true_branch, aux false_branch))
         )
       | Match_option {match_none ; match_some = ((name, t), sm)} -> (
           let%bind none_branch = translate_block env' match_none in
@@ -159,7 +167,7 @@ and translate_instruction (env:Environment.t) (i:AST.instruction) : statement li
             let%bind t' = translate_type t in
             let env' = Environment.add (name, t') env' in
             translate_block env' sm in
-          return (S_if_none (expr', none_branch, (name, some_branch)))
+          return (S_if_none (expr', aux none_branch, (name, aux some_branch)))
         )
       | _ -> simple_fail "todo : match"
     )
@@ -238,29 +246,6 @@ and translate_annotated_expression (env:Environment.t) (ae:AST.annotated_express
       let%bind tpl' = translate_annotated_expression env tpl in
       let expr = List.fold_left aux tpl' path in
       ok expr
-      (* let%bind tpl' = translate_annotated_expression env tpl in
-       * let%bind tpl_tv = get_t_tuple tpl.type_annotation in
-       * let node_tv = Append_tree.of_list @@ List.mapi (fun i a -> (i, a)) tpl_tv in
-       * let leaf (i, _) : expression result =
-       *   if i = ind then (
-       *     ok tpl'
-       *   ) else (
-       *     simple_fail "bad leaf"
-       *   ) in
-       * let node a b : expression result =
-       *   match%bind bind_lr (a, b) with
-       *   | `Left ((_, t, env) as ex) -> (
-       *       let%bind (a, _) = get_t_pair t in
-       *       ok (E_constant ("CAR", [ex]), a, env)
-       *     )
-       *   | `Right ((_, t, env) as ex) -> (
-       *       let%bind (_, b) = get_t_pair t in
-       *       ok (E_constant ("CDR", [ex]), b, env)
-       *     ) in
-       * let%bind expr =
-       *   trace_strong (simple_error "bad index in tuple (shouldn't happen here)") @@
-       *   Append_tree.fold_ne leaf node node_tv in
-       * ok expr *)
   | E_record m ->
       let node = Append_tree.of_list @@ list_of_map m in
       let aux a b : expression result =