Converters for michelson types

src/bin/expect_tests/michelson_converter.ml

@@ -0,0 +1,45 @@
+open Cli_expect
+
+let contract basename =
+  "../../test/contracts/" ^ basename
+let bad_contract basename =
+  "../../test/contracts/negative/" ^ basename
+
+let%expect_test _ =
+  run_ligo_bad [ "interpret" ; "--init-file="^(bad_contract "michelson_converter_no_annotation.mligo") ; "l4"] ;
+  [%expect {|
+    ligo: in file "michelson_converter_no_annotation.mligo", line 4, characters 9-39. can't retrieve declaration order in the converted record, you need to annotate it
+
+     If you're not sure how to fix this error, you can
+     do one of the following:
+
+    * Visit our documentation: https://ligolang.org/docs/intro/introduction
+    * Ask a question on our Discord: https://discord.gg/9rhYaEt
+    * Open a gitlab issue: https://gitlab.com/ligolang/ligo/issues/new
+    * Check the changelog by running 'ligo changelog' |}] ;
+
+  run_ligo_bad [ "interpret" ; "--init-file="^(bad_contract "michelson_converter_short_record.mligo") ; "l1"] ;
+  [%expect {|
+    ligo: in file "michelson_converter_short_record.mligo", line 4, characters 9-44. converted record must have at least two elements
+
+     If you're not sure how to fix this error, you can
+     do one of the following:
+
+    * Visit our documentation: https://ligolang.org/docs/intro/introduction
+    * Ask a question on our Discord: https://discord.gg/9rhYaEt
+    * Open a gitlab issue: https://gitlab.com/ligolang/ligo/issues/new
+    * Check the changelog by running 'ligo changelog' |}]
+
+let%expect_test _ =
+  run_ligo_good [ "interpret" ; "--init-file="^(contract "michelson_converter.mligo") ; "r3"] ;
+  [%expect {|
+    ( 2 , ( +3 , "q" ) ) |}] ;
+  run_ligo_good [ "interpret" ; "--init-file="^(contract "michelson_converter.mligo") ; "r4"] ;
+  [%expect {|
+    ( 2 , ( +3 , ( "q" , true ) ) ) |}] ;
+  run_ligo_good [ "interpret" ; "--init-file="^(contract "michelson_converter.mligo") ; "l3"] ;
+  [%expect {|
+    ( ( 2 , +3 ) , "q" ) |}] ;
+  run_ligo_good [ "interpret" ; "--init-file="^(contract "michelson_converter.mligo") ; "l4"] ;
+  [%expect {|
+    ( ( ( 2 , +3 ) , "q" ) , true ) |}] ;

src/passes/10-transpiler/transpiler.ml

@@ -228,6 +228,8 @@ let transpile_constant' : AST.constant' -> constant' = function
   | C_IMPLICIT_ACCOUNT -> C_IMPLICIT_ACCOUNT
   | C_SET_DELEGATE -> C_SET_DELEGATE
   | C_CREATE_CONTRACT -> C_CREATE_CONTRACT
+  | C_CONVERT_TO_LEFT_COMB -> C_CONVERT_TO_LEFT_COMB
+  | C_CONVERT_TO_RIGHT_COMB -> C_CONVERT_TO_RIGHT_COMB
 
 let rec transpile_type (t:AST.type_expression) : type_value result =
   match t.type_content with

src/passes/10-transpiler/untranspiler.ml

@@ -236,6 +236,8 @@ let rec untranspile (v : value) (t : AST.type_expression) : AST.expression resul
         | Empty -> fail @@ corner_case ~loc:__LOC__ "empty record"
         | Full t -> ok t in
       let%bind lst =
+        (* let () = Format.printf "\n%a\n" Ast_typed.PP.type_expression t in
+        let () = Format.printf "\n%a\n" Mini_c.PP.value v in *)
         trace_strong (corner_case ~loc:__LOC__ "record extract") @@
         extract_record v node in
       let%bind lst = bind_list

src/passes/2-concrete_to_imperative/cameligo.ml

@@ -294,14 +294,16 @@ and compile_type_expression : Raw.type_expr -> type_expression result = fun te -
   | TRecord r ->
       let (r, loc) = r_split r in
       let aux = fun (x, y) -> let%bind y = compile_type_expression y in ok (x, y) in
+      let order = fun i (x,y) -> ((x,i),y) in
       let apply (x:Raw.field_decl Raw.reg) =
         (x.value.field_name.value, x.value.field_type) in
       let%bind lst =
         bind_list
         @@ List.map aux
+        @@ List.mapi order
         @@ List.map apply
         @@ npseq_to_list r.ne_elements in
-      let m = List.fold_left (fun m (x, y) -> LMap.add (Label x) y m) LMap.empty lst in
+      let m = List.fold_left (fun m ((x,i), y) -> LMap.add (Label x) {field_type=y;decl_position=i} m) LMap.empty lst in
       ok @@ make_t ~loc @@ T_record m
   | TSum s ->
       let (s,loc) = r_split s in

src/passes/2-concrete_to_imperative/pascaligo.ml

@@ -224,13 +224,17 @@ let rec compile_type_expression (t:Raw.type_expr) : type_expression result =
         let%bind y = compile_type_expression y in
         ok (x, y)
       in
