From 0a44a22cacd3bee45dc14e095db7b9c2d3b74479 Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Thu, 30 Apr 2020 15:12:26 +0200 Subject: [PATCH] 'michelson_or_right_comb' and 'michelson_or_left_comb' type operators --- .../imperative_to_sugar.ml | 12 +++++++ src/passes/6-sugar_to_core/sugar_to_core.ml | 12 +++++++ src/passes/8-typer-new/typer.ml | 3 +- src/passes/8-typer-new/wrap.ml | 2 ++ src/passes/8-typer-old/typer.ml | 22 ++++++++++++ src/passes/operators/helpers.ml | 34 +++++++++++++++++++ src/passes/operators/helpers.mli | 2 ++ src/passes/operators/operators.ml | 21 ++++++++---- src/passes/operators/operators.mli | 2 ++ src/stages/1-ast_imperative/PP.ml | 2 ++ src/stages/1-ast_imperative/combinators.ml | 4 +++ src/stages/1-ast_imperative/types.ml | 2 ++ src/stages/2-ast_sugar/PP.ml | 2 ++ src/stages/2-ast_sugar/types.ml | 2 ++ src/stages/4-ast_typed/combinators.ml | 2 +- src/stages/common/PP.ml | 2 ++ src/stages/common/types.ml | 10 ++++++ .../contracts/michelson_converter_or.mligo | 18 +++++++++- 18 files changed, 145 insertions(+), 9 deletions(-) diff --git a/src/passes/4-imperative_to_sugar/imperative_to_sugar.ml b/src/passes/4-imperative_to_sugar/imperative_to_sugar.ml index 8e8036101..9365932f4 100644 --- a/src/passes/4-imperative_to_sugar/imperative_to_sugar.ml +++ b/src/passes/4-imperative_to_sugar/imperative_to_sugar.ml @@ -207,6 +207,12 @@ and compile_type_operator : I.type_operator -> O.type_operator result = | TC_michelson_pair_left_comb c -> let%bind c = compile_type_expression c in ok @@ O.TC_michelson_pair_left_comb c + | TC_michelson_or_right_comb c -> + let%bind c = compile_type_expression c in + ok @@ O.TC_michelson_or_right_comb c + | TC_michelson_or_left_comb c -> + let%bind c = compile_type_expression c in + ok @@ O.TC_michelson_or_left_comb c let rec compile_expression : I.expression -> O.expression result = fun e -> @@ -652,6 +658,12 @@ and uncompile_type_operator : O.type_operator -> I.type_operator result = | TC_michelson_pair_left_comb c -> let%bind c = uncompile_type_expression c in ok @@ I.TC_michelson_pair_left_comb c + | TC_michelson_or_right_comb c -> + let%bind c = uncompile_type_expression c in + ok @@ I.TC_michelson_or_right_comb c + | TC_michelson_or_left_comb c -> + let%bind c = uncompile_type_expression c in + ok @@ I.TC_michelson_or_left_comb c let rec uncompile_expression' : O.expression -> I.expression result = fun e -> diff --git a/src/passes/6-sugar_to_core/sugar_to_core.ml b/src/passes/6-sugar_to_core/sugar_to_core.ml index 972a26e9d..165ff5577 100644 --- a/src/passes/6-sugar_to_core/sugar_to_core.ml +++ b/src/passes/6-sugar_to_core/sugar_to_core.ml @@ -72,6 +72,12 @@ and idle_type_operator : I.type_operator -> O.type_operator result = | TC_michelson_pair_left_comb c -> let%bind c = idle_type_expression c in ok @@ O.TC_michelson_pair_left_comb c + | TC_michelson_or_right_comb c -> + let%bind c = idle_type_expression c in + ok @@ O.TC_michelson_or_right_comb c + | TC_michelson_or_left_comb c -> + let%bind c = idle_type_expression c in + ok @@ O.TC_michelson_or_left_comb c let rec compile_expression : I.expression -> O.expression result = fun e -> @@ -300,6 +306,12 @@ and uncompile_type_operator : O.type_operator -> I.type_operator result = | TC_michelson_pair_left_comb c -> let%bind c = uncompile_type_expression c in ok @@ I.TC_michelson_pair_left_comb c + | TC_michelson_or_right_comb c -> + let%bind c = uncompile_type_expression c in + ok @@ I.TC_michelson_or_right_comb c + | TC_michelson_or_left_comb c -> + let%bind c = uncompile_type_expression c in + ok @@ I.TC_michelson_or_left_comb c let rec uncompile_expression : O.expression -> I.expression result = fun e -> diff --git a/src/passes/8-typer-new/typer.ml b/src/passes/8-typer-new/typer.ml index 31c0f7a83..f524af386 100644 --- a/src/passes/8-typer-new/typer.ml +++ b/src/passes/8-typer-new/typer.ml @@ -181,7 +181,8 @@ and evaluate_type (e:environment) (t:I.type_expression) : O.type_expression resu | TC_contract c -> let%bind c = evaluate_type e c in ok @@ O.TC_contract c - | TC_michelson_pair_right_comb _c | TC_michelson_pair_left_comb _c -> + | TC_michelson_pair_right_comb _c | TC_michelson_pair_left_comb _c + | TC_michelson_or_right_comb _c | TC_michelson_or_left_comb _c -> (* not really sure what to do in the new typer, should be converted to a pair using functions defined in Helpers.Typer.Converter *) simple_fail "to be implemented" in diff --git a/src/passes/8-typer-new/wrap.ml b/src/passes/8-typer-new/wrap.ml index 8e98e2c4c..993750205 100644 --- a/src/passes/8-typer-new/wrap.ml +++ b/src/passes/8-typer-new/wrap.ml @@ -108,6 +108,8 @@ let rec type_expression_to_type_value_copypasted : I.type_expression -> O.type_v | TC_contract c -> (C_contract, [c]) | TC_michelson_pair_right_comb c -> (C_record, [c]) | TC_michelson_pair_left_comb c -> (C_record, [c]) + | TC_michelson_or_right_comb c -> (C_record, [c]) + | TC_michelson_or_left_comb c -> (C_record, [c]) ) in p_constant csttag (List.map type_expression_to_type_value_copypasted args) diff --git a/src/passes/8-typer-old/typer.ml b/src/passes/8-typer-old/typer.ml index b359cfed0..d0262f644 100644 --- a/src/passes/8-typer-old/typer.ml +++ b/src/passes/8-typer-old/typer.ml @@ -20,6 +20,14 @@ module Errors = struct ] in error ~data title message () + let michelson_comb_no_variant (loc:Location.t) () = + let title = (thunk "bad michelson_or_right_comb type parameter") in + let message () = "michelson_or_right_comb type operator must be used on a variant type" in + let data = [ + ("location" , fun () -> Format.asprintf "%a" Location.pp loc) ; + ] in + error ~data title message () + let unbound_type_variable (e:environment) (tv:I.type_variable) (loc:Location.t) () = let name = Var.to_name tv in let suggestion = match name with @@ -674,6 +682,20 @@ and evaluate_type (e:environment) (t:I.type_expression) : O.type_expression resu | _ -> fail (michelson_comb_no_record t.location) in let record = Operators.Typer.Converter.convert_pair_to_left_comb (Ast_typed.LMap.to_kv_list lmap) in return @@ record + | TC_michelson_or_right_comb c -> + let%bind c' = evaluate_type e c in + let%bind cmap = match c'.type_content with + | T_sum cmap -> ok cmap + | _ -> fail (michelson_comb_no_variant t.location) in + let pair = Operators.Typer.Converter.convert_variant_to_right_comb (Ast_typed.CMap.to_kv_list cmap) in + return @@ pair + | TC_michelson_or_left_comb c -> + let%bind c' = evaluate_type e c in + let%bind cmap = match c'.type_content with + | T_sum cmap -> ok cmap + | _ -> fail (michelson_comb_no_variant t.location) in + let pair = Operators.Typer.Converter.convert_variant_to_left_comb(Ast_typed.CMap.to_kv_list cmap) in + return @@ pair ) and type_expression : environment -> O.typer_state -> ?tv_opt:O.type_expression -> I.expression -> (O.expression * O.typer_state) result diff --git a/src/passes/operators/helpers.ml b/src/passes/operators/helpers.ml index 826499ce9..639f706ad 100644 --- a/src/passes/operators/helpers.ml +++ b/src/passes/operators/helpers.ml @@ -249,6 +249,26 @@ module Typer = struct ok (List.append next [r]) | _ -> simple_fail "Could not convert michelson_pair_left_comb pair to a record" + let rec from_right_comb_variant (l:ctor_content constructor_map) (size:int) : (ctor_content list) result = + let l' = List.rev @@ CMap.to_kv_list l in + match l' , size with + | [ (_,l) ; (_,r) ] , 2 -> ok [ l ; r ] + | [ (_,l) ; (_,{ctor_type=tr;_}) ], _ -> + let%bind comb_cmap = get_t_sum tr in + let%bind next = from_right_comb_variant comb_cmap (size-1) in + ok (l :: next) + | _ -> simple_fail "Could not convert michelson_or right comb to a variant" + + let rec from_left_comb_variant (l:ctor_content constructor_map) (size:int) : (ctor_content list) result = + let l' = List.rev @@ CMap.to_kv_list l in + match l' , size with + | [ (_,l) ; (_,r) ] , 2 -> ok [ l ; r ] + | [ (_,{ctor_type=tl;_}) ; (_,r) ], _ -> + let%bind comb_cmap = get_t_sum tl in + let%bind next = from_left_comb_variant comb_cmap (size-1) in + ok (List.append next [r]) + | _ -> simple_fail "Could not convert michelson_or left comb to a record" + let convert_pair_to_right_comb l = let l' = List.sort (fun (_,{field_decl_pos=a;_}) (_,{field_decl_pos=b;_}) -> Int.compare a b) l in T_record (to_right_comb_pair l' LMap.empty) @@ -279,6 +299,20 @@ module Typer = struct let l' = List.sort (fun (_,{ctor_decl_pos=a;_}) (_,{ctor_decl_pos=b;_}) -> Int.compare a b) l in T_sum (to_left_comb_variant l' CMap.empty) + let convert_variant_from_right_comb (src: ctor_content constructor_map) (dst: ctor_content constructor_map) : type_content result = + let%bind ctors = from_right_comb_variant src (CMap.cardinal dst) in + let ctors_name = List.map (fun (l,_) -> l) @@ + List.sort (fun (_,{ctor_decl_pos=a;_}) (_,{ctor_decl_pos=b;_}) -> Int.compare a b ) @@ + CMap.to_kv_list dst in + ok @@ (T_sum (CMap.of_list @@ List.combine ctors_name ctors)) + + let convert_variant_from_left_comb (src: ctor_content constructor_map) (dst: ctor_content constructor_map) : type_content result = + let%bind ctors = from_left_comb_variant src (CMap.cardinal dst) in + let ctors_name = List.map (fun (l,_) -> l) @@ + List.sort (fun (_,{ctor_decl_pos=a;_}) (_,{ctor_decl_pos=b;_}) -> Int.compare a b ) @@ + CMap.to_kv_list dst in + ok @@ (T_sum (CMap.of_list @@ List.combine ctors_name ctors)) + end end diff --git a/src/passes/operators/helpers.mli b/src/passes/operators/helpers.mli index 837705f0e..2138a218d 100644 --- a/src/passes/operators/helpers.mli +++ b/src/passes/operators/helpers.mli @@ -67,6 +67,8 @@ module Typer : sig val convert_variant_to_right_comb : (constructor' * ctor_content) list -> type_content val convert_variant_to_left_comb : (constructor' * ctor_content) list -> type_content + val convert_variant_from_right_comb : ctor_content constructor_map -> ctor_content constructor_map -> type_content result + val convert_variant_from_left_comb : ctor_content constructor_map -> ctor_content constructor_map -> type_content result end end diff --git a/src/passes/operators/operators.ml b/src/passes/operators/operators.ml index 046a300bc..ccb476b1d 100644 --- a/src/passes/operators/operators.ml +++ b/src/passes/operators/operators.ml @@ -61,6 +61,8 @@ module Concrete_to_imperative = struct | "contract" -> Some (TC_contract unit_expr) | "michelson_pair_right_comb" -> Some (TC_michelson_pair_right_comb unit_expr) | "michelson_pair_left_comb" -> Some (TC_michelson_pair_left_comb unit_expr) + | "michelson_or_right_comb" -> Some (TC_michelson_or_right_comb unit_expr) + | "michelson_or_left_comb" -> Some (TC_michelson_or_left_comb unit_expr) | _ -> None let pseudo_modules = function @@ -1196,12 +1198,19 @@ module Typer = struct ok {t with type_content = michelson_or} | _ -> simple_fail "converter can only be used on record or variants" - 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_pair_from_right_comb src_lmap dst_lmap in - ok {pair with type_content = record} + let convert_from_right_comb = typer_1_opt "CONVERT_FROM_RIGHT_COMB" @@ fun t opt -> + match t.type_content with + | T_record src_lmap -> + 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 record = Converter.convert_pair_from_right_comb src_lmap dst_lmap in + ok {t with type_content = record} + | T_sum src_cmap -> + let%bind dst_t = trace_option (simple_error "convert_from_right_comb must be annotated") opt in + let%bind dst_cmap = get_t_sum dst_t in + let%bind variant = Converter.convert_variant_from_right_comb src_cmap dst_cmap in + ok {t with type_content = variant} + | _ -> simple_fail "converter can only be used on record or variants" 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 diff --git a/src/passes/operators/operators.mli b/src/passes/operators/operators.mli index 5f5f62bb0..502d7af39 100644 --- a/src/passes/operators/operators.mli +++ b/src/passes/operators/operators.mli @@ -178,6 +178,8 @@ module Typer : sig val record_checks : (label * field_content) list -> unit result val convert_pair_to_right_comb : (label * field_content) list -> type_content val convert_pair_to_left_comb : (label * field_content) list -> type_content + val convert_variant_to_right_comb : (constructor' * ctor_content) list -> type_content + val convert_variant_to_left_comb : (constructor' * ctor_content) list -> type_content end end diff --git a/src/stages/1-ast_imperative/PP.ml b/src/stages/1-ast_imperative/PP.ml index 02deff4b7..6a2c835db 100644 --- a/src/stages/1-ast_imperative/PP.ml +++ b/src/stages/1-ast_imperative/PP.ml @@ -63,6 +63,8 @@ and type_operator : | TC_michelson_pair (l,_, r,_) -> Format.asprintf "Michelson_pair (%a,%a)" f l f r | TC_michelson_pair_right_comb e -> Format.asprintf "michelson_pair_right_comb (%a)" f e | TC_michelson_pair_left_comb e -> Format.asprintf "michelson_pair_left_comb (%a)" f e + | TC_michelson_or_right_comb e -> Format.asprintf "michelson_or_right_comb (%a)" f e + | TC_michelson_or_left_comb e -> Format.asprintf "michelson_or_left_comb (%a)" f e | TC_contract te -> Format.asprintf "Contract (%a)" f te in fprintf ppf "(TO_%s)" s diff --git a/src/stages/1-ast_imperative/combinators.ml b/src/stages/1-ast_imperative/combinators.ml index 8b6d47262..15a611ba2 100644 --- a/src/stages/1-ast_imperative/combinators.ml +++ b/src/stages/1-ast_imperative/combinators.ml @@ -65,6 +65,8 @@ let t_michelson_or ?loc l l_ann r r_ann : type_expression = make_t ?loc @@ T_ope let t_michelson_pair ?loc l l_ann r r_ann : type_expression = make_t ?loc @@ T_operator (TC_michelson_pair (l, l_ann, r, r_ann)) let t_michelson_pair_right_comb ?loc c : type_expression = make_t ?loc @@ T_operator (TC_michelson_pair_right_comb c) let t_michelson_pair_left_comb ?loc c : type_expression = make_t ?loc @@ T_operator (TC_michelson_pair_left_comb c) +let t_michelson_or_right_comb ?loc c : type_expression = make_t ?loc @@ T_operator (TC_michelson_or_right_comb c) +let t_michelson_or_left_comb ?loc c : type_expression = make_t ?loc @@ T_operator (TC_michelson_or_left_comb c) (* TODO find a better way than using list*) let t_operator ?loc op lst: type_expression result = @@ -78,6 +80,8 @@ let t_operator ?loc op lst: type_expression result = | TC_contract _ , [t] -> ok @@ t_contract t | TC_michelson_pair_right_comb _ , [c] -> ok @@ t_michelson_pair_right_comb c | TC_michelson_pair_left_comb _ , [c] -> ok @@ t_michelson_pair_left_comb c + | TC_michelson_or_right_comb _ , [c] -> ok @@ t_michelson_or_right_comb c + | TC_michelson_or_left_comb _ , [c] -> ok @@ t_michelson_or_left_comb c | _ , _ -> fail @@ bad_type_operator op let make_e ?(loc = Location.generated) expression_content = diff --git a/src/stages/1-ast_imperative/types.ml b/src/stages/1-ast_imperative/types.ml index 7a5146c65..baaefc48a 100644 --- a/src/stages/1-ast_imperative/types.ml +++ b/src/stages/1-ast_imperative/types.ml @@ -30,6 +30,8 @@ and type_operator = | TC_big_map of type_expression * type_expression | TC_michelson_or of type_expression * michelson_prct_annotation * type_expression * michelson_prct_annotation | TC_michelson_pair of type_expression * michelson_prct_annotation * type_expression * michelson_prct_annotation + | TC_michelson_or_right_comb of type_expression + | TC_michelson_or_left_comb of type_expression | TC_michelson_pair_right_comb of type_expression | TC_michelson_pair_left_comb of type_expression diff --git a/src/stages/2-ast_sugar/PP.ml b/src/stages/2-ast_sugar/PP.ml index 6525f2451..3f348c52c 100644 --- a/src/stages/2-ast_sugar/PP.ml +++ b/src/stages/2-ast_sugar/PP.ml @@ -54,6 +54,8 @@ and type_operator : (formatter -> type_expression -> unit) -> formatter -> type_ | TC_contract te -> Format.asprintf "Contract (%a)" f te | TC_michelson_pair_right_comb c -> Format.asprintf "michelson_pair_right_comb (%a)" f c | TC_michelson_pair_left_comb c -> Format.asprintf "michelson_pair_left_comb (%a)" f c + | TC_michelson_or_right_comb c -> Format.asprintf "michelson_or_right_comb (%a)" f c + | TC_michelson_or_left_comb c -> Format.asprintf "michelson_or_left_comb (%a)" f c in fprintf ppf "(TO_%s)" s diff --git a/src/stages/2-ast_sugar/types.ml b/src/stages/2-ast_sugar/types.ml index 0eb61e0a8..566f8ec35 100644 --- a/src/stages/2-ast_sugar/types.ml +++ b/src/stages/2-ast_sugar/types.ml @@ -32,6 +32,8 @@ and type_operator = | TC_big_map of type_expression * type_expression | TC_michelson_pair_right_comb of type_expression | TC_michelson_pair_left_comb of type_expression + | TC_michelson_or_right_comb of type_expression + | TC_michelson_or_left_comb of type_expression and type_expression = {type_content: type_content; location: Location.t} diff --git a/src/stages/4-ast_typed/combinators.ml b/src/stages/4-ast_typed/combinators.ml index de67e2a3d..eca86d173 100644 --- a/src/stages/4-ast_typed/combinators.ml +++ b/src/stages/4-ast_typed/combinators.ml @@ -76,7 +76,7 @@ let make_t_ez_sum ?loc ?s (lst:(constructor' * ctor_content) list) : type_expres make_t ?loc (T_sum map) s let t_bool ?loc ?s () : type_expression = make_t_ez_sum ?loc ?s - [(Constructor "true", {ctor_type=t_unit ();michelson_annotation=None});(Constructor "false", {ctor_type=t_unit ();michelson_annotation=None})] + [(Constructor "true", {ctor_type=t_unit ();michelson_annotation=None;ctor_decl_pos=0});(Constructor "false", {ctor_type=t_unit ();michelson_annotation=None;ctor_decl_pos=1})] let t_function param result ?loc ?s () : type_expression = make_t ?loc (T_arrow {type1=param; type2=result}) s let t_shallow_closure param result ?loc ?s () : type_expression = make_t ?loc (T_arrow {type1=param; type2=result}) s diff --git a/src/stages/common/PP.ml b/src/stages/common/PP.ml index 0789d5a44..2e72e085e 100644 --- a/src/stages/common/PP.ml +++ b/src/stages/common/PP.ml @@ -256,6 +256,8 @@ module Ast_PP_type (PARAMETER : AST_PARAMETER_TYPE) = struct | TC_contract te -> Format.asprintf "Contract (%a)" f te | TC_michelson_pair_right_comb c -> Format.asprintf "michelson_pair_right_comb (%a)" f c | TC_michelson_pair_left_comb c -> Format.asprintf "michelson_pair_left_comb (%a)" f c + | TC_michelson_or_right_comb c -> Format.asprintf "michelson_or_right_comb (%a)" f c + | TC_michelson_or_left_comb c -> Format.asprintf "michelson_or_left_comb (%a)" f c in fprintf ppf "(type_operator: %s)" s end diff --git a/src/stages/common/types.ml b/src/stages/common/types.ml index ecede3cb5..b97a9357d 100644 --- a/src/stages/common/types.ml +++ b/src/stages/common/types.ml @@ -61,6 +61,8 @@ module Ast_generic_type (PARAMETER : AST_PARAMETER_TYPE) = struct | TC_map_or_big_map of type_expression * type_expression | TC_michelson_pair_right_comb of type_expression | TC_michelson_pair_left_comb of type_expression + | TC_michelson_or_right_comb of type_expression + | TC_michelson_or_left_comb of type_expression and type_expression = {type_content: type_content; location: Location.t; type_meta: type_meta} @@ -76,6 +78,8 @@ module Ast_generic_type (PARAMETER : AST_PARAMETER_TYPE) = struct | TC_map_or_big_map (x , y)-> TC_map_or_big_map (f x , f y) | TC_michelson_pair_right_comb c -> TC_michelson_pair_right_comb (f c) | TC_michelson_pair_left_comb c -> TC_michelson_pair_left_comb (f c) + | TC_michelson_or_right_comb c -> TC_michelson_or_right_comb (f c) + | TC_michelson_or_left_comb c -> TC_michelson_or_left_comb (f c) let bind_map_type_operator f = function TC_contract x -> let%bind x = f x in ok @@ TC_contract x @@ -87,6 +91,8 @@ module Ast_generic_type (PARAMETER : AST_PARAMETER_TYPE) = struct | TC_map_or_big_map (x , y)-> let%bind x = f x in let%bind y = f y in ok @@ TC_map_or_big_map (x , y) | TC_michelson_pair_right_comb c -> let%bind c = f c in ok @@ TC_michelson_pair_right_comb c | TC_michelson_pair_left_comb c -> let%bind c = f c in ok @@ TC_michelson_pair_left_comb c + | TC_michelson_or_right_comb c -> let%bind c = f c in ok @@ TC_michelson_or_right_comb c + | TC_michelson_or_left_comb c -> let%bind c = f c in ok @@ TC_michelson_or_left_comb c let type_operator_name = function TC_contract _ -> "TC_contract" @@ -98,6 +104,8 @@ module Ast_generic_type (PARAMETER : AST_PARAMETER_TYPE) = struct | TC_map_or_big_map _ -> "TC_map_or_big_map" | TC_michelson_pair_right_comb _ -> "TC_michelson_pair_right_comb" | TC_michelson_pair_left_comb _ -> "TC_michelson_pair_left_comb" + | TC_michelson_or_right_comb _ -> "TC_michelson_or_right_comb" + | TC_michelson_or_left_comb _ -> "TC_michelson_or_left_comb" let type_expression'_of_string = function | "TC_contract" , [x] -> ok @@ T_operator(TC_contract x) @@ -137,6 +145,8 @@ module Ast_generic_type (PARAMETER : AST_PARAMETER_TYPE) = struct | TC_map_or_big_map (x , y) -> "TC_map_or_big_map" , [x ; y] | TC_michelson_pair_right_comb c -> "TC_michelson_pair_right_comb" , [c] | TC_michelson_pair_left_comb c -> "TC_michelson_pair_left_comb" , [c] + | TC_michelson_or_right_comb c -> "TC_michelson_or_right_comb" , [c] + | TC_michelson_or_left_comb c -> "TC_michelson_or_left_comb" , [c] let string_of_type_constant = function | TC_unit -> "TC_unit", [] diff --git a/src/test/contracts/michelson_converter_or.mligo b/src/test/contracts/michelson_converter_or.mligo index 3394ab7fa..673e138c5 100644 --- a/src/test/contracts/michelson_converter_or.mligo +++ b/src/test/contracts/michelson_converter_or.mligo @@ -18,4 +18,20 @@ let str3 = Layout.convert_to_right_comb (vst3:st3) let str4 = Layout.convert_to_right_comb (vst4:st4) let stl3 = Layout.convert_to_left_comb (vst3:st3) -let stl4 = Layout.convert_to_left_comb (vst4:st4) \ No newline at end of file +let stl4 = Layout.convert_to_left_comb (vst4:st4) + +(*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 = st4 michelson_or_right_comb +let main_r (p, s : param_r * string) : (operation list * string) = + // let r4 : t4 = Layout.convert_from_right_comb p in + ([] : operation list), "hey" + +type param_l = st4 michelson_or_left_comb +let main_l (p, s : param_l * string) : (operation list * string) = + // let r4 : t4 = Layout.convert_from_left_comb p in + ([] : operation list), "hey" \ No newline at end of file