diff --git a/src/proto_alpha/lib_client/michelson_v1_macros.ml b/src/proto_alpha/lib_client/michelson_v1_macros.ml index 5a3028b91..d192d4b2e 100644 --- a/src/proto_alpha/lib_client/michelson_v1_macros.ml +++ b/src/proto_alpha/lib_client/michelson_v1_macros.ml @@ -36,7 +36,7 @@ let expand_caddadr original = if i = 0 then Seq (loc, acc) else - let annot = if i = (String.length str - 2) then annot else [] in + let annot = if i = len - 2 then annot else [] in match String.get str i with | 'A' -> parse (i - 1) [] (Prim (loc, "CAR", [], annot) :: acc) | 'D' -> parse (i - 1) [] (Prim (loc, "CDR", [], annot) :: acc) @@ -46,6 +46,17 @@ let expand_caddadr original = ok None | _ -> ok None +let extract_first_field_annot annot = + let rec extract_first_field_annot others = function + | [] -> None, List.rev others + | a :: rest -> + match a.[0] with + | '%' -> Some a, List.rev_append others rest + | _ -> extract_first_field_annot (a :: others) rest + | exception Invalid_argument _ -> extract_first_field_annot (a :: others) rest + in + extract_first_field_annot [] annot + let expand_set_caddadr original = match original with | Prim (loc, str, args, annot) -> @@ -59,10 +70,12 @@ let expand_set_caddadr original = | [] -> ok () | _ :: _ -> error (Invalid_arity (str, List.length args, 0)) end >>? fun () -> + let field_annot, annot = extract_first_field_annot annot in let rec parse i acc = if i = 4 then acc else + let annot = if i = 5 then annot else [] in match String.get str i with | 'A' -> let acc = @@ -74,7 +87,7 @@ let expand_set_caddadr original = acc ]) ], []) ; Prim (loc, "CDR", [], []) ; Prim (loc, "SWAP", [], []) ; - Prim (loc, "PAIR", [], []) ]) in + Prim (loc, "PAIR", [], annot) ]) in parse (i - 1) acc | 'D' -> let acc = @@ -85,27 +98,47 @@ let expand_set_caddadr original = [ Prim (loc, "CDR", [], []) ; acc ]) ], []) ; Prim (loc, "CAR", [], []) ; - Prim (loc, "PAIR", [], []) ]) in + Prim (loc, "PAIR", [], annot) ]) in parse (i - 1) acc | _ -> assert false in match String.get str (len - 2) with | 'A' -> - let init = - Seq (loc, - [ Prim (loc, "CDR", [], []) ; - Prim (loc, "SWAP", [], annot) ; - Prim (loc, "PAIR", [], []) ]) in + let access_check = match field_annot with + | None -> [] + | Some f -> [ Prim (loc, "DUP", [], []) ; + Prim (loc, "CAR", [], [ f ]) ; + Prim (loc, "DROP", [], []) ; + ] in + let encoding = [ Prim (loc, "CDR", [], []) ; + Prim (loc, "SWAP", [], []) ] in + let rename = match field_annot with + | None -> [] + | Some f -> [ Prim (loc, "RENAME", [], + [ "@" ^ String.sub f 1 (String.length f - 1) ]) ] + in + let pair = [ Prim (loc, "PAIR", [], []) ] in + let init = Seq (loc, access_check @ encoding @ rename @ pair) in ok (Some (parse (len - 3) init)) | 'D' -> - let init = - Seq (loc, - (Prim (loc, "CAR", [], [])) :: - (let pair = Prim (loc, "PAIR", [], []) in - match annot with - | [] -> [ pair ] - | _ -> [ Prim (loc, "SWAP", [], annot) ; - Prim (loc, "SWAP", [], []) ; - pair])) in + let access_check = match field_annot with + | None -> [] + | Some f -> [ Prim (loc, "DUP", [], []) ; + Prim (loc, "CDR", [], [ f ]) ; + Prim (loc, "DROP", [], []) ; + ] in + let encoding = [ Prim (loc, "CAR", [], []) ] in + let rename = match field_annot with + | None -> [] + | Some f -> + [ Prim (loc, "DIP", [ + Seq (loc, [ + Prim (loc, "RENAME", [], + [ "@" ^ String.sub f 1 (String.length f - 1) ]) + ]) + ], []) ] + in + let pair = [ Prim (loc, "PAIR", [], []) ] in + let init = Seq (loc, access_check @ encoding @ rename @ pair) in ok (Some (parse (len - 3) init)) | _ -> assert false else @@ -121,19 +154,17 @@ let expand_map_caddadr original = && String.get str (len - 1) = 'R' && check_letters str 5 (len - 2) (function 'A' | 'D' -> true | _ -> false) then - begin match annot with - | _ :: _ -> (error (Unexpected_macro_annotation str)) - | [] -> ok () - end >>? fun () -> begin match args with | [ Seq _ as code ] -> ok code | [ _ ] -> error (Sequence_expected str) | [] | _ :: _ :: _ -> error (Invalid_arity (str, List.length args, 1)) end >>? fun code -> + let field_annot, annot = extract_first_field_annot annot in let rec parse i acc = if i = 4 then acc else + let annot = if i = 5 then annot else [] in match String.get str i with | 'A' -> let acc = @@ -145,7 +176,7 @@ let expand_map_caddadr original = acc ]) ], []) ; Prim (loc, "CDR", [], []) ; Prim (loc, "SWAP", [], []) ; - Prim (loc, "PAIR", [], []) ]) in + Prim (loc, "PAIR", [], annot) ]) in parse (i - 1) acc | 'D' -> let acc = @@ -156,9 +187,17 @@ let expand_map_caddadr original = [ Prim (loc, "CDR", [], []) ; acc ]) ], []) ; Prim (loc, "CAR", [], []) ; - Prim (loc, "PAIR", [], []) ]) in + Prim (loc, "PAIR", [], annot) ]) in parse (i - 1) acc | _ -> assert false in + let cr_annot = match field_annot with + | None -> [] + | Some f -> [ f ] in + let rename_op = match field_annot with + | None -> [] + | Some f -> + [ Prim (loc, "RENAME", [], + [ "@" ^ String.sub f 1 (String.length f - 1) ]) ] in match String.get str (len - 2) with | 'A' -> let init = @@ -166,7 +205,8 @@ let expand_map_caddadr original = [ Prim (loc, "DUP", [], []) ; Prim (loc, "CDR", [], []) ; Prim (loc, "DIP", - [ Seq (loc, [ Prim (loc, "CAR", [], []) ; code ]) ], []) ; + [ Seq (loc, [ Prim (loc, "CAR", [], cr_annot) ; code ] @ + rename_op ) ], []) ; Prim (loc, "SWAP", [], []) ; Prim (loc, "PAIR", [], []) ]) in ok (Some (parse (len - 3) init)) @@ -174,8 +214,10 @@ let expand_map_caddadr original = let init = Seq (loc, [ Prim (loc, "DUP", [], []) ; - Prim (loc, "CDR", [], []) ; - code ; + Prim (loc, "CDR", [], cr_annot) ; + code ] @ + rename_op @ + [ Prim (loc, "SWAP", [], []) ; Prim (loc, "CAR", [], []) ; Prim (loc, "PAIR", [], []) ]) in @@ -272,6 +314,7 @@ let expand_paaiair original = ok None | _ -> ok None +(* TODO incorrect annotations *) let expand_unpaaiair original = match original with | Prim (loc, str, args, annot) -> @@ -471,21 +514,17 @@ let expand_asserts original = let expand_if_some = function - | Prim (loc, "IF_SOME", [ right ; left ], []) -> - ok @@ Some (Seq (loc, [ Prim (loc, "IF_NONE", [ left ; right ], []) ])) - | Prim (_, "IF_SOME", args, []) -> + | Prim (loc, "IF_SOME", [ right ; left ], annot) -> + ok @@ Some (Seq (loc, [ Prim (loc, "IF_NONE", [ left ; right ], annot) ])) + | Prim (_, "IF_SOME", args, _annot) -> error (Invalid_arity ("IF_SOME", List.length args, 2)) - | Prim (_, "IF_SOME", [], _ :: _) -> - error (Unexpected_macro_annotation "IF_SOME") | _ -> ok @@ None let expand_if_right = function - | Prim (loc, "IF_RIGHT", [ right ; left ], []) -> - ok @@ Some (Seq (loc, [ Prim (loc, "IF_LEFT", [ left ; right ], []) ])) - | Prim (_, "IF_RIGHT", args, []) -> + | Prim (loc, "IF_RIGHT", [ right ; left ], annot) -> + ok @@ Some (Seq (loc, [ Prim (loc, "IF_LEFT", [ left ; right ], annot) ])) + | Prim (_, "IF_RIGHT", args, _annot) -> error (Invalid_arity ("IF_RIGHT", List.length args, 2)) - | Prim (_, "IF_RIGHT", [], _ :: _) -> - error (Unexpected_macro_annotation "IF_RIGHT") | _ -> ok @@ None let expand_rename = function @@ -563,16 +602,33 @@ let unexpand_caddadr expanded = | _ -> None let unexpand_set_caddadr expanded = - let rec steps acc = function + let rec steps acc annots = function | Seq (loc, [ Prim (_, "CDR", [], []) ; Prim (_, "SWAP", [], []) ; Prim (_, "PAIR", [], []) ]) -> - Some (loc, "A" :: acc) + Some (loc, "A" :: acc, annots) + | Seq (loc, + [ Prim (_, "DUP", [], []) ; + Prim (_, "CAR", [], [ field_annot ]) ; + Prim (_, "DROP", [], []) ; + Prim (_, "CDR", [], []) ; + Prim (_, "SWAP", [], []) ; + Prim (_, "RENAME", [], _) ; + Prim (_, "PAIR", [], []) ]) -> + Some (loc, "A" :: acc, field_annot :: annots) | Seq (loc, [ Prim (_, "CAR", [], []) ; Prim (_, "PAIR", [], []) ]) -> - Some (loc, "D" :: acc) + Some (loc, "D" :: acc, annots) + | Seq (loc, + [ Prim (_, "DUP", [], []) ; + Prim (_, "CDR", [], [ field_annot ]) ; + Prim (_, "DROP", [], []) ; + Prim (_, "CAR", [], []) ; + Prim (_, "DIP", [ Seq (_, [ Prim (_, "RENAME", [], _) ]) ], []); + Prim (_, "PAIR", [], []) ]) -> + Some (loc, "D" :: acc, field_annot :: annots) | Seq (_, [ Prim (_, "DUP", [], []) ; Prim (_, "DIP", @@ -581,8 +637,8 @@ let unexpand_set_caddadr expanded = sub ]) ], []) ; Prim (_, "CDR", [], []) ; Prim (_, "SWAP", [], []) ; - Prim (_, "PAIR", [], []) ]) -> - steps ("A" :: acc) sub + Prim (_, "PAIR", [], pair_annots) ]) -> + steps ("A" :: acc) (List.rev_append pair_annots annots) sub | Seq (_, [ Prim (_, "DUP", [], []) ; Prim (_, "DIP", @@ -590,25 +646,38 @@ let unexpand_set_caddadr expanded = [ Prim (_, "CDR", [], []) ; sub ]) ], []) ; Prim (_, "CAR", [], []) ; - Prim (_, "PAIR", [], []) ]) -> - steps ("D" :: acc) sub + Prim (_, "PAIR", [], pair_annots) ]) -> + steps ("D" :: acc) (List.rev_append pair_annots annots) sub | _ -> None in - match steps [] expanded with - | Some (loc, steps) -> + match steps [] [] expanded with + | Some (loc, steps, annots) -> let name = String.concat "" ("SET_C" :: List.rev ("R" :: steps)) in - Some (Prim (loc, name, [], [])) + Some (Prim (loc, name, [], List.rev annots)) | None -> None let unexpand_map_caddadr expanded = - let rec steps acc = function + let rec steps acc annots = function | Seq (loc, [ Prim (_, "DUP", [], []) ; Prim (_, "CDR", [], []) ; Prim (_, "SWAP", [], []) ; - Prim (_, "CAR", [], []) ; - code ; + Prim (_, "DIP", + [ Seq (_, + [ Prim (_, "CAR", [], []) ; + code ]) ], []) ; Prim (_, "PAIR", [], []) ]) -> - Some (loc, "A" :: acc, code) + Some (loc, "A" :: acc, annots, code) + | Seq (loc, + [ Prim (_, "DUP", [], []) ; + Prim (_, "CDR", [], []) ; + Prim (_, "SWAP", [], []) ; + Prim (_, "DIP", + [ Seq (_, + [ Prim (_, "CAR", [], [ field_annot ]) ; + code ; + Prim (_, "RENAME", [], _) ]) ], []) ; + Prim (_, "PAIR", [], []) ]) -> + Some (loc, "A" :: acc, field_annot :: annots, code) | Seq (loc, [ Prim (_, "DUP", [], []) ; Prim (_, "CDR", [], []) ; @@ -616,7 +685,16 @@ let unexpand_map_caddadr expanded = Prim (_, "SWAP", [], []) ; Prim (_, "CAR", [], []) ; Prim (_, "PAIR", [], []) ]) -> - Some (loc, "D" :: acc, code) + Some (loc, "D" :: acc, annots, code) + | Seq (loc, + [ Prim (_, "DUP", [], []) ; + Prim (_, "CDR", [], [ field_annot ]) ; + code ; + Prim (_, "RENAME", [], _) ; + Prim (_, "SWAP", [], []) ; + Prim (_, "CAR", [], []) ; + Prim (_, "PAIR", [], []) ]) -> + Some (loc, "D" :: acc, field_annot :: annots, code) | Seq (_, [ Prim (_, "DUP", [], []) ; Prim (_, "DIP", @@ -625,8 +703,8 @@ let unexpand_map_caddadr expanded = sub ]) ], []) ; Prim (_, "CDR", [], []) ; Prim (_, "SWAP", [], []) ; - Prim (_, "PAIR", [], []) ]) -> - steps ("A" :: acc) sub + Prim (_, "PAIR", [], pair_annots) ]) -> + steps ("A" :: acc) (List.rev_append pair_annots annots) sub | Seq (_, [ Prim (_, "DUP", [], []) ; Prim (_, "DIP", @@ -634,13 +712,13 @@ let unexpand_map_caddadr expanded = [ Prim (_, "CDR", [], []) ; sub ]) ], []) ; Prim (_, "CAR", [], []) ; - Prim (_, "PAIR", [], []) ]) -> - steps ("D" :: acc) sub + Prim (_, "PAIR", [], pair_annots) ]) -> + steps ("D" :: acc) (List.rev_append pair_annots annots) sub | _ -> None in - match steps [] expanded with - | Some (loc, steps, code) -> + match steps [] [] expanded with + | Some (loc, steps, annots, code) -> let name = String.concat "" ("MAP_C" :: List.rev ("R" :: steps)) in - Some (Prim (loc, name, [ code ], [])) + Some (Prim (loc, name, [ code ], List.rev annots)) | None -> None let roman_of_decimal decimal =