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

Michelson: fix roman numeral DIP unexpansion

Browse Source
This commit is contained in:
Tom Jack 2018-12-01 12:10:29 +00:00 committed by Benjamin Canou
parent 3109b7f026
commit 4449389ef2
2 changed files with 13 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -821,6 +821,14 @@ let roman_of_decimal decimal =
digit "I" "V" "X" x in digit "I" "V" "X" x in
String.concat "" (to_roman decimal) String.concat "" (to_roman decimal)
let dxiiivp_roman_of_decimal decimal =
let roman = roman_of_decimal decimal in
if String.length roman = 1 then
(* too short for D*P, fall back to IIIII... *)
String.concat "" (List.init decimal (fun _ -> "I"))
else
roman
let unexpand_dxiiivp expanded = let unexpand_dxiiivp expanded =
match expanded with match expanded with
| Seq (loc, | Seq (loc,
@ -831,7 +839,7 @@ let unexpand_dxiiivp expanded =
| Seq (_, [ Prim (_, "DIP", [ sub ], []) ]) -> count (acc + 1) sub | Seq (_, [ Prim (_, "DIP", [ sub ], []) ]) -> count (acc + 1) sub
| sub -> (acc, sub) in | sub -> (acc, sub) in
let depth, sub = count 1 sub in let depth, sub = count 1 sub in
let name = "D" ^ roman_of_decimal depth ^ "P" in let name = "D" ^ dxiiivp_roman_of_decimal depth ^ "P" in
Some (Prim (loc, name, [ sub ], [])) Some (Prim (loc, name, [ sub ], []))
| _ -> None | _ -> None

4
src/proto_alpha/lib_delegate/test/test_michelson_parser.ml
View File

@ -190,6 +190,10 @@ let test_unexpansion_consistency () =
assert_unexpansion_consistent (Prim (zero_loc, "UNPAPAPAIR", [], [])) >>? fun () -> assert_unexpansion_consistent (Prim (zero_loc, "UNPAPAPAIR", [], [])) >>? fun () ->
assert_unexpansion_consistent assert_unexpansion_consistent
(Prim (zero_loc, "DIIIP", [ Seq (zero_loc, [ Prim (zero_loc, "DROP", [], []) ]) ], [])) >>? fun () -> (Prim (zero_loc, "DIIIP", [ Seq (zero_loc, [ Prim (zero_loc, "DROP", [], []) ]) ], [])) >>? fun () ->
assert_unexpansion_consistent
(Prim (zero_loc, "DIVP", [ Seq (zero_loc, [ Prim (zero_loc, "DROP", [], []) ]) ], [])) >>? fun () ->
assert_unexpansion_consistent
(Prim (zero_loc, "DIIIIIP", [ Seq (zero_loc, [ Prim (zero_loc, "DROP", [], []) ]) ], [])) >>? fun () ->
assert_unexpansion_consistent (Prim (zero_loc, "SET_CAR", [], [])) >>? fun () -> assert_unexpansion_consistent (Prim (zero_loc, "SET_CAR", [], [])) >>? fun () ->
assert_unexpansion_consistent (Prim (zero_loc, "SET_CDR", [], [])) >>? fun () -> assert_unexpansion_consistent (Prim (zero_loc, "SET_CDR", [], [])) >>? fun () ->
assert_unexpansion_consistent (Prim (zero_loc, "DUP", [], [])) >>? fun () -> assert_unexpansion_consistent (Prim (zero_loc, "DUP", [], [])) >>? fun () ->