rename 'michelson_right/left_comb' to 'michelson_pair_right/left_comb'

This commit is contained in:
Lesenechal Remi 2020-04-28 21:29:21 +02:00
parent fb2f3e89e7
commit b54bcb8db7
16 changed files with 55 additions and 55 deletions

View File

@ -201,12 +201,12 @@ and compile_type_operator : I.type_operator -> O.type_operator result =
let%bind (k,v) = bind_map_pair compile_type_expression (k,v) in
ok @@ O.TC_big_map (k,v)
| TC_michelson_or _ | TC_michelson_pair _ -> fail @@ Errors.corner_case __LOC__
| TC_michelson_right_comb c ->
| TC_michelson_pair_right_comb c ->
let%bind c = compile_type_expression c in
ok @@ O.TC_michelson_right_comb c
| TC_michelson_left_comb c ->
ok @@ O.TC_michelson_pair_right_comb c
| TC_michelson_pair_left_comb c ->
let%bind c = compile_type_expression c in
ok @@ O.TC_michelson_left_comb c
ok @@ O.TC_michelson_pair_left_comb c
let rec compile_expression : I.expression -> O.expression result =
fun e ->
@ -646,12 +646,12 @@ and uncompile_type_operator : O.type_operator -> I.type_operator result =
| TC_big_map (k,v) ->
let%bind (k,v) = bind_map_pair uncompile_type_expression (k,v) in
ok @@ I.TC_big_map (k,v)
| TC_michelson_right_comb c ->
| TC_michelson_pair_right_comb c ->
let%bind c = uncompile_type_expression c in
ok @@ I.TC_michelson_right_comb c
| TC_michelson_left_comb c ->
ok @@ I.TC_michelson_pair_right_comb c
| TC_michelson_pair_left_comb c ->
let%bind c = uncompile_type_expression c in
ok @@ I.TC_michelson_left_comb c
ok @@ I.TC_michelson_pair_left_comb c
let rec uncompile_expression' : O.expression -> I.expression result =
fun e ->

View File

@ -66,12 +66,12 @@ and idle_type_operator : I.type_operator -> O.type_operator result =
| TC_big_map (k,v) ->
let%bind (k,v) = bind_map_pair idle_type_expression (k,v) in
ok @@ O.TC_big_map (k,v)
| TC_michelson_right_comb c ->
| TC_michelson_pair_right_comb c ->
let%bind c = idle_type_expression c in
ok @@ O.TC_michelson_right_comb c
| TC_michelson_left_comb c ->
ok @@ O.TC_michelson_pair_right_comb c
| TC_michelson_pair_left_comb c ->
let%bind c = idle_type_expression c in
ok @@ O.TC_michelson_left_comb c
ok @@ O.TC_michelson_pair_left_comb c
let rec compile_expression : I.expression -> O.expression result =
fun e ->
@ -294,12 +294,12 @@ and uncompile_type_operator : O.type_operator -> I.type_operator result =
let%bind (k,v) = bind_map_pair uncompile_type_expression (k,v) in
ok @@ I.TC_big_map (k,v)
| TC_map_or_big_map _ -> failwith "TC_map_or_big_map shouldn't be uncompiled"
| TC_michelson_right_comb c ->
| TC_michelson_pair_right_comb c ->
let%bind c = uncompile_type_expression c in
ok @@ I.TC_michelson_right_comb c
| TC_michelson_left_comb c ->
ok @@ I.TC_michelson_pair_right_comb c
| TC_michelson_pair_left_comb c ->
let%bind c = uncompile_type_expression c in
ok @@ I.TC_michelson_left_comb c
ok @@ I.TC_michelson_pair_left_comb c
let rec uncompile_expression : O.expression -> I.expression result =
fun e ->

View File

@ -181,7 +181,7 @@ 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_right_comb _c | TC_michelson_left_comb _c ->
| TC_michelson_pair_right_comb _c | TC_michelson_pair_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

View File

@ -106,8 +106,8 @@ let rec type_expression_to_type_value_copypasted : I.type_expression -> O.type_v
| TC_big_map ( k , v ) -> (C_big_map, [k;v])
| TC_map_or_big_map ( k , v) -> (C_map, [k;v])
| TC_contract c -> (C_contract, [c])
| TC_michelson_right_comb c -> (C_record, [c])
| TC_michelson_left_comb c -> (C_record, [c])
| TC_michelson_pair_right_comb c -> (C_record, [c])
| TC_michelson_pair_left_comb c -> (C_record, [c])
)
in
p_constant csttag (List.map type_expression_to_type_value_copypasted args)

View File

