balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity
b6449cae87
ligo/src/client/embedded/alpha/michelson_macros.ml

768 lines
28 KiB
OCaml
Raw Normal View History

Michelson: new parser and macro expander.
2017-06-15 01:35:24 +04:00
(**************************************************************************)
(* *)
Almost too late for copyright update.
2017-11-14 03:36:14 +04:00
(* Copyright (c) 2014 - 2017. *)
Michelson: new parser and macro expander.
2017-06-15 01:35:24 +04:00
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
Michelson: Switch parser/printer/representation to Micheline
2017-11-02 21:57:17 +04:00
open Micheline
type 'l node = ('l, string) Micheline.node
Michelson: new parser and macro expander.
2017-06-15 01:35:24 +04:00
let expand_caddadr original =
match original with
| Prim (loc, str, [], annot) ->
let len = String.length str in
if len > 3
&& String.get str 0 = 'C'
&& String.get str (len - 1) = 'R' then
let rec parse i ?annot acc =
if i = 0 then
Some (Seq (loc, acc, None))
else
match String.get str i with
| 'A' -> parse (i - 1) (Prim (loc, "CAR", [], annot) :: acc)
| 'D' -> parse (i - 1) (Prim (loc, "CDR", [], annot) :: acc)
| _ -> None in
parse (len - 2) ?annot []
else
None
| _ -> None
let expand_set_caddadr original =
match original with
| Prim (loc, str, [], None) ->
let len = String.length str in
if len >= 7
&& String.sub str 0 5 = "SET_C"
&& String.get str (len - 1) = 'R' then
let rec parse i acc =
if i = 4 then
Some acc
else
match String.get str i with
| 'A' ->
let acc =
Seq (loc,
[ Prim (loc, "DUP", [], None) ;
Prim (loc, "DIP",
[ Seq (loc,
[ Prim (loc, "CAR", [], None) ;
acc ], None) ], None) ;
Prim (loc, "CDR", [], None) ;
Prim (loc, "SWAP", [], None) ;
Prim (loc, "PAIR", [], None) ], None) in
parse (i - 1) acc
| 'D' ->
let acc =
Seq (loc,
[ Prim (loc, "DUP", [], None) ;
Prim (loc, "DIP",
[ Seq (loc,
[ Prim (loc, "CDR", [], None) ;
acc ], None) ], None) ;
Prim (loc, "CAR", [], None) ;
Prim (loc, "PAIR", [], None) ], None) in
parse (i - 1) acc
| _ -> None in
match String.get str (len - 2) with
| 'A' ->
let init =
Seq (loc,
[ Prim (loc, "CDR", [], None) ;
Prim (loc, "SWAP", [], None) ;
Prim (loc, "PAIR", [], None) ], None) in
parse (len - 3) init
| 'D' ->
let init =
Seq (loc,
[ Prim (loc, "CAR", [], None) ;
Prim (loc, "PAIR", [], None) ], None) in
parse (len - 3) init
| _ -> None
else
None
| _ -> None
let expand_map_caddadr original =
match original with
| Prim (loc, str, [ Seq _ as code ], None) ->
let len = String.length str in
if len >= 7
&& String.sub str 0 5 = "MAP_C"
&& String.get str (len - 1) = 'R' then
let rec parse i acc =
if i = 4 then
Some acc
else
match String.get str i with
| 'A' ->
let acc =
Seq (loc,
[ Prim (loc, "DUP", [], None) ;
Prim (loc, "DIP",
[ Seq (loc,
[ Prim (loc, "CAR", [], None) ;
acc ], None) ], None) ;
Prim (loc, "CDR", [], None) ;
Prim (loc, "SWAP", [], None) ;
Prim (loc, "PAIR", [], None) ], None) in
parse (i - 1) acc
| 'D' ->
let acc =
Seq (loc,
[ Prim (loc, "DUP", [], None) ;
Prim (loc, "DIP",
[ Seq (loc,
[ Prim (loc, "CDR", [], None) ;
acc ], None) ], None) ;
Prim (loc, "CAR", [], None) ;
Prim (loc, "PAIR", [], None) ], None) in
parse (i - 1) acc
| _ -> None in
match String.get str (len - 2) with
| 'A' ->
let init =
Seq (loc,
[ Prim (loc, "DUP", [], None) ;
Prim (loc, "CDR", [], None) ;
Prim (loc, "SWAP", [], None) ;
Prim (loc, "CAR", [], None) ;
code ;
Prim (loc, "PAIR", [], None) ], None) in
parse (len - 3) init
| 'D' ->
let init =
Seq (loc,
[ Prim (loc, "DUP", [], None) ;
Prim (loc, "CDR", [], None) ;
code ;
Prim (loc, "SWAP", [], None) ;
Prim (loc, "CAR", [], None) ;
Prim (loc, "PAIR", [], None) ], None) in
parse (len - 3) init
| _ -> None
else
None
| _ -> None
exception Not_a_roman
let decimal_of_roman roman =
(* http://rosettacode.org/wiki/Roman_numerals/Decode#OCaml *)
let arabic = ref 0 in
let lastval = ref 0 in
for i = (String.length roman) - 1 downto 0 do
let n =
match roman.[i] with
| 'M' -> 1000
| 'D' -> 500
| 'C' -> 100
| 'L' -> 50
| 'X' -> 10
| 'V' -> 5
| 'I' -> 1
| _ -> raise Not_a_roman
in
if Compare.Int.(n < !lastval)
then arabic := !arabic - n
else arabic := !arabic + n;
lastval := n
done;
!arabic
let expand_dxiiivp original =
match original with
| Prim (loc, str, [ arg ], None) ->
let len = String.length str in
if len > 3
&& String.get str 0 = 'D'
&& String.get str (len - 1) = 'P' then
try
let depth = decimal_of_roman (String.sub str 1 (len - 2)) in
let rec make i acc =
if i = 0 then
acc
else
make (i - 1)
(Seq (loc, [ Prim (loc, "DIP", [ acc ], None) ], None)) in
Some (make depth arg)
with Not_a_roman -> None
else None
| _ -> None
exception Not_a_pair
let expand_paaiair original =
match original with
| Prim (loc, str, [], None) ->
let len = String.length str in
if len > 4
&& String.get str 0 = 'P'
&& String.get str (len - 1) = 'R' then
try
let rec parse i acc =
if i = 0 then
acc
else if String.get str i = 'I'
&& String.get str (i - 1) = 'A' then
parse (i - 2) (Prim (loc, "PAIR", [], None) :: acc)
else if String.get str i = 'A' then
match acc with
| [] ->
raise Not_a_pair
| acc :: accs ->
parse (i - 1)
(Prim (loc, "DIP", [ Seq (loc, [ acc ], None) ], None)
:: accs)
else
raise Not_a_pair in
Some (Seq (loc, parse (len - 2) [], None))
with Not_a_pair -> None
else
None
| _ -> None
let expand_unpaaiair original =
match original with
| Prim (loc, str, [], None) ->
let len = String.length str in
if len >= 6
&& String.sub str 0 3 = "UNP"
&& String.get str (len - 1) = 'R' then
try
let rec parse i acc =
if i = 2 then
match acc with
| [ Seq _ as acc ] -> acc
| _ -> Seq (loc, List.rev acc, None)
else if String.get str i = 'I'
&& String.get str (i - 1) = 'A' then
parse (i - 2)
(Seq (loc, [ Prim (loc, "DUP", [], None) ;
Prim (loc, "CAR", [], None) ;
Prim (loc, "DIP",
[ Seq (loc,
[ Prim (loc, "CDR", [], None) ],
None) ], None) ], None)
:: acc)
else if String.get str i = 'A' then
match acc with
| [] ->
raise Not_a_pair
| (Seq _ as acc) :: accs ->
parse (i - 1)
(Prim (loc, "DIP", [ acc ], None) :: accs)
| acc :: accs ->
parse (i - 1)
(Prim (loc, "DIP",
[ Seq (loc, [ acc ], None) ],
None) :: accs)
else
raise Not_a_pair in
Some (parse (len - 2) [])
with Not_a_pair -> None
else
None
| _ -> None
exception Not_a_dup
let expand_duuuuup original =
match original with
| Prim (loc, str, [], None) ->
let len = String.length str in
if len > 3
&& String.get str 0 = 'D'
&& String.get str 1 = 'U'
&& String.get str (len - 1) = 'P' then
try
let rec parse i acc =
if i = 1 then acc
else if String.get str i = 'U' then
parse (i - 1)
(Seq (loc, [ Prim (loc, "DIP", [ acc ], None) ;
Prim (loc, "SWAP", [], None) ], None))
else
raise Not_a_dup in
Some (parse (len - 2) (Seq (loc, [ Prim (loc, "DUP", [], None) ], None)))
with Not_a_dup -> None
else
None
| _ -> None
let expand_compare original =
match original with
| Prim (loc, "CMPEQ", [], None) ->
Some (Seq (loc, [ Prim (loc, "COMPARE", [], None) ;
Prim (loc, "EQ", [], None) ], None))
| Prim (loc, "CMPNEQ", [], None) ->
Some (Seq (loc, [ Prim (loc, "COMPARE", [], None) ;
Prim (loc, "NEQ", [], None) ], None))
| Prim (loc, "CMPLT", [], None) ->
Some (Seq (loc, [ Prim (loc, "COMPARE", [], None) ;
Prim (loc, "LT", [], None) ], None))
| Prim (loc, "CMPGT", [], None) ->
Some (Seq (loc, [ Prim (loc, "COMPARE", [], None) ;
Prim (loc, "GT", [], None) ], None))
| Prim (loc, "CMPLE", [], None) ->
Some (Seq (loc, [ Prim (loc, "COMPARE", [], None) ;
Prim (loc, "LE", [], None) ], None))
| Prim (loc, "CMPGE", [], None) ->
Some (Seq (loc, [ Prim (loc, "COMPARE", [], None) ;
Prim (loc, "GE", [], None) ], None))
| Prim (loc, "IFCMPEQ", args, None) ->
Some (Seq (loc, [ Prim (loc, "COMPARE", [], None) ;
Prim (loc, "EQ", [], None) ;
Prim (loc, "IF", args, None) ], None))
| Prim (loc, "IFCMPNEQ", args, None) ->
Some (Seq (loc, [ Prim (loc, "COMPARE", [], None) ;
Prim (loc, "NEQ", [], None) ;
Prim (loc, "IF", args, None) ], None))
| Prim (loc, "IFCMPLT", args, None) ->
Some (Seq (loc, [ Prim (loc, "COMPARE", [], None) ;
Prim (loc, "LT", [], None) ;
Prim (loc, "IF", args, None) ], None))
| Prim (loc, "IFCMPGT", args, None) ->
Some (Seq (loc, [ Prim (loc, "COMPARE", [], None) ;
Prim (loc, "GT", [], None) ;
Prim (loc, "IF", args, None) ], None))
| Prim (loc, "IFCMPLE", args, None) ->
Some (Seq (loc, [ Prim (loc, "COMPARE", [], None) ;
Prim (loc, "LE", [], None) ;
Prim (loc, "IF", args, None) ], None))
| Prim (loc, "IFCMPGE", args, None) ->
Some (Seq (loc, [ Prim (loc, "COMPARE", [], None) ;
Prim (loc, "GE", [], None) ;
Prim (loc, "IF", args, None) ], None))
| Prim (loc, "IFEQ", args, None) ->
Some (Seq (loc, [ Prim (loc, "EQ", [], None) ;
Prim (loc, "IF", args, None) ], None))
| Prim (loc, "IFNEQ", args, None) ->
Some (Seq (loc, [ Prim (loc, "NEQ", [], None) ;
Prim (loc, "IF", args, None) ], None))
| Prim (loc, "IFLT", args, None) ->
Some (Seq (loc, [ Prim (loc, "LT", [], None) ;
Prim (loc, "IF", args, None) ], None))
| Prim (loc, "IFGT", args, None) ->
Some (Seq (loc, [ Prim (loc, "GT", [], None) ;
Prim (loc, "IF", args, None) ], None))
| Prim (loc, "IFLE", args, None) ->
Some (Seq (loc, [ Prim (loc, "LE", [], None) ;
Prim (loc, "IF", args, None) ], None))
| Prim (loc, "IFGE", args, None) ->
Some (Seq (loc, [ Prim (loc, "GE", [], None) ;
Prim (loc, "IF", args, None) ], None))
Michelson: tests for new parser and macro expander
2017-08-24 17:29:43 +04:00
| _ -> None;;
let expand_asserts original =
let fail_false loc =
[ Seq(loc, [], None) ; Seq(loc, [ Prim (loc, "FAIL", [], None) ], None) ] in
let fail_true loc =
[ Seq(loc, [ Prim (loc, "FAIL", [], None) ], None) ; Seq(loc, [], None) ] in
match original with
| Prim (loc, "ASSERT", [], None) ->
Some (Seq (loc, [ Prim (loc, "IF", fail_false loc, None) ], None))
| Prim (loc, "ASSERT_NONE", [], None) ->
Some (Seq (loc, [ Prim (loc, "IF_NONE", fail_false loc, None) ], None))
| Prim (loc, "ASSERT_SOME", [], None) ->
Some (Seq (loc, [ Prim (loc, "IF_NONE", fail_true loc, None) ], None))
| Prim (loc, "ASSERT_LEFT", [], None) ->
Some (Seq (loc, [ Prim (loc, "IF_LEFT", fail_false loc, None) ], None))
| Prim (loc, "ASSERT_RIGHT", [], None) ->
Some (Seq (loc, [ Prim (loc, "IF_LEFT", fail_true loc, None) ], None))
| Prim (loc, s, [], None)
when String.(length s > 7 && equal (sub s 0 7) "ASSERT_") ->
begin
let remaining = String.(sub s 7 ((length s) - 7)) in
let remaining_prim = Prim(loc, remaining, [], None) in
match remaining with
| "EQ" | "NEQ" | "LT" | "LE" | "GE" | "GT" ->
Some (Seq (loc, [ remaining_prim ;
Prim (loc, "IF", fail_false loc, None) ], None))
| _ ->
begin
match expand_compare remaining_prim with
Reindent all files Now `make test` fails when sources are not indented correctly, the indentation test is also executed in the CI.
2017-11-13 19:34:00 +04:00
| None -> None
| Some seq ->
Some (Seq (loc, [ seq ;
Prim (loc, "IF", fail_false loc, None) ], None))
end
Michelson: tests for new parser and macro expander
2017-08-24 17:29:43 +04:00
end
| _ -> None
let expand_if_some = function
| Prim (loc, "IF_SOME", [ right ; left ], None) ->
Some (Seq (loc, [ Prim (loc, "IF_NONE", [ left ; right ], None) ], None))
| _ -> None
let expand_if_right = function
| Prim (loc, "IF_RIGHT", [ right ; left ], None) ->
Some (Seq (loc, [ Prim (loc, "IF_LEFT", [ left ; right ], None) ], None))
Michelson: new parser and macro expander.
2017-06-15 01:35:24 +04:00
| _ -> None
let expand original =
let try_expansions expanders =
match
List.fold_left
(fun acc f ->
match acc with
| None -> f original
| Some rewritten -> Some rewritten)
None expanders with
| None -> original
| Some rewritten -> rewritten in
try_expansions
[ expand_caddadr ;
expand_set_caddadr ;
expand_map_caddadr ;
expand_dxiiivp ;
expand_paaiair ;
expand_unpaaiair ;
expand_duuuuup ;
Michelson: tests for new parser and macro expander
2017-08-24 17:29:43 +04:00
expand_compare ;
expand_asserts ;
expand_if_some ;
expand_if_right ]
Michelson: new parser and macro expander.
2017-06-15 01:35:24 +04:00
let unexpand_caddadr expanded =
let rec rsteps acc = function
| [] -> Some acc
| Prim (_, "CAR" , [], None) :: rest ->
rsteps ("A" :: acc) rest
| Prim (_, "CDR" , [], None) :: rest ->
rsteps ("D" :: acc) rest
| _ -> None in
match expanded with
| Seq (loc, (Prim (_, "CAR" , [], None) :: _ as nodes), None)
| Seq (loc, (Prim (_, "CDR" , [], None) :: _ as nodes), None) ->
begin match rsteps [] nodes with
| Some steps ->
let name = String.concat "" ("C" :: List.rev ("R" :: steps)) in
Some (Prim (loc, name, [], None))
| None -> None
end
| _ -> None
let unexpand_set_caddadr expanded =
let rec steps acc = function
| Seq (loc,
[ Prim (_, "CDR", [], None) ;
Prim (_, "SWAP", [], None) ;
Prim (_, "PAIR", [], None) ], None) ->
Some (loc, "A" :: acc)
| Seq (loc,
[ Prim (_, "CAR", [], None) ;
Prim (_, "PAIR", [], None) ], None) ->
Some (loc, "D" :: acc)
| Seq (_,
[ Prim (_, "DUP", [], None) ;
Prim (_, "DIP",
[ Seq (_,
[ Prim (_, "CAR", [], None) ;
sub ], None) ], None) ;
Prim (_, "CDR", [], None) ;
Prim (_, "SWAP", [], None) ;
Prim (_, "PAIR", [], None) ], None) ->
steps ("A" :: acc) sub
| Seq (_,
[ Prim (_, "DUP", [], None) ;
Prim (_, "DIP",
[ Seq (_,
[ Prim (_, "CDR", [], None) ;
sub ], None) ], None) ;
Prim (_, "CAR", [], None) ;
Prim (_, "PAIR", [], None) ], None) ->
steps ("D" :: acc) sub
| _ -> None in
match steps [] expanded with
| Some (loc, steps) ->
let name = String.concat "" ("SET_C" :: List.rev ("R" :: steps)) in
Some (Prim (loc, name, [], None))
| None -> None
let unexpand_map_caddadr expanded =
let rec steps acc = function
| Seq (loc,
[ Prim (_, "DUP", [], None) ;
Prim (_, "CDR", [], None) ;
Prim (_, "SWAP", [], None) ;
Prim (_, "CAR", [], None) ;
code ;
Prim (_, "PAIR", [], None) ], None) ->
Some (loc, "A" :: acc, code)
| Seq (loc,
[ Prim (_, "DUP", [], None) ;
Prim (_, "CDR", [], None) ;
code ;
Prim (_, "SWAP", [], None) ;
Prim (_, "CAR", [], None) ;
Prim (_, "PAIR", [], None) ], None) ->
Some (loc, "D" :: acc, code)
| Seq (_,
[ Prim (_, "DUP", [], None) ;
Prim (_, "DIP",
[ Seq (_,
[ Prim (_, "CAR", [], None) ;
sub ], None) ], None) ;
Prim (_, "CDR", [], None) ;
Prim (_, "SWAP", [], None) ;
Prim (_, "PAIR", [], None) ], None) ->
steps ("A" :: acc) sub
| Seq (_,
[ Prim (_, "DUP", [], None) ;
Prim (_, "DIP",
[ Seq (_,
[ Prim (_, "CDR", [], None) ;
sub ], None) ], None) ;
Prim (_, "CAR", [], None) ;
Prim (_, "PAIR", [], None) ], None) ->
steps ("D" :: acc) sub
| _ -> None in
match steps [] expanded with
| Some (loc, steps, code) ->
let name = String.concat "" ("MAP_C" :: List.rev ("R" :: steps)) in
Some (Prim (loc, name, [ code ], None))
| None -> None
let roman_of_decimal decimal =
(* http://rosettacode.org/wiki/Roman_numerals/Encode#OCaml *)
let digit x y z = function
| 1 -> [ x ]
| 2 -> [ x ; x ]
| 3 -> [ x ; x ; x ]
| 4 -> [ x ; y ]
| 5 -> [ y ]
| 6 -> [ y ; x ]
| 7 -> [ y ; x ; x ]
| 8 -> [ y ; x ; x ; x ]
| 9 -> [ x ; z ]
| _ -> assert false in
let rec to_roman x =
if x = 0 then []
else if x < 0 then
invalid_arg "Negative roman numeral"
else if x >= 1000 then
"M" :: to_roman (x - 1000)
else if x >= 100 then
digit "C" "D" "M" (x / 100) @ to_roman (x mod 100)
else if x >= 10 then
digit "X" "L" "C" (x / 10) @ to_roman (x mod 10)
else
digit "I" "V" "X" x in
String.concat "" (to_roman decimal)
let unexpand_dxiiivp expanded =
match expanded with
| Seq (loc,
[ Prim (_, "DIP",
[ Seq (_, [ Prim (_, "DIP", [ _ ], None) ], None) as sub ],
None) ],
None) ->
let rec count acc = function
| Seq (_, [ Prim (_, "DIP", [ sub ], None) ], None) -> count (acc + 1) sub
| sub -> (acc, sub) in
let depth, sub = count 1 sub in
let name = "D" ^ roman_of_decimal depth ^ "P" in
Some (Prim (loc, name, [ sub ], None))
| _ -> None
let unexpand_duuuuup expanded =
Michelson: tests for new parser and macro expander
2017-08-24 17:29:43 +04:00
let rec help expanded =
match expanded with
| Seq (loc, [ Prim (_, "DUP", [], None) ], None) -> Some (loc, 1)
| Seq (_, [ Prim (_, "DIP", [expanded'], None);
Prim (_, "SWAP", [], None) ], None) ->
begin
match help expanded' with
| None -> None
| Some (loc, n) -> Some (loc, n + 1)
end
| _ -> None
in let rec dupn = function
| 0 -> "P"
| n -> "U" ^ (dupn (n - 1)) in
match help expanded with
| None -> None
| Some (loc, n) -> Some (Prim (loc, "D" ^ (dupn n), [], None))
Michelson: new parser and macro expander.
2017-06-15 01:35:24 +04:00
let unexpand_paaiair expanded =
match expanded with
| Seq (_, [ Prim (_, "PAIR", [], None) ], None) -> Some expanded
| Seq (loc, (_ :: _ as nodes), None) ->
let rec destruct acc = function
| [] -> Some acc
| Prim (_, "DIP", [ Seq (_, [ sub ], None) ], None) :: rest ->
destruct ("A" :: acc) (sub :: rest)
| Prim (_, "PAIR", [], None) :: rest ->
destruct ("AI" :: acc) rest
| _ -> None in
begin match destruct [] nodes with
| None -> None
| Some seq ->
let name = String.concat "" ("P" :: List.rev ("R" :: seq)) in
Some (Prim (loc, name, [], None))
end
| _ -> None
let unexpand_unpaaiair expanded =
match expanded with
| Seq (loc, (_ :: _ as nodes), None) ->
let rec destruct sacc acc = function
| [] -> Some acc
| Prim (_, "DIP", [ Seq (_, [ sub ], None) ], None) :: rest
| Prim (_, "DIP", [ Seq (_, _, _) as sub ], None) :: rest ->
destruct ("A" :: sacc) acc (sub :: rest)
| Seq (_, [ Prim (_, "DUP", [], None) ;
Reindent all files Now `make test` fails when sources are not indented correctly, the indentation test is also executed in the CI.
2017-11-13 19:34:00 +04:00
Prim (_, "CAR", [], None) ;
Prim (_, "DIP",
[ Seq (_,
[ Prim (_, "CDR", [], None) ], None) ],
None) ], None) :: rest ->
Michelson: new parser and macro expander.
2017-06-15 01:35:24 +04:00
destruct [] (List.rev ("AI" :: sacc) :: acc) rest
| _ -> None in
begin match destruct [] [ [ "R" ] ] nodes with
| None -> None
| Some seq ->
let name = String.concat "" ("UNP" :: List.flatten seq) in
Some (Prim (loc, name, [], None))
end
| _ -> None
let unexpand_compare expanded =
match expanded with
| Seq (loc, [ Prim (_, "COMPARE", [], None) ;
Prim (_, "EQ", [], None) ], None) ->
Some (Prim (loc, "CMPEQ", [], None))
| Seq (loc, [ Prim (_, "COMPARE", [], None) ;
Prim (_, "NEQ", [], None) ], None) ->
Some (Prim (loc, "CMPNEQ", [], None))
| Seq (loc, [ Prim (_, "COMPARE", [], None) ;
Prim (_, "LT", [], None) ], None) ->
Some (Prim (loc, "CMPLT", [], None))
| Seq (loc, [ Prim (_, "COMPARE", [], None) ;
Prim (_, "GT", [], None) ], None) ->
Some (Prim (loc, "CMPGT", [], None))
| Seq (loc, [ Prim (_, "COMPARE", [], None) ;
Prim (_, "LE", [], None) ], None) ->
Some (Prim (loc, "CMPLE", [], None))
| Seq (loc, [ Prim (_, "COMPARE", [], None) ;
Prim (_, "GE", [], None) ], None) ->
Some (Prim (loc, "CMPGE", [], None))
| Seq (loc, [ Prim (_, "COMPARE", [], None) ;
Prim (_, "EQ", [], None) ;
Prim (_, "IF", args, None) ], None) ->
Some (Prim (loc, "IFCMPEQ", args, None))
| Seq (loc, [ Prim (_, "COMPARE", [], None) ;
Prim (_, "NEQ", [], None) ;
Prim (_, "IF", args, None) ], None) ->
Some (Prim (loc, "IFCMPNEQ", args, None))
| Seq (loc, [ Prim (_, "COMPARE", [], None) ;
Prim (_, "LT", [], None) ;
Prim (_, "IF", args, None) ], None) ->
Some (Prim (loc, "IFCMPLT", args, None))
| Seq (loc, [ Prim (_, "COMPARE", [], None) ;
Prim (_, "GT", [], None) ;
Prim (_, "IF", args, None) ], None) ->
Some (Prim (loc, "IFCMPGT", args, None))
| Seq (loc, [ Prim (_, "COMPARE", [], None) ;
Prim (_, "LE", [], None) ;
Prim (_, "IF", args, None) ], None) ->
Some (Prim (loc, "IFCMPLE", args, None))
| Seq (loc, [ Prim (_, "COMPARE", [], None) ;
Prim (_, "GE", [], None) ;
Prim (_, "IF", args, None) ], None) ->
Some (Prim (loc, "IFCMPGE", args, None))
| Seq (loc, [ Prim (_, "EQ", [], None) ;
Prim (_, "IF", args, None) ], None) ->
Some (Prim (loc, "IFEQ", args, None))
| Seq (loc, [ Prim (_, "NEQ", [], None) ;
Prim (_, "IF", args, None) ], None) ->
Some (Prim (loc, "IFNEQ", args, None))
| Seq (loc, [ Prim (_, "LT", [], None) ;
Prim (_, "IF", args, None) ], None) ->
Some (Prim (loc, "IFLT", args, None))
| Seq (loc, [ Prim (_, "GT", [], None) ;
Prim (_, "IF", args, None) ], None) ->
Some (Prim (loc, "IFGT", args, None))
| Seq (loc, [ Prim (_, "LE", [], None) ;
Prim (_, "IF", args, None) ], None) ->
Some (Prim (loc, "IFLE", args, None))
| Seq (loc, [ Prim (_, "GE", [], None) ;
Prim (_, "IF", args, None) ], None) ->
Some (Prim (loc, "IFGE", args, None))
| _ -> None
Michelson: tests for new parser and macro expander
2017-08-24 17:29:43 +04:00
let unexpand_asserts expanded =
match expanded with
| Seq (loc, [ Prim (_, "IF", [ Seq (_, [ ], None) ;
Seq (_, [ Prim(_, "FAIL", [], None) ], None) ],
None) ], None) ->
Some (Prim (loc, "ASSERT", [], None))
| Seq (loc, [ Seq (_, [ Prim(_, "COMPARE", [], None) ; Prim(_, comparison, [], None) ], None) ;
Prim (_, "IF", [ Seq (_, [ ], None) ;
Seq (_, [ Prim(_, "FAIL", [], None) ], None) ],
None) ], None) ->
Some (Prim (loc, "ASSERT_CMP" ^ comparison, [], None))
| Seq (loc, [ Prim (_, comparison, [], None) ;
Prim (_, "IF", [ Seq (_, [ ], None) ;
Seq (_, [ Prim(_, "FAIL", [], None) ], None) ],
None) ], None) ->
Some (Prim (loc, "ASSERT_" ^ comparison, [], None))
| Seq (loc, [ Prim (_, "IF_NONE", [ Seq (_, [ ], None) ;
Seq (_, [ Prim(_, "FAIL", [], None) ], None) ],
None) ], None) ->
Some (Prim (loc, "ASSERT_NONE", [], None))
| Seq (loc, [ Prim (_, "IF_NONE", [ Seq (_, [ Prim(_, "FAIL", [], None) ], None) ;
Seq (_, [ ], None)],
None) ], None) ->
Some (Prim (loc, "ASSERT_SOME", [], None))
| Seq (loc, [ Prim (_, "IF_LEFT", [ Seq (_, [ ], None) ;
Seq (_, [ Prim(_, "FAIL", [], None) ], None) ],
None) ], None) ->
Some (Prim (loc, "ASSERT_LEFT", [], None))
| Seq (loc, [ Prim (_, "IF_LEFT", [ Seq (_, [ Prim(_, "FAIL", [], None) ], None) ;
Seq (_, [ ], None) ],
None) ], None) ->
Some (Prim (loc, "ASSERT_RIGHT", [], None))
| _ -> None
let unexpand_if_some = function
| Seq (loc, [ Prim (_, "IF_NONE", [ left ; right ], None) ], None) ->
Some (Prim (loc, "IF_SOME", [ right ; left ], None))
| _ -> None
let unexpand_if_right = function
| Seq (loc, [ Prim (_, "IF_LEFT", [ left ; right ], None) ], None) ->
Some (Prim (loc, "IF_RIGHT", [ right ; left ], None))
| _ -> None
Michelson: new parser and macro expander.
2017-06-15 01:35:24 +04:00
let unexpand original =
let try_expansions unexpanders =
match
List.fold_left
(fun acc f ->
match acc with
| None -> f original
| Some rewritten -> Some rewritten)
None unexpanders with
| None -> original
| Some rewritten -> rewritten in
try_expansions
Michelson: tests for new parser and macro expander
2017-08-24 17:29:43 +04:00
[ unexpand_asserts ;
unexpand_caddadr ;
Michelson: new parser and macro expander.
2017-06-15 01:35:24 +04:00
unexpand_set_caddadr ;
unexpand_map_caddadr ;
unexpand_dxiiivp ;
unexpand_paaiair ;
unexpand_unpaaiair ;
unexpand_duuuuup ;
Michelson: tests for new parser and macro expander
2017-08-24 17:29:43 +04:00
unexpand_compare ;
unexpand_if_some ;
unexpand_if_right ]
Reference in New Issue Copy Permalink