+      let order = fun i (x,y) ->
+        ((x,i),y)
+      in
       let apply =
         fun (x:Raw.field_decl Raw.reg) -> (x.value.field_name.value, x.value.field_type) in
       let%bind lst = bind_list
         @@ List.map aux
+        @@ List.mapi order
         @@ List.map apply
         @@ npseq_to_list r.ne_elements in
-      let m = List.fold_left (fun m (x, y) -> LMap.add (Label x) y m) LMap.empty lst in
+      let m = List.fold_left (fun m ((x,i), y) -> LMap.add (Label x) {field_type=y;decl_position=i} m) LMap.empty lst in
       ok @@ make_t ~loc @@ T_record m
   | TSum s ->
       let (s,loc) = r_split s in

src/passes/3-self_ast_imperative/helpers.ml

@@ -2,6 +2,13 @@ open Ast_imperative
 open Trace
 open Stage_common.Helpers
 
+let bind_map_lmap_t f map = bind_lmap (
+  LMap.map 
+    (fun ({field_type;_} as field) -> 
+      let%bind field_type = f field_type in
+      ok {field with field_type }) 
+    map)
+
 type 'a folder = 'a -> expression -> 'a result
 let rec fold_expression : 'a folder -> 'a -> expression -> 'a result = fun f init e ->
   let self = fold_expression f in 
