balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Michelson: annotations for set_cadr, map_cadr

Browse Source
This commit is contained in:
Alain Mebsout 2018-05-22 19:44:46 +02:00 committed by Benjamin Canou
parent 82022acabb
commit c8dd939849
1 changed files with 136 additions and 58 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

194
src/proto_alpha/lib_client/michelson_v1_macros.ml
View File

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