Michelson: fix and extend macro expansion.

fixes #114
fixes #115
This commit is contained in:
Benjamin Canou 2017-01-11 18:51:59 +01:00
parent 507c46bbcb
commit 3cce0f3d1d
2 changed files with 174 additions and 72 deletions

View File

@ -22,7 +22,9 @@
open Script_located_ir
let expand_caddadr loc str =
let expand_caddadr original =
match original with
| Prim (loc, str, []) ->
let len = String.length str in
if len > 3
&& String.get str 0 = 'C'
@ -38,6 +40,7 @@ let expand_caddadr loc str =
parse (len - 2) []
else
None
| _ -> None
exception Not_a_roman
@ -64,33 +67,40 @@ let decimal_of_roman roman =
done;
!arabic
let expand_dxiiivp loc str arg =
let expand_dxiiivp original =
match original with
| Prim (loc, str, [ arg ]) ->
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 =
let rec make i acc =
if i = 0 then
arg
acc
else
let sub = make (i - 1) in
Prim (loc, "DIP", [ Seq (loc, [ sub ]) ]) in
Some (make depth)
make (i - 1)
(Seq (loc, [ Prim (loc, "DIP", [ acc ]) ])) in
Some (make depth arg)
with Not_a_roman -> None
else None
| _ -> None
exception Not_a_pair
let expand_paaiair loc str =
let expand_paaiair original =
match original with
| Prim (loc, str, []) ->
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 String.get str i = 'I'
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", []) :: acc)
else if String.get str i = 'A' then
@ -105,23 +115,115 @@ let expand_paaiair loc str =
with Not_a_pair -> None
else
None
| _ -> None
let expand = function
| Prim (loc, name, [ arg ]) as original ->
begin match expand_dxiiivp loc name arg with
exception Not_a_dup
let expand_duuuuup original =
match original with
| Prim (loc, str, []) ->
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 ]) ;
Prim (loc, "SWAP", []) ]))
else
raise Not_a_dup in
Some (parse (len - 2) (Seq (loc, [ Prim (loc, "DUP", []) ])))
with Not_a_dup -> None
else
None
| _ -> None
let expand_compare original =
match original with
| Prim (loc, "CMPEQ", []) ->
Some (Seq (loc, [ Prim (loc, "COMPARE", []) ;
Prim (loc, "EQ", []) ]))
| Prim (loc, "CMPNEQ", []) ->
Some (Seq (loc, [ Prim (loc, "COMPARE", []) ;
Prim (loc, "NEQ", []) ]))
| Prim (loc, "CMPLT", []) ->
Some (Seq (loc, [ Prim (loc, "COMPARE", []) ;
Prim (loc, "LT", []) ]))
| Prim (loc, "CMPGT", []) ->
Some (Seq (loc, [ Prim (loc, "COMPARE", []) ;
Prim (loc, "GT", []) ]))
| Prim (loc, "CMPLE", []) ->
Some (Seq (loc, [ Prim (loc, "COMPARE", []) ;
Prim (loc, "LE", []) ]))
| Prim (loc, "CMPGE", []) ->
Some (Seq (loc, [ Prim (loc, "COMPARE", []) ;
Prim (loc, "GE", []) ]))
| Prim (loc, "IFCMPEQ", args) ->
Some (Seq (loc, [ Prim (loc, "COMPARE", []) ;
Prim (loc, "EQ", []) ;
Prim (loc, "IF", args) ]))
| Prim (loc, "IFCMPNEQ", args) ->
Some (Seq (loc, [ Prim (loc, "COMPARE", []) ;
Prim (loc, "NEQ", []) ;
Prim (loc, "IF", args) ]))
| Prim (loc, "IFCMPLT", args) ->
Some (Seq (loc, [ Prim (loc, "COMPARE", []) ;
Prim (loc, "LT", []) ;
Prim (loc, "IF", args) ]))
| Prim (loc, "IFCMPGT", args) ->
Some (Seq (loc, [ Prim (loc, "COMPARE", []) ;
Prim (loc, "GT", []) ;
Prim (loc, "IF", args) ]))
| Prim (loc, "IFCMPLE", args) ->
Some (Seq (loc, [ Prim (loc, "COMPARE", []) ;
Prim (loc, "LE", []) ;
Prim (loc, "IF", args) ]))
| Prim (loc, "IFCMPGE", args) ->
Some (Seq (loc, [ Prim (loc, "COMPARE", []) ;
Prim (loc, "GE", []) ;
Prim (loc, "IF", args) ]))
| Prim (loc, "IFEQ", args) ->
Some (Seq (loc, [ Prim (loc, "EQ", []) ;
Prim (loc, "IF", args) ]))
| Prim (loc, "IFNEQ", args) ->
Some (Seq (loc, [ Prim (loc, "NEQ", []) ;
Prim (loc, "IF", args) ]))
| Prim (loc, "IFLT", args) ->
Some (Seq (loc, [ Prim (loc, "LT", []) ;
Prim (loc, "IF", args) ]))
| Prim (loc, "IFGT", args) ->
Some (Seq (loc, [ Prim (loc, "GT", []) ;
Prim (loc, "IF", args) ]))
| Prim (loc, "IFLE", args) ->
Some (Seq (loc, [ Prim (loc, "LE", []) ;
Prim (loc, "IF", args) ]))
| Prim (loc, "IFGE", args) ->
Some (Seq (loc, [ Prim (loc, "GE", []) ;
Prim (loc, "IF", args) ]))
| _ -> 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
end
| Prim (loc, name, []) as original ->
begin match expand_paaiair loc name with
| None ->
begin match expand_caddadr loc name with
| None -> original
| Some rewritten -> rewritten
end
| Some rewritten -> rewritten
end
| original -> original
| Some rewritten -> rewritten in
try_expansions
[ expand_dxiiivp ;
expand_paaiair ;
expand_caddadr ;
expand_duuuuup ;
expand_compare ]
let apply node arg =
match node with

View File

@ -539,11 +539,11 @@ combinators, and also for branching.
* `IF{EQ|NEQ|LT|GT|LE|GE} bt bf`
> IFCMP(\op) ; C / S => (\op) ; IF bt bf ; C / S
> IF(\op) ; C / S => (\op) ; IF bt bf ; C / S
* `IFCMP{EQ|NEQ|LT|GT|LE|GE} bt bf`
> IFCMP(\op) ; C / S => COMPARE ; IF(\op) bt bf ; C / S
> IFCMP(\op) ; C / S => COMPARE ; (\op) ; IF bt bf ; C / S
V - Operations