add expression constructions to mini_c

src/compiler/compiler_program.ml

@@ -86,10 +86,14 @@ and translate_expression ?(first=false) (expr:expression) (env:environment) : (m
   let (expr' , ty) = Combinators.Expression.(get_content expr , get_type expr) in
   let error_message () = Format.asprintf  "%a" PP.expression expr in
 
-  let return ?env' code =
+  let return ?prepend_env ?end_env code =
-    let env' =
+    let%bind env' =
-      let default = env in
+      match (prepend_env , end_env) with
-      Environment.add ("_tmp_expression" , ty) @@ Option.unopt ~default env' in
+      | (Some _ , Some _) -> simple_fail ("two args to return at " ^ __LOC__)
+      | None , None -> ok @@ Environment.add ("_tmp_expression" , ty) env
+      | Some prepend_env , None ->
+        ok @@ Environment.add ("_tmp_expression" , ty) prepend_env
+      | None , Some end_env -> ok end_env in
     let%bind (Stack.Ex_stack_ty input_stack_ty) = Compiler_type.Ty.environment env in
     let%bind output_type = Compiler_type.type_ ty in
     let%bind (Stack.Ex_stack_ty output_stack_ty) = Compiler_type.Ty.environment env' in
@@ -120,6 +124,18 @@ and translate_expression ?(first=false) (expr:expression) (env:environment) : (m
   | E_environment_capture c ->
       let%bind code = Compiler_environment.pack_select env c in
       return @@ code
+  | E_environment_load (expr , load_env) ->
+      let%bind (expr' , _) = translate_expression expr env in
+      let%bind clear = Compiler_environment.select env [] in
+      let%bind unpack = Compiler_environment.unpack load_env in
+      return ~end_env:load_env @@ seq [
+        expr' ;
+        dip clear ;
+        unpack ;
+      ]
+  | E_environment_select sub_env ->
+      let%bind code = Compiler_environment.select_env env sub_env in
+      return ~end_env:sub_env code
   | E_literal v ->
       let%bind v = translate_value v in
       let%bind t = Compiler_type.type_ ty in
@@ -178,7 +194,7 @@ and translate_expression ?(first=false) (expr:expression) (env:environment) : (m
   | E_sequence (a , b) ->
     let%bind (a' , env_a) = translate_expression a env in
     let%bind (b' , env_b) = translate_expression b env_a in
-    return ~env':env_b @@ seq [
+    return ~prepend_env:env_b @@ seq [
       a' ;
       b' ;
     ]
@@ -292,6 +308,36 @@ and translate_expression ?(first=false) (expr:expression) (env:environment) : (m
         ]) in
       return code
     )
+  | E_assignment (name , lrs , expr) -> (
+      let%bind (expr' , env') = translate_expression expr env in
+      let%bind get_code = Compiler_environment.get env' name in
+      let modify_code =
+        let aux acc step = match step with
+          | `Left -> seq [dip i_unpair ; acc ; i_pair]
+          | `Right -> seq [dip i_unpiar ; acc ; i_piar]
+        in
+        let init = dip i_drop in
+        List.fold_right' aux init lrs
+      in
+      let%bind set_code = Compiler_environment.set env name in
+      let error =
+        let title () = "michelson type-checking patch" in
+        let content () =
+          let aux ppf = function
+            | `Left -> Format.fprintf ppf "left"
+            | `Right -> Format.fprintf ppf "right" in
+          Format.asprintf "Sub path: %a\n"
+            PP_helpers.(list_sep aux (const " , ")) lrs
+        in
+        error title content in
+      trace error @@
+      return ~end_env:env @@ seq [
+        expr' ;
+        get_code ;
+        i_swap ; modify_code ;
+        set_code ;
+      ]
+    )
 
 and translate_statement ((s', w_env) as s:statement) : michelson result =
   let error_message () = Format.asprintf "%a" PP.statement s in

src/mini_c/PP.ml

@@ -62,6 +62,8 @@ and value_assoc ppf : (value * value) -> unit = fun (a, b) ->
 
 and expression' ppf (e:expression') = match e with
   | E_environment_capture s -> fprintf ppf "capture(%a)" (list_sep string (const " ; ")) s
+  | E_environment_load (expr , env) -> fprintf ppf "load %a in %a" expression expr environment env
+  | E_environment_select env -> fprintf ppf "select %a" environment env
   | E_variable v -> fprintf ppf "%s" v
   | E_application(a, b) -> fprintf ppf "(%a)@(%a)" expression a expression b
   | E_constant(p, lst) -> fprintf ppf "%s %a" p (pp_print_list ~pp_sep:space_sep expression) lst
@@ -76,6 +78,8 @@ and expression' ppf (e:expression') = match e with
   | E_sequence (a , b) -> fprintf ppf "%a ; %a" expression a expression b
   | E_let_in ((name , _) , expr , body) ->
       fprintf ppf "let %s = %a in %a" name expression expr expression body
+  | E_assignment (r , path , e) ->
+      fprintf ppf "%s.%a := %a" r (list_sep lr (const ".")) path expression e
 
 and expression : _ -> expression -> _ = fun ppf e ->
   expression' ppf e.content

src/mini_c/types.ml

@@ -54,6 +54,8 @@ and selector = var_name list
 and expression' =
   | E_literal of value
   | E_environment_capture of selector
+  | E_environment_select of environment
+  | E_environment_load of (expression * environment)
   | E_constant of string * expression list
   | E_application of expression * expression
   | E_variable of var_name
@@ -65,6 +67,7 @@ and expression' =
   | E_if_left of expression * ((var_name * type_value) * expression) * ((var_name * type_value) * expression)
   | E_let_in of ((var_name * type_value) * expression * expression)
   | E_sequence of (expression * expression)
+  | E_assignment of (string * [`Left | `Right] list * expression)
 
 and expression = {
   content : expression' ;
@@ -98,10 +101,6 @@ and anon_function = {
   result : expression ;
 }
 
-and capture =
-  | No_capture (* For functions that don't capture their environments. Quotes. *)
-  | Deep_capture of environment (* Retrieves only the values it needs. Multiple SETs on init. Lighter GETs and SETs at use. *)
-
 and block' = statement list
 
 and block = block' * environment_wrap