diff --git a/src/proto_alpha/lib_client/michelson_v1_macros.ml b/src/proto_alpha/lib_client/michelson_v1_macros.ml index 8e253279b..478ab4de0 100644 --- a/src/proto_alpha/lib_client/michelson_v1_macros.ml +++ b/src/proto_alpha/lib_client/michelson_v1_macros.ml @@ -821,6 +821,14 @@ let roman_of_decimal decimal = digit "I" "V" "X" x in 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 = match expanded with | Seq (loc, @@ -831,7 +839,7 @@ let unexpand_dxiiivp expanded = | Seq (_, [ Prim (_, "DIP", [ sub ], []) ]) -> count (acc + 1) sub | sub -> (acc, 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 ], [])) | _ -> None diff --git a/src/proto_alpha/lib_delegate/test/test_michelson_parser.ml b/src/proto_alpha/lib_delegate/test/test_michelson_parser.ml index efab13fcf..8119006ad 100644 --- a/src/proto_alpha/lib_delegate/test/test_michelson_parser.ml +++ b/src/proto_alpha/lib_delegate/test/test_michelson_parser.ml @@ -190,6 +190,10 @@ let test_unexpansion_consistency () = assert_unexpansion_consistent (Prim (zero_loc, "UNPAPAPAIR", [], [])) >>? fun () -> assert_unexpansion_consistent (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_CDR", [], [])) >>? fun () -> assert_unexpansion_consistent (Prim (zero_loc, "DUP", [], [])) >>? fun () ->