@@ -253,7 +260,7 @@ and map_type_expression : ty_exp_mapper -> type_expression -> type_expression re
     let%bind temap' = bind_map_cmap self temap in
     return @@ (T_sum temap')
   | T_record temap ->
-    let%bind temap' = bind_map_lmap self temap in
+    let%bind temap' = bind_map_lmap_t self temap in
     return @@ (T_record temap')
   | T_tuple telst ->
     let%bind telst' = bind_map_list self telst in

src/passes/4-imperative_to_sugar/imperative_to_sugar.ml

@@ -145,9 +145,9 @@ let rec compile_type_expression : I.type_expression -> O.type_expression result
     | I.T_record record -> 
       let record = I.LMap.to_kv_list record in
       let%bind record = 
-        bind_map_list (fun (k,v) ->
+        bind_map_list (fun (k, ({field_type = v; decl_position ; _}:I.field_content)) ->
           let%bind v = compile_type_expression v in
-          let content : O.field_content = {field_type = v ; michelson_annotation = None} in
+          let content : O.field_content = {field_type = v; michelson_annotation = None ; decl_position} in
           ok @@ (k,content)
         ) record
       in
@@ -171,8 +171,8 @@ let rec compile_type_expression : I.type_expression -> O.type_expression result
     | I.T_operator (TC_michelson_pair (l,l_ann,r,r_ann)) ->
       let%bind (l,r) = bind_map_pair compile_type_expression (l,r) in
       let sum : (O.label * O.field_content) list = [
-        (O.Label "0" , {field_type = l ; michelson_annotation = Some l_ann}); 
+        (O.Label "0" , {field_type = l ; michelson_annotation = Some l_ann ; decl_position = 0}); 
-        (O.Label "1", {field_type = r ; michelson_annotation = Some r_ann}); ]
+        (O.Label "1", {field_type = r ; michelson_annotation = Some r_ann ; decl_position = 0}); ]
       in
       return @@ O.T_record (O.LMap.of_list sum)
     | I.T_operator type_operator ->
@@ -600,9 +600,9 @@ let rec uncompile_type_expression : O.type_expression -> I.type_expression resul
       let record = I.LMap.to_kv_list record in
       let%bind record = 
         bind_map_list (fun (k,v) ->
-          let {field_type;_} : O.field_content = v in
+          let {field_type;decl_position} : O.field_content = v in
           let%bind v = uncompile_type_expression field_type in
-          ok @@ (k,v)
+          ok @@ (k,({field_type=v;decl_position}:I.field_content))
         ) record
       in
       return @@ I.T_record (O.LMap.of_list record)

src/passes/6-sugar_to_core/sugar_to_core.ml

@@ -21,9 +21,9 @@ let rec idle_type_expression : I.type_expression -> O.type_expression result =
       let record = I.LMap.to_kv_list record in
       let%bind record = 
         bind_map_list (fun (k,v) ->
-          let {field_type ; michelson_annotation} : I.field_content = v in
+          let {field_type ; michelson_annotation ; decl_position} : I.field_content = v in
           let%bind field_type = idle_type_expression field_type in
-          let v' : O.field_content = {field_type ; field_annotation=michelson_annotation} in
+          let v' : O.field_content = {field_type ; field_annotation=michelson_annotation ; decl_position} in
           ok @@ (k,v')
         ) record
       in
@@ -31,7 +31,7 @@ let rec idle_type_expression : I.type_expression -> O.type_expression result =
     | I.T_tuple tuple ->
       let aux (i,acc) el = 
         let%bind el = idle_type_expression el in
-        ok @@ (i+1,(O.Label (string_of_int i), ({field_type=el;field_annotation=None}:O.field_content))::acc) in
+        ok @@ (i+1,(O.Label (string_of_int i), ({field_type=el;field_annotation=None;decl_position=0}:O.field_content))::acc) in
       let%bind (_, lst ) = bind_fold_list aux (0,[]) tuple in
       let record = O.LMap.of_list lst in
       return @@ O.T_record record
@@ -249,9 +249,9 @@ let rec uncompile_type_expression : O.type_expression -> I.type_expression resul
       let record = I.LMap.to_kv_list record in
       let%bind record = 
         bind_map_list (fun (k,v) ->
-          let {field_type;field_annotation} : O.field_content = v in
+          let {field_type;field_annotation;decl_position} : O.field_content = v in
           let%bind field_type = uncompile_type_expression field_type in
-          let v' : I.field_content = {field_type;michelson_annotation=field_annotation} in
+          let v' : I.field_content = {field_type ; michelson_annotation=field_annotation ; decl_position} in
           ok @@ (k,v')
         ) record
       in

src/passes/8-typer-new/todo_use_fold_generator.ml

@@ -133,3 +133,5 @@ let convert_constant' : I.constant' -> O.constant' = function
   | C_IMPLICIT_ACCOUNT -> C_IMPLICIT_ACCOUNT
   | C_SET_DELEGATE -> C_SET_DELEGATE
   | C_CREATE_CONTRACT -> C_CREATE_CONTRACT
+  | C_CONVERT_TO_LEFT_COMB -> C_CONVERT_TO_LEFT_COMB
+  | C_CONVERT_TO_RIGHT_COMB -> C_CONVERT_TO_RIGHT_COMB

src/passes/8-typer-new/typer.ml

@@ -142,9 +142,9 @@ and evaluate_type (e:environment) (t:I.type_expression) : O.type_expression resu
   | T_record m ->
     let aux k v prev =
       let%bind prev' = prev in
-      let {field_type ; field_annotation} : I.field_content = v in
+      let {field_type ; field_annotation ; decl_position} : I.field_content = v in
       let%bind field_type = evaluate_type e field_type in
-      ok @@ O.LMap.add (convert_label k) ({field_type ; michelson_annotation=field_annotation}:O.field_content) prev'
+      ok @@ O.LMap.add (convert_label k) ({field_type ; michelson_annotation=field_annotation ; decl_position}:O.field_content) prev'
     in
     let%bind m = I.LMap.fold aux m (ok O.LMap.empty) in
     return (T_record m)
@@ -300,7 +300,7 @@ and type_expression : environment -> O.typer_state -> ?tv_opt:O.type_expression
       ok (O.LMap.add (convert_label k) expr' acc , state')
     in
     let%bind (m' , state') = Stage_common.Helpers.bind_fold_lmap aux (ok (O.LMap.empty , state)) m in
-    let wrapped = Wrap.record (O.LMap.map (fun e -> ({field_type = get_type_expression e ; michelson_annotation = None}: O.field_content)) m') in
+    let wrapped = Wrap.record (O.LMap.map (fun e -> ({field_type = get_type_expression e ; michelson_annotation = None ; decl_position = 0}: O.field_content)) m') in
     return_wrapped (E_record m') state' wrapped
   | E_record_update {record; path; update} ->
     let%bind (record, state) = type_expression e state record in

src/passes/8-typer-new/untyper.ml

@@ -135,6 +135,8 @@ let unconvert_constant' : O.constant' -> I.constant' = function
   | C_IMPLICIT_ACCOUNT -> C_IMPLICIT_ACCOUNT
   | C_SET_DELEGATE -> C_SET_DELEGATE
   | C_CREATE_CONTRACT -> C_CREATE_CONTRACT
+  | C_CONVERT_TO_LEFT_COMB -> C_CONVERT_TO_LEFT_COMB
+  | C_CONVERT_TO_RIGHT_COMB -> C_CONVERT_TO_RIGHT_COMB
 
 let untype_type_value (t:O.type_expression) : (I.type_expression) result =
   match t.type_meta with
@@ -156,10 +158,10 @@ let rec untype_type_expression (t:O.type_expression) : (I.type_expression) resul
     let%bind x' = O.CMap.fold aux x (ok I.CMap.empty) in
     ok @@ I.T_sum x'
   | O.T_record x ->
-    let aux k ({field_type ; michelson_annotation} : O.field_content) acc =
+    let aux k ({field_type ; michelson_annotation ; decl_position} : O.field_content) acc =
       let%bind acc = acc in
       let%bind field_type = untype_type_expression field_type in
-      let v' = ({field_type ; field_annotation=michelson_annotation} : I.field_content) in
+      let v' = ({field_type ; field_annotation=michelson_annotation ; decl_position} : I.field_content) in
       ok @@ I.LMap.add (unconvert_label k) v' acc in
     let%bind x' = O.LMap.fold aux x (ok I.LMap.empty) in
     ok @@ I.T_record x'

src/passes/8-typer-old/typer.ml

@@ -350,6 +350,8 @@ let convert_constant' : I.constant' -> O.constant' = function
   | C_IMPLICIT_ACCOUNT -> C_IMPLICIT_ACCOUNT
   | C_SET_DELEGATE -> C_SET_DELEGATE
   | C_CREATE_CONTRACT -> C_CREATE_CONTRACT
+  | C_CONVERT_TO_LEFT_COMB -> C_CONVERT_TO_LEFT_COMB
+  | C_CONVERT_TO_RIGHT_COMB -> C_CONVERT_TO_RIGHT_COMB
 
 let unconvert_constant' : O.constant' -> I.constant' = function
   | C_INT -> C_INT
@@ -465,6 +467,8 @@ let unconvert_constant' : O.constant' -> I.constant' = function
   | C_IMPLICIT_ACCOUNT -> C_IMPLICIT_ACCOUNT
   | C_SET_DELEGATE -> C_SET_DELEGATE
   | C_CREATE_CONTRACT -> C_CREATE_CONTRACT
+  | C_CONVERT_TO_LEFT_COMB -> C_CONVERT_TO_LEFT_COMB
+  | C_CONVERT_TO_RIGHT_COMB -> C_CONVERT_TO_RIGHT_COMB
 
 let rec type_program (p:I.program) : (O.program * O.typer_state) result =
   let aux (e, acc:(environment * O.declaration Location.wrap list)) (d:I.declaration Location.wrap) =
@@ -604,10 +608,10 @@ and evaluate_type (e:environment) (t:I.type_expression) : O.type_expression resu
       let%bind m = I.CMap.fold aux m (ok O.CMap.empty) in
       return (T_sum m)
   | T_record m ->
-      let aux k ({field_type;field_annotation}: I.field_content) prev =
+      let aux k ({field_type;field_annotation;decl_position}: I.field_content) prev =
         let%bind prev' = prev in
         let%bind field_type = evaluate_type e field_type in
-        let v' = ({field_type;michelson_annotation=field_annotation} : O.field_content) in
+        let v' = ({field_type;michelson_annotation=field_annotation;decl_position} : O.field_content) in
         ok @@ O.LMap.add (convert_label k) v' prev'
       in
       let%bind m = I.LMap.fold aux m (ok O.LMap.empty) in
@@ -759,7 +763,10 @@ and type_expression' : environment -> ?tv_opt:O.type_expression -> I.expression
         ok (O.LMap.add (convert_label k) expr' prev)
       in
       let%bind m' = Stage_common.Helpers.bind_fold_lmap aux (ok O.LMap.empty) m in
-      let lmap = O.LMap.map (fun e -> ({field_type = get_type_expression e; michelson_annotation = None}:O.field_content)) m' in
+      (* let () = match tv_opt with
+        Some _ -> Format.printf "YES"
+       | None -> Format.printf "NO" in *)
+      let lmap = O.LMap.map (fun e -> ({field_type = get_type_expression e; michelson_annotation = None; decl_position=0}:O.field_content)) m' in
       return (E_record m') (t_record lmap ())
   | E_record_update {record; path; update} ->
     let path = convert_label path in

src/passes/9-self_ast_typed/michelson_layout.ml

@@ -0,0 +1,62 @@
+open Ast_typed
+open Trace
+
+let get_label_map_from_env (v:expression_variable) (env: full_environment) : expression_label_map result = 
+  let%bind a = trace_option (simple_error "corner case") @@
+    Environment.get_opt v env in
+  ( match a.definition with
+    | ED_declaration { expr = {expression_content = E_record lmap_e;_} ; _} -> ok lmap_e
+    | _ -> simple_fail "corner case" )
+
+let rec to_right_comb_e l new_map =
+  match l with
+  | [] -> new_map 
+  | [ (_, expl) ; (_ , expr) ] ->
+    LMap.add_bindings [ (Label "0" , expl) ; (Label "1" , expr) ] new_map
+  | (_, exp)::tl ->
+    let new_map' = LMap.add (Label "0") exp new_map in
+    LMap.add (Label "1") ({exp with expression_content = E_record (to_right_comb_e tl new_map')}) new_map'
+
+let rec to_left_comb_e_ first l new_map =
+  match l with
+  | [] -> new_map 
+  | (_, expl) :: (_, expr) ::tl when first ->
+    let new_map' = LMap.add_bindings [ (Label "0" , expl) ; (Label "1" , expr) ] LMap.empty in
+    to_left_comb_e_ false tl new_map'
+  | (_,exp)::tl ->
+    let new_map' = LMap.add_bindings [
+      (Label "0" , {exp with expression_content = E_record new_map});
+      (Label "1" , exp ) ;] LMap.empty in
+    to_left_comb_e_ first tl new_map'
+
+let to_left_comb_e = to_left_comb_e_ true
+
+let to_sorted_kv_list (l_e:expression_label_map) (l_t:te_lmap) : (label * expression) list =
+  let l = List.combine (LMap.to_kv_list l_e) (LMap.to_kv_list l_t) in
+  let sorted' = List.sort
+    (fun (_,(_,{decl_position=a;_})) (_,(_,{decl_position=b;_})) -> Int.compare a b) l in
+  List.map (fun (e,_t) -> e) sorted'
+
+let peephole_expression : expression -> expression result = fun e ->
+  let return expression_content = ok { e with expression_content } in
+  match e.expression_content with
+  | E_constant {cons_name= (C_CONVERT_TO_RIGHT_COMB | C_CONVERT_TO_LEFT_COMB ) as converter;
+                arguments= [ {
+                  expression_content = record_exp;
+                  type_expression = {type_content = T_record lmap_t} }
+                ] } ->
+
+    let%bind lmap_e = match record_exp with
+      | E_record lmap_e -> ok lmap_e
+      | E_variable v -> get_label_map_from_env v e.environment
+      | _ -> simple_fail "corner case" in
+
+    let kvl = to_sorted_kv_list lmap_e lmap_t in 
+    let converted_exp = match converter with
+      | C_CONVERT_TO_RIGHT_COMB -> E_record (to_right_comb_e kvl LMap.empty)
+      | C_CONVERT_TO_LEFT_COMB -> E_record (to_left_comb_e kvl LMap.empty)
+      | _ -> e.expression_content
+    in
+
+    return converted_exp
+  | _ as e -> return e

src/passes/9-self_ast_typed/self_ast_typed.ml

@@ -1,7 +1,8 @@
 open Trace
 
 let all_passes = [
-  Tail_recursion.peephole_expression
+  Tail_recursion.peephole_expression ;
+  Michelson_layout.peephole_expression ;
 ]
 
 let contract_passes = [

src/passes/operators/helpers.ml

@@ -133,6 +133,65 @@ module Typer = struct
       type_expression_eq (t_bool () , b) in
     ok @@ t_bool ()
 
+  module Converter = struct
+    open Ast_typed
+
+    let record_checks kvl =
+      let%bind () = Assert.assert_true_err
+        (simple_error "converted record must have at least two elements")
+        (List.length kvl >=2) in
+      let all_undefined = List.for_all (fun (_,{decl_position;_}) -> decl_position = 0) kvl in
+      let%bind () = Assert.assert_true_err
+        (simple_error "can't retrieve declaration order in the converted record, you need to annotate it")
+        (not all_undefined) in
+      ok ()
+
+    let annotate_field (field:field_content) (ann:string) : field_content =
+      {field with michelson_annotation=Some ann}
+
+    let comb (t:type_content) : field_content =
+      let field_type = {
+        type_content = t ;
+        type_meta = None ;
+        location = Location.generated ; } in
+      {field_type ; michelson_annotation = Some "" ; decl_position = 0}
+
+    let rec to_right_comb_t l new_map =
+      match l with
+      | [] -> new_map
+      | [ (Label ann_l, field_content_l) ; (Label ann_r, field_content_r) ] ->
+        LMap.add_bindings [
+          (Label "0" , annotate_field field_content_l ann_l) ;
+          (Label "1" , annotate_field field_content_r ann_r) ] new_map
+      | (Label ann, field)::tl ->
+        let new_map' = LMap.add (Label "0") (annotate_field field ann) new_map in
+        LMap.add (Label "1") (comb (T_record (to_right_comb_t tl new_map'))) new_map'
+
+    let rec to_left_comb_t_ first l new_map =
+      match l with
+      | [] -> new_map
+      | (Label ann_l, field_content_l) :: (Label ann_r, field_content_r) ::tl when first ->
+        let new_map' = LMap.add_bindings [
+          (Label "0" , annotate_field field_content_l ann_l) ;
+          (Label "1" , annotate_field field_content_r ann_r) ] LMap.empty in
+        to_left_comb_t_ false tl new_map'
+      | (Label ann, field)::tl ->
+        let new_map' = LMap.add_bindings [
+          (Label "0" , comb (T_record new_map)) ;
+          (Label "1" , annotate_field field ann ) ;] LMap.empty in
+        to_left_comb_t_ first tl new_map'
+    
+    let to_left_comb_t = to_left_comb_t_ true
+
+    let convert_type_to_right_comb l =
+      let l' = List.sort (fun (_,{decl_position=a;_}) (_,{decl_position=b;_}) -> Int.compare a b) l in
+      T_record (to_right_comb_t l' LMap.empty)
+
+    let convert_type_to_left_comb l =
+      let l' = List.sort (fun (_,{decl_position=a;_}) (_,{decl_position=b;_}) -> Int.compare a b) l in
+      T_record (to_left_comb_t l' LMap.empty)
+  end
+
 end
 
 module Compiler = struct

src/passes/operators/helpers.mli

@@ -53,6 +53,15 @@ module Typer : sig
   val comparator : string -> typer
   val boolean_operator_2 : string -> typer
 
+  module Converter : sig
+
+    open Ast_typed
+
+    val record_checks : (label * field_content) list -> unit result
+    val convert_type_to_right_comb : (label * field_content) list -> type_content
+    val convert_type_to_left_comb : (label * field_content) list -> type_content
+
+  end
 end
 
 module Compiler : sig

src/passes/operators/operators.ml

@@ -156,6 +156,12 @@ module Concrete_to_imperative = struct
     | "String.sub"      -> Some C_SLICE
     | "String.concat"   -> Some C_CONCAT
 
+    (* michelson pair/or type converter module *)
+
+    | "Layout.convert_to_right_comb" -> Some C_CONVERT_TO_RIGHT_COMB
+    | "Layout.convert_to_left_comb" -> Some C_CONVERT_TO_LEFT_COMB
+    (* | "Layout.convert_from" -> Some C_CONVERT_FROM *)
+
     | _ -> None
 
 
@@ -271,6 +277,9 @@ module Concrete_to_imperative = struct
 
     | "assert"          -> Some C_ASSERTION
     | "size"            -> Some C_SIZE (* Deprecated *)
+    
+    | "Layout.convert_to_right_comb" -> Some C_CONVERT_TO_RIGHT_COMB
+    | "Layout.convert_to_left_comb" -> Some C_CONVERT_TO_LEFT_COMB
 
     | _ as c            -> pseudo_modules c
 
@@ -1155,6 +1164,20 @@ module Typer = struct
     let%bind () = assert_eq_1 hd elt in
     ok tl
 
+  let convert_to_right_comb = typer_1 "CONVERT_TO_RIGHT_COMB" @@ fun record ->
+    let%bind lmap = get_t_record record in
+    let kvl =  LMap.to_kv_list lmap in
+    let%bind () = Converter.record_checks kvl in
+    let pair = Converter.convert_type_to_right_comb kvl in
+    ok {record with type_content = pair}
+
+  let convert_to_left_comb = typer_1 "CONVERT_TO_LEFT_COMB" @@ fun record ->
+    let%bind lmap = get_t_record record in
+    let kvl =  LMap.to_kv_list lmap in
+    let%bind () = Converter.record_checks kvl in
+    let pair = Converter.convert_type_to_left_comb kvl in
+    ok {record with type_content = pair}
+  
   let constant_typers c : typer result = match c with
     | C_INT                 -> ok @@ int ;
     | C_UNIT                -> ok @@ unit ;
@@ -1247,6 +1270,8 @@ module Typer = struct
     | C_IMPLICIT_ACCOUNT    -> ok @@ implicit_account;
     | C_SET_DELEGATE        -> ok @@ set_delegate ;
     | C_CREATE_CONTRACT     -> ok @@ create_contract ;
+    | C_CONVERT_TO_RIGHT_COMB -> ok @@ convert_to_right_comb ;
+    | C_CONVERT_TO_LEFT_COMB  -> ok @@ convert_to_left_comb ;
     | _                     -> simple_fail @@ Format.asprintf "Typer not implemented for consant %a" PP.constant c
 
 

src/stages/1-ast_imperative/PP.ml

@@ -13,6 +13,12 @@ let cmap_sep value sep ppf m =
 
 let cmap_sep_d x = cmap_sep x (tag " ,@ ")
 
+let record_sep_t value sep ppf (m : 'a label_map) =
+  let lst = LMap.to_kv_list m in
+  let lst = List.sort_uniq (fun (Label a,_) (Label b,_) -> String.compare a b) lst in
+  let new_pp ppf (k, {field_type=v;_}) = fprintf ppf "@[<h>%a -> %a@]" label k value v in
+  fprintf ppf "%a" (list_sep new_pp sep) lst
+
 let record_sep value sep ppf (m : 'a label_map) =
   let lst = LMap.to_kv_list m in
   let lst = List.sort_uniq (fun (Label a,_) (Label b,_) -> String.compare a b) lst in
@@ -30,7 +36,7 @@ let rec type_expression' :
   fun f ppf te ->
   match te.type_content with
   | T_sum m -> fprintf ppf "sum[%a]" (cmap_sep_d f) m
-  | T_record m -> fprintf ppf "{%a}" (record_sep f (const ";")) m
+  | T_record m -> fprintf ppf "{%a}" (record_sep_t f (const ";")) m
   | T_tuple t -> fprintf ppf "(%a)" (list_sep_d f) t
   | T_arrow a -> fprintf ppf "%a -> %a" f a.type1 f a.type2
   | T_variable tv -> type_variable ppf tv

src/stages/1-ast_imperative/combinators.ml

@@ -38,7 +38,7 @@ let t_option ?loc o       : type_expression = make_t ?loc @@ T_operator (TC_opti
 let t_list ?loc t         : type_expression = make_t ?loc @@ T_operator (TC_list t)
 let t_variable ?loc n     : type_expression = make_t ?loc @@ T_variable (Var.of_name n)
 let t_record_ez ?loc lst =
-  let lst = List.map (fun (k, v) -> (Label k, v)) lst in
+  let lst = List.mapi (fun i (k, v) -> (Label k, {field_type=v;decl_position=i})) lst in
   let m = LMap.of_list lst in
   make_t ?loc @@ T_record m
 let t_record ?loc m  : type_expression =

src/stages/1-ast_imperative/types.ml

@@ -6,7 +6,7 @@ include Stage_common.Types
 
 type type_content =
   | T_sum of type_expression constructor_map
-  | T_record of type_expression label_map
+  | T_record of field_content label_map
   | T_tuple  of type_expression list
   | T_arrow of arrow
   | T_variable of type_variable
@@ -15,6 +15,8 @@ type type_content =
 
 and arrow = {type1: type_expression; type2: type_expression}
 
+and field_content = {field_type :type_expression ; decl_position : int} 
+
 and michelson_prct_annotation = string
 
 and type_operator =

src/stages/2-ast_sugar/combinators.ml

@@ -52,8 +52,8 @@ let t_record ?loc m  : type_expression =
   t_record_ez ?loc lst
 
 let t_pair ?loc (a , b) : type_expression = t_record_ez ?loc [
-  ("0",{field_type=a;michelson_annotation=None}) ;
+  ("0",{field_type=a ; michelson_annotation=None ; decl_position=0}) ;
-  ("1",{field_type=b;michelson_annotation=None})]
+  ("1",{field_type=b ; michelson_annotation=None ; decl_position=0})]
 let t_tuple ?loc lst    : type_expression = t_record_ez ?loc (tuple_to_record lst)
 
 let ez_t_sum ?loc (lst:((string * ctor_content) list)) : type_expression =

src/stages/2-ast_sugar/types.ml

@@ -21,7 +21,7 @@ and arrow = {type1: type_expression; type2: type_expression}
 
 and ctor_content = {ctor_type : type_expression ; michelson_annotation : string option}
 
-and field_content = {field_type : type_expression ; michelson_annotation : string option}
+and field_content = {field_type : type_expression ; michelson_annotation : string option ; decl_position : int}
 
 and type_operator =
   | TC_contract of type_expression

src/stages/4-ast_typed/PP.ml

@@ -175,6 +175,8 @@ let constant ppf : constant' -> unit = function
   | C_IMPLICIT_ACCOUNT      -> fprintf ppf "IMPLICIT_ACCOUNT"
   | C_SET_DELEGATE          -> fprintf ppf "SET_DELEGATE"
   | C_CREATE_CONTRACT       -> fprintf ppf "CREATE_CONTRACT"
+  | C_CONVERT_TO_RIGHT_COMB -> fprintf ppf "CONVERT_TO_RIGHT_COMB"
+  | C_CONVERT_TO_LEFT_COMB  -> fprintf ppf "CONVERT_TO_LEFT_COMB"
 
 let literal ppf (l : literal) =
   match l with

src/stages/4-ast_typed/combinators.ml

@@ -51,15 +51,19 @@ let t_list t ?loc ?s ()     : type_expression = make_t ?loc (T_operator (TC_list
 let t_set t ?loc ?s ()      : type_expression = make_t ?loc (T_operator (TC_set t)) s
 let t_contract t ?loc ?s () : type_expression = make_t ?loc (T_operator (TC_contract t)) s
 
+
 let t_record m ?loc ?s () : type_expression = make_t ?loc (T_record m) s
 let make_t_ez_record ?loc (lst:(string * type_expression) list) : type_expression =
-  let lst = List.map (fun (x,y) -> (Label x, {field_type=y;michelson_annotation=None}) ) lst in
+  let lst = List.mapi (fun i (x,y) -> (Label x, {field_type=y;michelson_annotation=None;decl_position=i}) ) lst in
   let map = LMap.of_list lst in
   make_t ?loc (T_record map) None
 let ez_t_record lst ?loc ?s () : type_expression =
   let m = LMap.of_list lst in
   t_record m ?loc ?s ()
-let t_pair a b ?loc ?s ()   : type_expression = ez_t_record [(Label "0",{field_type=a;michelson_annotation=None}) ; (Label "1",{field_type=b;michelson_annotation=None})] ?loc ?s ()
+let t_pair a b ?loc ?s () : type_expression =
+  ez_t_record [
+    (Label "0",{field_type=a;michelson_annotation=None ; decl_position = 0}) ;
+    (Label "1",{field_type=b;michelson_annotation=None ; decl_position = 0}) ] ?loc ?s ()
 
 let t_map ?loc k v ?s () = make_t ?loc (T_operator (TC_map { k ; v })) s
 let t_big_map ?loc k v ?s () = make_t ?loc (T_operator (TC_big_map { k ; v })) s
@@ -183,7 +187,7 @@ let get_t_function_full (t:type_expression) : (type_expression * type_expression
     | _ -> ([],t)
   in
   let (input,output) = aux 0 t in
-  let input = List.map (fun (l,t) -> (l,{field_type = t ; michelson_annotation = None})) input in
+  let input = List.map (fun (l,t) -> (l,{field_type = t ; michelson_annotation = None ; decl_position = 0})) input in
   ok @@ (t_record (LMap.of_list input) (),output) 
 
 let get_t_sum (t:type_expression) : ctor_content constructor_map result = match t.type_content with
@@ -242,6 +246,10 @@ let assert_t_list t =
   let%bind _ = get_t_list t in
   ok ()
 
+let assert_t_record t =
+  let%bind _ = get_t_record t in
+  ok ()
+
 let is_t_list = Function.compose to_bool get_t_list
 let is_t_set = Function.compose to_bool get_t_set
 let is_t_nat = Function.compose to_bool get_t_nat
@@ -324,11 +332,11 @@ let e_a_record r = make_e (e_record r) (t_record
   (LMap.map
     (fun t ->
       let field_type = get_type_expression t in
-      {field_type ; michelson_annotation=None} )
+      {field_type ; michelson_annotation=None ; decl_position = 0} )
     r ) () )
 let e_a_application a b = make_e (e_application a b) (get_type_expression b)
 let e_a_variable v ty = make_e (e_variable v) ty
-let ez_e_a_record r = make_e (ez_e_record r) (ez_t_record (List.map (fun (x, y) -> x, {field_type = y.type_expression ; michelson_annotation = None}) r) ())
+let ez_e_a_record r = make_e (ez_e_record r) (ez_t_record (List.mapi (fun i (x, y) -> x, {field_type = y.type_expression ; michelson_annotation = None ; decl_position = i}) r) ())
 let e_a_let_in binder expr body attributes = make_e (e_let_in binder expr body attributes) (get_type_expression body)
 
 

src/stages/4-ast_typed/combinators.mli

@@ -103,6 +103,7 @@ val assert_t_nat : type_expression -> unit result
 val assert_t_bool : type_expression -> unit result
 val assert_t_unit : type_expression -> unit result
 val assert_t_contract : type_expression -> unit result
+val assert_t_record : type_expression -> unit result
 (*
 val e_record : ae_map -> expression
 val ez_e_record : ( string * expression ) list -> expression

src/stages/4-ast_typed/helpers.ml

@@ -174,7 +174,7 @@ let is_michelson_pair (t: _ label_map) =
   LMap.cardinal t = 2 && 
   let l = LMap.to_list t in
   List.fold_left
-    (fun prev {field_type=_;michelson_annotation} -> match michelson_annotation with
+    (fun prev {michelson_annotation;_} -> match michelson_annotation with
       | Some _ -> true
       | None -> prev)
     false 

src/stages/4-ast_typed/types.ml

@@ -45,6 +45,7 @@ and ctor_content = {
 and field_content = {
     field_type : type_expression;
     michelson_annotation : annot_option;
+    decl_position : int;
 }
 
 and type_map_args = {
@@ -254,6 +255,8 @@ and constant' =
   | C_IMPLICIT_ACCOUNT
   | C_SET_DELEGATE
   | C_CREATE_CONTRACT
+  | C_CONVERT_TO_LEFT_COMB
+  | C_CONVERT_TO_RIGHT_COMB
 
 and declaration_loc = declaration location_wrap
 

src/stages/5-mini_c/PP.ml

@@ -248,6 +248,8 @@ and constant ppf : constant' -> unit = function
   | C_IMPLICIT_ACCOUNT      -> fprintf ppf "IMPLICIT_ACCOUNT"
   | C_SET_DELEGATE          -> fprintf ppf "SET_DELEGATE"
   | C_CREATE_CONTRACT       -> fprintf ppf "CREATE_CONTRACT"
+  | C_CONVERT_TO_RIGHT_COMB -> fprintf ppf "CONVERT_TO_RIGHT_COMB"
+  | C_CONVERT_TO_LEFT_COMB  -> fprintf ppf "CONVERT_TO_LEFT_COMB"
 
 let%expect_test _ =
   Format.printf "%a" value (D_bytes (Bytes.of_string "foo")) ;

src/stages/common/PP.ml

@@ -125,6 +125,8 @@ let constant ppf : constant' -> unit = function
   | C_IMPLICIT_ACCOUNT      -> fprintf ppf "IMPLICIT_ACCOUNT"
   | C_SET_DELEGATE          -> fprintf ppf "SET_DELEGATE"
   | C_CREATE_CONTRACT       -> fprintf ppf "CREATE_CONTRACT"
+  | C_CONVERT_TO_RIGHT_COMB -> fprintf ppf "CONVERT_TO_RIGHT_COMB"
+  | C_CONVERT_TO_LEFT_COMB  -> fprintf ppf "CONVERT_TO_LEFT_COMB"
 
 let literal ppf (l : literal) =
   match l with

src/stages/common/types.ml

@@ -49,7 +49,7 @@ module Ast_generic_type (PARAMETER : AST_PARAMETER_TYPE) = struct
   
   and ctor_content = {ctor_type : type_expression ; michelson_annotation : string option}
 
-  and field_content = {field_type : type_expression ; field_annotation : string option}
+  and field_content = {field_type : type_expression ; field_annotation : string option ; decl_position : int}
 
   and type_operator =
     | TC_contract of type_expression
@@ -294,3 +294,5 @@ and constant' =
   | C_IMPLICIT_ACCOUNT
   | C_SET_DELEGATE
   | C_CREATE_CONTRACT
+  | C_CONVERT_TO_LEFT_COMB
+  | C_CONVERT_TO_RIGHT_COMB

src/test/contracts/michelson_converter.mligo

@@ -0,0 +1,11 @@
+type t3 = { foo : int ; bar : nat ;  baz : string}
+let v3 = { foo = 2 ; bar = 3n ; baz = "q" }
+
+type t4 = { one: int ; two : nat ; three : string ; four : bool}
+let v4 = { one = 2 ; two = 3n ; three = "q" ; four = true }
+
+let r3 = Layout.convert_to_right_comb (v3:t3)
+let r4 = Layout.convert_to_right_comb (v4:t4)
+
+let l3 = Layout.convert_to_left_comb (v3:t3)
+let l4 = Layout.convert_to_left_comb (v4:t4)

src/test/contracts/negative/michelson_converter_no_annotation.mligo

@@ -0,0 +1,4 @@
+type t4 = { one: int ; two : nat ; three : string ; four : bool}
+let v4 = { one = 2 ; two = 3n ; three = "q" ; four = true }
+
+let l4 = Layout.convert_to_left_comb v4

src/test/contracts/negative/michelson_converter_short_record.mligo

@@ -0,0 +1,4 @@
+type t1 = { foo : int }
+let v1 = { foo = 2 }
+
+let l1 = Layout.convert_to_left_comb (v1:t1)

vendors/ligo-utils/simple-utils/trace.ml

@@ -752,6 +752,10 @@ module Assert = struct
      true -> ok ()
   | false -> simple_fail msg
 
+  let assert_true_err err = function
+    | true -> ok ()
+    | false -> fail err
+
   let assert_equal ?msg expected actual =
     assert_true ?msg (expected = actual)
 

vendors/ligo-utils/simple-utils/x_map.ml

@@ -6,6 +6,7 @@ module type S = sig
   val of_list : (key * 'a) list -> 'a t
   val to_list : 'a t -> 'a list
   val to_kv_list : 'a t -> (key * 'a) list
+  val add_bindings : (key * 'a) list -> 'a t -> 'a t
 end
 
 module Make(Ord : Map.OrderedType) : S with type key = Ord.t = struct
@@ -22,6 +23,10 @@ module Make(Ord : Map.OrderedType) : S with type key = Ord.t = struct
   let to_kv_list (t: 'a t) : (key * 'a) list =
     let aux k v prev = (k, v) :: prev in
     fold aux t []
+  
+  let add_bindings (kvl:(key * 'a) list) (m:'a t) =
+    let aux prev (k, v) = add k v prev in
+    List.fold_left aux m kvl
 end
 
 module String = Make(String)