convert_from for pairs/record
This commit is contained in:
parent
9d200a1b56
commit
1f6bc4fc6b
@ -44,6 +44,52 @@ let%expect_test _ =
|
||||
[%expect {|
|
||||
( ( ( 2 , +3 ) , "q" ) , true ) |}]
|
||||
|
||||
let%expect_test _ =
|
||||
run_ligo_good [ "dry-run" ; (contract "michelson_converter.mligo") ; "main_r" ; "test_input_pair_r" ; "s"] ;
|
||||
[%expect {|
|
||||
( LIST_EMPTY() , "eqeq" ) |}] ;
|
||||
run_ligo_good [ "compile-contract" ; (contract "michelson_converter.mligo") ; "main_r" ] ;
|
||||
[%expect {|
|
||||
{ parameter (pair (int %one) (pair (nat %two) (pair (string %three) (bool %four)))) ;
|
||||
storage string ;
|
||||
code { DUP ;
|
||||
CAR ;
|
||||
DUP ;
|
||||
CDR ;
|
||||
CDR ;
|
||||
CAR ;
|
||||
DIG 1 ;
|
||||
DUP ;
|
||||
DUG 2 ;
|
||||
CDR ;
|
||||
CDR ;
|
||||
CAR ;
|
||||
CONCAT ;
|
||||
NIL operation ;
|
||||
PAIR ;
|
||||
DIP { DROP 2 } } } |}];
|
||||
run_ligo_good [ "dry-run" ; (contract "michelson_converter.mligo") ; "main_l" ; "test_input_pair_l" ; "s"] ;
|
||||
[%expect {|
|
||||
( LIST_EMPTY() , "eqeq" ) |}] ;
|
||||
run_ligo_good [ "compile-contract" ; (contract "michelson_converter.mligo") ; "main_l" ] ;
|
||||
[%expect {|
|
||||
{ parameter (pair (pair (pair (int %one) (nat %two)) (string %three)) (bool %four)) ;
|
||||
storage string ;
|
||||
code { DUP ;
|
||||
CAR ;
|
||||
DUP ;
|
||||
CAR ;
|
||||
CDR ;
|
||||
DIG 1 ;
|
||||
DUP ;
|
||||
DUG 2 ;
|
||||
CAR ;
|
||||
CDR ;
|
||||
CONCAT ;
|
||||
NIL operation ;
|
||||
PAIR ;
|
||||
DIP { DROP 2 } } } |}]
|
||||
|
||||
let%expect_test _ =
|
||||
run_ligo_good [ "compile-contract" ; contract "michelson_comb_type_operators.mligo" ; "main_r"] ;
|
||||
[%expect {|
|
||||
|
@ -230,6 +230,8 @@ let transpile_constant' : AST.constant' -> constant' = function
|
||||
| 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
|
||||
| C_CONVERT_FROM_LEFT_COMB -> C_CONVERT_FROM_LEFT_COMB
|
||||
| C_CONVERT_FROM_RIGHT_COMB -> C_CONVERT_FROM_RIGHT_COMB
|
||||
|
||||
let rec transpile_type (t:AST.type_expression) : type_value result =
|
||||
match t.type_content with
|
||||
|
@ -135,3 +135,5 @@ let convert_constant' : I.constant' -> O.constant' = function
|
||||
| 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
|
||||
| C_CONVERT_FROM_LEFT_COMB -> C_CONVERT_FROM_LEFT_COMB
|
||||
| C_CONVERT_FROM_RIGHT_COMB -> C_CONVERT_FROM_RIGHT_COMB
|
||||
|
@ -137,6 +137,8 @@ let unconvert_constant' : O.constant' -> I.constant' = function
|
||||
| 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
|
||||
| C_CONVERT_FROM_LEFT_COMB -> C_CONVERT_FROM_LEFT_COMB
|
||||
| C_CONVERT_FROM_RIGHT_COMB -> C_CONVERT_FROM_RIGHT_COMB
|
||||
|
||||
let untype_type_value (t:O.type_expression) : (I.type_expression) result =
|
||||
match t.type_meta with
|
||||
|
@ -360,6 +360,8 @@ let convert_constant' : I.constant' -> O.constant' = function
|
||||
| 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
|
||||
| C_CONVERT_FROM_LEFT_COMB -> C_CONVERT_FROM_LEFT_COMB
|
||||
| C_CONVERT_FROM_RIGHT_COMB -> C_CONVERT_FROM_RIGHT_COMB
|
||||
|
||||
let unconvert_constant' : O.constant' -> I.constant' = function
|
||||
| C_INT -> C_INT
|
||||
@ -477,6 +479,8 @@ let unconvert_constant' : O.constant' -> I.constant' = function
|
||||
| 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
|
||||
| C_CONVERT_FROM_LEFT_COMB -> C_CONVERT_FROM_LEFT_COMB
|
||||
| C_CONVERT_FROM_RIGHT_COMB -> C_CONVERT_FROM_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) =
|
||||
|
@ -1,62 +1,115 @@
|
||||
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 to_sorted_kv_list lmap =
|
||||
List.sort (fun (_,{decl_position=a;_}) (_,{decl_position=b;}) -> Int.compare a b) @@
|
||||
LMap.to_kv_list lmap
|
||||
|
||||
let rec to_right_comb_e l new_map =
|
||||
let accessor (record:expression) (path:label) (t:type_expression) =
|
||||
{ expression_content = E_record_accessor {record; path} ;
|
||||
location = Location.generated ;
|
||||
type_expression = t ;
|
||||
environment = record.environment}
|
||||
|
||||
let rec to_left_comb' first prev l conv_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'
|
||||
| [] -> conv_map
|
||||
| (label_l, {field_type=t_l}) :: (label_r, {field_type=t_r})::tl when first ->
|
||||
let exp_l = accessor prev label_l t_l in
|
||||
let exp_r = accessor prev label_r t_r in
|
||||
let conv_map' = LMap.add_bindings [ (Label "0" , exp_l) ; (Label "1" , exp_r) ] LMap.empty in
|
||||
to_left_comb' false prev tl conv_map'
|
||||
| (label, {field_type=t})::tl ->
|
||||
let conv_map' = LMap.add_bindings [
|
||||
(Label "0" , {prev with expression_content = E_record conv_map});
|
||||
(Label "1" , accessor prev label t)]
|
||||
LMap.empty in
|
||||
to_left_comb' first prev tl conv_map'
|
||||
|
||||
let rec to_left_comb_e_ first l new_map =
|
||||
let to_left_comb = to_left_comb' true
|
||||
|
||||
let rec to_right_comb
|
||||
(prev:expression)
|
||||
(l:(label * field_content) list)
|
||||
(conv_map: expression label_map) : expression label_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'
|
||||
| [] -> conv_map
|
||||
| [ (label_l,{field_type=tl}) ; (label_r,{field_type=tr}) ] ->
|
||||
let exp_l = accessor prev label_l tl in
|
||||
let exp_r = accessor prev label_r tr in
|
||||
LMap.add_bindings [ (Label "0" , exp_l) ; (Label "1" , exp_r) ] conv_map
|
||||
| (label,{field_type})::tl ->
|
||||
let exp = { expression_content = E_record_accessor {record = prev ; path = label } ;
|
||||
location = Location.generated ;
|
||||
type_expression = field_type ;
|
||||
environment = prev.environment } in
|
||||
let conv_map' = LMap.add (Label "0") exp conv_map in
|
||||
LMap.add (Label "1") ({exp with expression_content = E_record (to_right_comb prev tl conv_map')}) conv_map'
|
||||
|
||||
let to_left_comb_e = to_left_comb_e_ true
|
||||
let rec from_right_comb
|
||||
(prev:expression)
|
||||
(src_lmap: field_content label_map)
|
||||
(dst_kvl:(label * field_content) list)
|
||||
(conv_map:expression label_map) : expression label_map =
|
||||
match dst_kvl with
|
||||
| (label , {field_type;_}) :: (_::_ as tl) ->
|
||||
let intermediary_type = LMap.find (Label "1") src_lmap in
|
||||
let src_lmap' = match intermediary_type.field_type.type_content with
|
||||
| T_record a -> a
|
||||
| _ -> src_lmap in
|
||||
let conv_map' = LMap.add label (accessor prev (Label "0") field_type) conv_map in
|
||||
let next = accessor prev (Label "1") intermediary_type.field_type in
|
||||
from_right_comb next src_lmap' tl conv_map'
|
||||
| [(label,_)] -> LMap.add label prev conv_map
|
||||
| [] -> conv_map
|
||||
|
||||
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 rec from_left_comb'
|
||||
(prev:expression)
|
||||
(src_lmap: field_content label_map)
|
||||
(dst_kvl:(label * field_content) list)
|
||||
(conv_map:expression label_map) : expression label_map =
|
||||
match dst_kvl with
|
||||
| (label , {field_type;_}) :: (_::_ as tl) ->
|
||||
let intermediary_type = LMap.find (Label "0") src_lmap in
|
||||
let src_lmap' = match intermediary_type.field_type.type_content with
|
||||
| T_record a -> a
|
||||
| _ -> src_lmap in
|
||||
let conv_map' = LMap.add label (accessor prev (Label "1") field_type) conv_map in
|
||||
let next = accessor prev (Label "0") intermediary_type.field_type in
|
||||
from_left_comb' next src_lmap' tl conv_map'
|
||||
| [(label,_)] -> LMap.add label prev conv_map
|
||||
| [] -> conv_map
|
||||
|
||||
let from_left_comb prev src_lmap dst_kvl conv_map =
|
||||
from_left_comb' prev src_lmap (List.rev dst_kvl) conv_map
|
||||
|
||||
(**
|
||||
converts pair/record of a given layout to record/pair to another
|
||||
- foo = (a,(b,(c,d))) -> foo_converted = { a=foo.0 ; b=foo.1.0 ; c=foo.1.1.0 ; d=foo.1.1.1 }
|
||||
**)
|
||||
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
|
||||
| E_constant {cons_name= (C_CONVERT_TO_LEFT_COMB);
|
||||
arguments= [ to_convert ] } ->
|
||||
let%bind src_lmap = get_t_record to_convert.type_expression in
|
||||
let src_kvl = to_sorted_kv_list src_lmap in
|
||||
return @@ E_record (to_left_comb to_convert src_kvl LMap.empty)
|
||||
| E_constant {cons_name= (C_CONVERT_TO_RIGHT_COMB);
|
||||
arguments= [ to_convert ] } ->
|
||||
let%bind src_lmap = get_t_record to_convert.type_expression in
|
||||
let src_kvl = to_sorted_kv_list src_lmap in
|
||||
return @@ E_record (to_right_comb to_convert src_kvl LMap.empty)
|
||||
| E_constant {cons_name= (C_CONVERT_FROM_RIGHT_COMB);
|
||||
arguments= [ to_convert ] } ->
|
||||
let%bind dst_lmap = get_t_record e.type_expression in
|
||||
let%bind src_lmap = get_t_record to_convert.type_expression in
|
||||
let dst_kvl = to_sorted_kv_list dst_lmap in
|
||||
return @@ E_record (from_right_comb to_convert src_lmap dst_kvl LMap.empty)
|
||||
| E_constant {cons_name= (C_CONVERT_FROM_LEFT_COMB);
|
||||
arguments= [ to_convert ] } ->
|
||||
let%bind dst_lmap = get_t_record e.type_expression in
|
||||
let%bind src_lmap = get_t_record to_convert.type_expression in
|
||||
let dst_kvl = to_sorted_kv_list dst_lmap in
|
||||
return @@ E_record (from_left_comb to_convert src_lmap dst_kvl LMap.empty)
|
||||
| _ as e -> return e
|
||||
|
@ -135,6 +135,7 @@ module Typer = struct
|
||||
|
||||
module Converter = struct
|
||||
open Ast_typed
|
||||
open Trace
|
||||
|
||||
let record_checks kvl =
|
||||
let%bind () = Assert.assert_true_err
|
||||
@ -167,21 +168,20 @@ module Typer = struct
|
||||
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 =
|
||||
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'
|
||||
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
|
||||
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
|
||||
@ -190,6 +190,41 @@ module Typer = struct
|
||||
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)
|
||||
|
||||
let rec from_right_comb (l:field_content label_map) (size:int) : (field_content list) result =
|
||||
let l' = List.rev @@ LMap.to_kv_list l in
|
||||
match l' , size with
|
||||
| [ (_,l) ; (_,r) ] , 2 -> ok [ l ; r ]
|
||||
| [ (_,l) ; (_,{field_type=tr;_}) ], _ ->
|
||||
let%bind comb_lmap = get_t_record tr in
|
||||
let%bind next = from_right_comb comb_lmap (size-1) in
|
||||
ok (l :: next)
|
||||
| _ -> simple_fail "Could not convert michelson_right_comb pair to a record"
|
||||
|
||||
let rec from_left_comb (l:field_content label_map) (size:int) : (field_content list) result =
|
||||
let l' = List.rev @@ LMap.to_kv_list l in
|
||||
match l' , size with
|
||||
| [ (_,l) ; (_,r) ] , 2 -> ok [ l ; r ]
|
||||
| [ (_,{field_type=tl;_}) ; (_,r) ], _ ->
|
||||
let%bind comb_lmap = get_t_record tl in
|
||||
let%bind next = from_left_comb comb_lmap (size-1) in
|
||||
ok (List.append next [r])
|
||||
| _ -> simple_fail "Could not convert michelson_left_comb pair to a record"
|
||||
|
||||
let convert_from_right_comb (src: field_content label_map) (dst: field_content label_map) : type_content result =
|
||||
let%bind fields = from_right_comb src (LMap.cardinal dst) in
|
||||
let labels = List.map (fun (l,_) -> l) @@
|
||||
List.sort (fun (_,{decl_position=a;_}) (_,{decl_position=b;_}) -> Int.compare a b ) @@
|
||||
LMap.to_kv_list dst in
|
||||
ok @@ (T_record (LMap.of_list @@ List.combine labels fields))
|
||||
|
||||
let convert_from_left_comb (src: field_content label_map) (dst: field_content label_map) : type_content result =
|
||||
let%bind fields = from_left_comb src (LMap.cardinal dst) in
|
||||
let labels = List.map (fun (l,_) -> l) @@
|
||||
List.sort (fun (_,{decl_position=a;_}) (_,{decl_position=b;_}) -> Int.compare a b ) @@
|
||||
LMap.to_kv_list dst in
|
||||
ok @@ (T_record (LMap.of_list @@ List.combine labels fields))
|
||||
|
||||
end
|
||||
|
||||
end
|
||||
|
@ -60,6 +60,8 @@ module Typer : sig
|
||||
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
|
||||
val convert_from_right_comb : field_content label_map -> field_content label_map -> type_content result
|
||||
val convert_from_left_comb : field_content label_map -> field_content label_map -> type_content result
|
||||
|
||||
end
|
||||
end
|
||||
|
@ -161,7 +161,8 @@ module Concrete_to_imperative = struct
|
||||
|
||||
| "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 *)
|
||||
| "Layout.convert_from_right_comb" -> Some C_CONVERT_FROM_RIGHT_COMB
|
||||
| "Layout.convert_from_left_comb" -> Some C_CONVERT_FROM_LEFT_COMB
|
||||
|
||||
| _ -> None
|
||||
|
||||
@ -603,7 +604,7 @@ module Typer = struct
|
||||
| C_SELF_ADDRESS -> ok @@ t_self_address;
|
||||
| C_IMPLICIT_ACCOUNT -> ok @@ t_implicit_account;
|
||||
| C_SET_DELEGATE -> ok @@ t_set_delegate ;
|
||||
| c -> simple_fail @@ Format.asprintf "Typer not implemented for consant %a" Ast_typed.PP.constant c
|
||||
| c -> simple_fail @@ Format.asprintf "Typer not implemented for constant %a" Ast_typed.PP.constant c
|
||||
end
|
||||
|
||||
let none = typer_0 "NONE" @@ fun tv_opt ->
|
||||
@ -1180,6 +1181,20 @@ module Typer = struct
|
||||
let%bind () = Converter.record_checks kvl in
|
||||
let pair = Converter.convert_type_to_left_comb kvl in
|
||||
ok {record with type_content = pair}
|
||||
|
||||
let convert_from_right_comb = typer_1_opt "CONVERT_FROM_RIGHT_COMB" @@ fun pair opt ->
|
||||
let%bind dst_t = trace_option (simple_error "convert_from_right_comb must be annotated") opt in
|
||||
let%bind dst_lmap = get_t_record dst_t in
|
||||
let%bind src_lmap = get_t_record pair in
|
||||
let%bind record = Converter.convert_from_right_comb src_lmap dst_lmap in
|
||||
ok {pair with type_content = record}
|
||||
|
||||
let convert_from_left_comb = typer_1_opt "CONVERT_FROM_LEFT_COMB" @@ fun pair opt ->
|
||||
let%bind dst_t = trace_option (simple_error "convert_from_left_comb must be annotated") opt in
|
||||
let%bind dst_lmap = get_t_record dst_t in
|
||||
let%bind src_lmap = get_t_record pair in
|
||||
let%bind record = Converter.convert_from_left_comb src_lmap dst_lmap in
|
||||
ok {pair with type_content = record}
|
||||
|
||||
let constant_typers c : typer result = match c with
|
||||
| C_INT -> ok @@ int ;
|
||||
@ -1275,7 +1290,9 @@ module Typer = struct
|
||||
| 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
|
||||
| C_CONVERT_FROM_RIGHT_COMB -> ok @@ convert_from_right_comb ;
|
||||
| C_CONVERT_FROM_LEFT_COMB -> ok @@ convert_from_left_comb ;
|
||||
| _ -> simple_fail @@ Format.asprintf "Typer not implemented for constant %a" PP.constant c
|
||||
|
||||
|
||||
|
||||
|
@ -177,6 +177,8 @@ let constant ppf : constant' -> unit = function
|
||||
| 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"
|
||||
| C_CONVERT_FROM_RIGHT_COMB -> fprintf ppf "CONVERT_FROM_RIGHT_COMB"
|
||||
| C_CONVERT_FROM_LEFT_COMB -> fprintf ppf "CONVERT_FROM_LEFT_COMB"
|
||||
|
||||
let literal ppf (l : literal) =
|
||||
match l with
|
||||
|
@ -257,6 +257,8 @@ and constant' =
|
||||
| C_CREATE_CONTRACT
|
||||
| C_CONVERT_TO_LEFT_COMB
|
||||
| C_CONVERT_TO_RIGHT_COMB
|
||||
| C_CONVERT_FROM_LEFT_COMB
|
||||
| C_CONVERT_FROM_RIGHT_COMB
|
||||
|
||||
and declaration_loc = declaration location_wrap
|
||||
|
||||
|
@ -250,6 +250,8 @@ and constant ppf : constant' -> unit = function
|
||||
| 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"
|
||||
| C_CONVERT_FROM_RIGHT_COMB -> fprintf ppf "CONVERT_FROM_RIGHT_COMB"
|
||||
| C_CONVERT_FROM_LEFT_COMB -> fprintf ppf "CONVERT_FROM_LEFT_COMB"
|
||||
|
||||
let%expect_test _ =
|
||||
Format.printf "%a" value (D_bytes (Bytes.of_string "foo")) ;
|
||||
|
@ -127,6 +127,8 @@ let constant ppf : constant' -> unit = function
|
||||
| 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"
|
||||
| C_CONVERT_FROM_RIGHT_COMB -> fprintf ppf "CONVERT_FROM_RIGHT_COMB"
|
||||
| C_CONVERT_FROM_LEFT_COMB -> fprintf ppf "CONVERT_FROM_LEFT_COMB"
|
||||
|
||||
let literal ppf (l : literal) =
|
||||
match l with
|
||||
|
@ -306,3 +306,5 @@ and constant' =
|
||||
| C_CREATE_CONTRACT
|
||||
| C_CONVERT_TO_LEFT_COMB
|
||||
| C_CONVERT_TO_RIGHT_COMB
|
||||
| C_CONVERT_FROM_LEFT_COMB
|
||||
| C_CONVERT_FROM_RIGHT_COMB
|
||||
|
@ -1,11 +1,29 @@
|
||||
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 }
|
||||
|
||||
|
||||
(*convert to*)
|
||||
|
||||
let v3 = { foo = 2 ; bar = 3n ; baz = "q" }
|
||||
let r3 = Layout.convert_to_right_comb (v3:t3)
|
||||
let v4 = { one = 2 ; two = 3n ; three = "q" ; four = true }
|
||||
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)
|
||||
let l4 = Layout.convert_to_left_comb (v4:t4)
|
||||
|
||||
(*convert from*)
|
||||
|
||||
let s = "eq"
|
||||
let test_input_pair_r = (1,(2n,(s,true)))
|
||||
let test_input_pair_l = (((1,2n), s), true)
|
||||
type param_r = t4 michelson_right_comb
|
||||
type param_l = t4 michelson_left_comb
|
||||
|
||||
let main_r (p, s : param_r * string) : (operation list * string) =
|
||||
let r4 : t4 = Layout.convert_from_right_comb p in
|
||||
([] : operation list), r4.three ^ p.1.1.0
|
||||
|
||||
let main_l (p, s : param_l * string) : (operation list * string) =
|
||||
let r4 : t4 = Layout.convert_from_left_comb p in
|
||||
([] : operation list), r4.three ^ p.0.1
|
Loading…
Reference in New Issue
Block a user