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

Michelson: fix and extend macro expansion.

Browse Source 
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

242
src/client/embedded/bootstrap/concrete_parser.mly
View File

@ -22,22 +22,25 @@
open Script_located_ir open Script_located_ir
let expand_caddadr loc str = let expand_caddadr original =
let len = String.length str in match original with
if len > 3 | Prim (loc, str, []) ->
&& String.get str 0 = 'C' let len = String.length str in
&& String.get str (len - 1) = 'R' then if len > 3
let rec parse i acc = && String.get str 0 = 'C'
if i = 0 then && String.get str (len - 1) = 'R' then
Some (Seq (loc, acc)) let rec parse i acc =
else if i = 0 then
match String.get str i with Some (Seq (loc, acc))
| 'A' -> parse (i - 1) (Prim (loc, "CAR", []) :: acc) else
| 'D' -> parse (i - 1) (Prim (loc, "CDR", []) :: acc) match String.get str i with
| _ -> None in | 'A' -> parse (i - 1) (Prim (loc, "CAR", []) :: acc)
parse (len - 2) [] | 'D' -> parse (i - 1) (Prim (loc, "CDR", []) :: acc)
else | _ -> None in
None parse (len - 2) []
else
None
| _ -> None
exception Not_a_roman exception Not_a_roman
@ -64,64 +67,163 @@ let decimal_of_roman roman =
done; done;
!arabic !arabic
let expand_dxiiivp loc str arg = let expand_dxiiivp original =
let len = String.length str in match original with
if len > 3 | Prim (loc, str, [ arg ]) ->
&& String.get str 0 = 'D' let len = String.length str in
&& String.get str (len - 1) = 'P' then if len > 3
try && String.get str 0 = 'D'
let depth = decimal_of_roman (String.sub str 1 (len - 2)) in && String.get str (len - 1) = 'P' then
let rec make i = try
if i = 0 then let depth = decimal_of_roman (String.sub str 1 (len - 2)) in
arg let rec make i acc =
else if i = 0 then
let sub = make (i - 1) in acc
Prim (loc, "DIP", [ Seq (loc, [ sub ]) ]) in else
Some (make depth) make (i - 1)
with Not_a_roman -> None (Seq (loc, [ Prim (loc, "DIP", [ acc ]) ])) in
else None Some (make depth arg)
with Not_a_roman -> None
else None
| _ -> None
exception Not_a_pair exception Not_a_pair
let expand_paaiair loc str = let expand_paaiair original =
let len = String.length str in match original with
if len > 4 | Prim (loc, str, []) ->
&& String.get str 0 = 'P' let len = String.length str in
&& String.get str (len - 1) = 'R' then if len > 4
try && String.get str 0 = 'P'
let rec parse i acc = && String.get str (len - 1) = 'R' then
if String.get str i = 'I' try
&& String.get str (i - 1) = 'A' then let rec parse i acc =
parse (i - 2) (Prim (loc, "PAIR", []) :: acc) if i = 0 then
else if String.get str i = 'A' then acc
match acc with else if String.get str i = 'I'
| [] -> && String.get str (i - 1) = 'A' then
raise Not_a_pair parse (i - 2) (Prim (loc, "PAIR", []) :: acc)
| acc :: accs -> else if String.get str i = 'A' then
parse (i - 1) (Prim (loc, "DIP", [ acc ]) :: accs) match acc with
else | [] ->
raise Not_a_pair in raise Not_a_pair
Some (Seq (loc, parse (len - 2) [])) | acc :: accs ->
with Not_a_pair -> None parse (i - 1) (Prim (loc, "DIP", [ acc ]) :: accs)
else else
None raise Not_a_pair in
Some (Seq (loc, parse (len - 2) []))
with Not_a_pair -> None
else
None
| _ -> None
let expand = function exception Not_a_dup
| Prim (loc, name, [ arg ]) as original ->
begin match expand_dxiiivp loc name arg with let expand_duuuuup original =
| None -> original match original with
| Some rewritten -> rewritten | Prim (loc, str, []) ->
end let len = String.length str in
| Prim (loc, name, []) as original -> if len > 3
begin match expand_paaiair loc name with && String.get str 0 = 'D'
| None -> && String.get str 1 = 'U'
begin match expand_caddadr loc name with && String.get str (len - 1) = 'P' then
| None -> original try
| Some rewritten -> rewritten let rec parse i acc =
end if i = 1 then acc
| Some rewritten -> rewritten else if String.get str i = 'U' then
end parse (i - 1)
| original -> original (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 in
try_expansions
[ expand_dxiiivp ;
expand_paaiair ;
expand_caddadr ;
expand_duuuuup ;
expand_compare ]
let apply node arg = let apply node arg =
match node with match node with

4
src/proto/bootstrap/docs/language.md
View File

@ -539,11 +539,11 @@ combinators, and also for branching.
* `IF{EQ|NEQ|LT|GT|LE|GE} bt bf` * `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{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 V - Operations