@ -13,8 +13,8 @@ type environment = Environment.t
module Errors = struct
let michelson_comb_no_record (loc:Location.t) () =
let title = (thunk "bad michelson_right_comb type parameter") in
let message () = "michelson_right_comb type operator must be used on a record type" in
let title = (thunk "bad michelson_pair_right_comb type parameter") in
let message () = "michelson_pair_right_comb type operator must be used on a record type" in
let data = [
("location" , fun () -> Format.asprintf "%a" Location.pp loc) ;
] in
@ -660,14 +660,14 @@ and evaluate_type (e:environment) (t:I.type_expression) : O.type_expression resu
| TC_contract c ->
let%bind c = evaluate_type e c in
return @@ T_operator (O.TC_contract c)
| TC_michelson_right_comb c ->
| TC_michelson_pair_right_comb c ->
let%bind c' = evaluate_type e c in
let%bind lmap = match c'.type_content with
| T_record lmap when (not (Ast_typed.Helpers.is_tuple_lmap lmap)) -> ok lmap
| _ -> fail (michelson_comb_no_record t.location) in
let record = Operators.Typer.Converter.convert_type_to_right_comb (Ast_typed.LMap.to_kv_list lmap) in
return @@ record
| TC_michelson_left_comb c ->
| TC_michelson_pair_left_comb c ->
let%bind c' = evaluate_type e c in
let%bind lmap = match c'.type_content with
| T_record lmap when (not (Ast_typed.Helpers.is_tuple_lmap lmap)) -> ok lmap

View File

@ -199,7 +199,7 @@ module Typer = struct
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"
| _ -> simple_fail "Could not convert michelson_pair_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
@ -209,7 +209,7 @@ module Typer = struct
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"
| _ -> simple_fail "Could not convert michelson_pair_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

View File

@ -59,8 +59,8 @@ module Concrete_to_imperative = struct
| "map" -> Some (TC_map (unit_expr,unit_expr))
| "big_map" -> Some (TC_big_map (unit_expr,unit_expr))
| "contract" -> Some (TC_contract unit_expr)
| "michelson_right_comb" -> Some (TC_michelson_right_comb unit_expr)
| "michelson_left_comb" -> Some (TC_michelson_left_comb 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)
| _ -> None
let pseudo_modules = function

View File

@ -61,8 +61,8 @@ and type_operator :
| TC_big_map (k, v) -> Format.asprintf "Big Map (%a,%a)" f k f v
| TC_michelson_or (l,_, r,_) -> Format.asprintf "Michelson_or (%a,%a)" f l f r
| TC_michelson_pair (l,_, r,_) -> Format.asprintf "Michelson_pair (%a,%a)" f l f r
| TC_michelson_right_comb e -> Format.asprintf "Michelson_right_comb (%a)" f e
| TC_michelson_left_comb e -> Format.asprintf "Michelson_left_comb (%a)" f e
| 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_contract te -> Format.asprintf "Contract (%a)" f te
in
fprintf ppf "(TO_%s)" s

View File

@ -63,8 +63,8 @@ let t_set ?loc key : type_expression = make_t ?loc @@ T_operator (
let t_contract ?loc contract : type_expression = make_t ?loc @@ T_operator (TC_contract contract)
let t_michelson_or ?loc l l_ann r r_ann : type_expression = make_t ?loc @@ T_operator (TC_michelson_or (l, l_ann, r, r_ann))
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_right_comb ?loc c : type_expression = make_t ?loc @@ T_operator (TC_michelson_right_comb c)
let t_michelson_left_comb ?loc c : type_expression = make_t ?loc @@ T_operator (TC_michelson_left_comb c)
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)
(* TODO find a better way than using list*)
let t_operator ?loc op lst: type_expression result =
@ -76,8 +76,8 @@ let t_operator ?loc op lst: type_expression result =
| TC_big_map (_,_) , [kt;vt] -> ok @@ t_big_map ?loc kt vt
| TC_michelson_or (_,l_ann,_,r_ann) , [l;r] -> ok @@ t_michelson_or ?loc l l_ann r r_ann
| TC_contract _ , [t] -> ok @@ t_contract t
| TC_michelson_right_comb _ , [c] -> ok @@ t_michelson_right_comb c
| TC_michelson_left_comb _ , [c] -> ok @@ t_michelson_left_comb c
| 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
| _ , _ -> fail @@ bad_type_operator op
let make_e ?(loc = Location.generated) expression_content =

View File

@ -28,8 +28,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_right_comb of type_expression
| TC_michelson_left_comb of type_expression
| TC_michelson_pair_right_comb of type_expression
| TC_michelson_pair_left_comb of type_expression
and type_expression = {type_content: type_content; location: Location.t}

View File

@ -52,8 +52,8 @@ and type_operator : (formatter -> type_expression -> unit) -> formatter -> type_
| TC_map (k, v) -> Format.asprintf "Map (%a,%a)" f k f v
| TC_big_map (k, v) -> Format.asprintf "Big Map (%a,%a)" f k f v
| TC_contract te -> Format.asprintf "Contract (%a)" f te
| TC_michelson_right_comb c -> Format.asprintf "michelson_right_comb (%a)" f c
| TC_michelson_left_comb c -> Format.asprintf "michelson_left_comb (%a)" f c
| 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
in
fprintf ppf "(TO_%s)" s

View File

@ -30,8 +30,8 @@ and type_operator =
| TC_set of type_expression
| TC_map of type_expression * type_expression
| TC_big_map of type_expression * type_expression
| TC_michelson_right_comb of type_expression
| TC_michelson_left_comb of type_expression
| TC_michelson_pair_right_comb of type_expression
| TC_michelson_pair_left_comb of type_expression
and type_expression = {type_content: type_content; location: Location.t}

View File

@ -254,8 +254,8 @@ module Ast_PP_type (PARAMETER : AST_PARAMETER_TYPE) = struct
| TC_big_map (k, v) -> Format.asprintf "Big Map (%a,%a)" f k f v
| TC_map_or_big_map (k, v) -> Format.asprintf "Map Or Big Map (%a,%a)" f k f v
| TC_contract te -> Format.asprintf "Contract (%a)" f te
| TC_michelson_right_comb c -> Format.asprintf "Michelson_right_comb (%a)" f c
| TC_michelson_left_comb c -> Format.asprintf "Michelson_left_comb (%a)" f c
| 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
in
fprintf ppf "(type_operator: %s)" s
end

View File

@ -59,8 +59,8 @@ module Ast_generic_type (PARAMETER : AST_PARAMETER_TYPE) = struct
| TC_map of type_expression * type_expression
| TC_big_map of type_expression * type_expression
| TC_map_or_big_map of type_expression * type_expression
| TC_michelson_right_comb of type_expression
| TC_michelson_left_comb of type_expression
| TC_michelson_pair_right_comb of type_expression
| TC_michelson_pair_left_comb of type_expression
and type_expression = {type_content: type_content; location: Location.t; type_meta: type_meta}
@ -74,8 +74,8 @@ module Ast_generic_type (PARAMETER : AST_PARAMETER_TYPE) = struct
| TC_map (x , y) -> TC_map (f x , f y)
| TC_big_map (x , y)-> TC_big_map (f x , f y)
| TC_map_or_big_map (x , y)-> TC_map_or_big_map (f x , f y)
| TC_michelson_right_comb c -> TC_michelson_right_comb (f c)
| TC_michelson_left_comb c -> TC_michelson_left_comb (f c)
| 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)
let bind_map_type_operator f = function
TC_contract x -> let%bind x = f x in ok @@ TC_contract x
@ -85,8 +85,8 @@ module Ast_generic_type (PARAMETER : AST_PARAMETER_TYPE) = struct
| TC_map (x , y) -> let%bind x = f x in let%bind y = f y in ok @@ TC_map (x , y)
| TC_big_map (x , y)-> let%bind x = f x in let%bind y = f y in ok @@ TC_big_map (x , y)
| 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_right_comb c -> let%bind c = f c in ok @@ TC_michelson_right_comb c
| TC_michelson_left_comb c -> let%bind c = f c in ok @@ TC_michelson_left_comb c
| 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
let type_operator_name = function
TC_contract _ -> "TC_contract"
@ -96,8 +96,8 @@ module Ast_generic_type (PARAMETER : AST_PARAMETER_TYPE) = struct
| TC_map _ -> "TC_map"
| TC_big_map _ -> "TC_big_map"
| TC_map_or_big_map _ -> "TC_map_or_big_map"
| TC_michelson_right_comb _ -> "TC_michelson_right_comb"
| TC_michelson_left_comb _ -> "TC_michelson_left_comb"
| TC_michelson_pair_right_comb _ -> "TC_michelson_pair_right_comb"
| TC_michelson_pair_left_comb _ -> "TC_michelson_pair_left_comb"
let type_expression'_of_string = function
| "TC_contract" , [x] -> ok @@ T_operator(TC_contract x)
@ -135,8 +135,8 @@ module Ast_generic_type (PARAMETER : AST_PARAMETER_TYPE) = struct
| TC_map (x , y) -> "TC_map" , [x ; y]
| TC_big_map (x , y) -> "TC_big_map" , [x ; y]
| TC_map_or_big_map (x , y) -> "TC_map_or_big_map" , [x ; y]
| TC_michelson_right_comb c -> "TC_michelson_right_comb" , [c]
| TC_michelson_left_comb c -> "TC_michelson_left_comb" , [c]
| TC_michelson_pair_right_comb c -> "TC_michelson_pair_right_comb" , [c]
| TC_michelson_pair_left_comb c -> "TC_michelson_pair_left_comb" , [c]
let string_of_type_constant = function
| TC_unit -> "TC_unit", []

View File

@ -1,7 +1,7 @@
type t3 = { foo : int ; bar : nat ; baz : string}
type param_r = t3 michelson_right_comb
type param_l = t3 michelson_left_comb
type param_r = t3 michelson_pair_right_comb
type param_l = t3 michelson_pair_left_comb
let main_r (action, store : param_r * unit) : (operation list * unit) =
([] : operation list), unit

View File

@ -17,8 +17,8 @@ let l4 = Layout.convert_to_left_comb (v4:t4)
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
type param_r = t4 michelson_pair_right_comb
type param_l = t4 michelson_pair_left_comb
let main_r (p, s : param_r * string) : (operation list * string) =
let r4 : t4 = Layout.convert_from_right_comb p in