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

Merge branch 'optimize-inserted-michelson' into 'dev'

Browse Source 
Optimize inserted michelson

See merge request ligolang/ligo!714
This commit is contained in:
Gabriel Alfour 2020-07-05 07:36:10 +00:00
commit 0c0889f514
2 changed files with 49 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
src/bin/expect_tests/code_insertion.ml
View File

@ -51,9 +51,11 @@ let%expect_test _ =
{ parameter nat ;
storage nat ;
code { DUP ;
LAMBDA (pair nat nat) nat { { { DUP ; CDR ; SWAP ; CAR } } ; ADD } ;
DUP ;
CDR ;
SWAP ;
EXEC ;
CAR ;
ADD ;
NIL operation ;
PAIR ;
DIP { DROP } } } |}]

45
src/passes/14-self_michelson/self_michelson.ml
View File

@ -199,6 +199,7 @@ type peep1 = michelson -> michelson list option
type peep2 = michelson * michelson -> michelson list option
type peep3 = michelson * michelson * michelson -> michelson list option
type peep4 = michelson * michelson * michelson * michelson -> michelson list option
type peep5 = michelson * michelson * michelson * michelson * michelson -> michelson list option
let rec peep1 (f : peep1) : michelson list -> bool * michelson list = function
| [] -> (false, [])
@ -242,6 +243,19 @@ let rec peep4 (f : peep4) : michelson list -> bool * michelson list = function
| None -> let (changed, xs') = peep4 f (x2 :: x3 :: x4 :: xs) in
(changed, x1 :: xs')
let rec peep5 (f : peep5) : michelson list -> bool * michelson list = function
| [] -> (false, [])
| [x] -> (false, [x])
| [x ; y] -> (false, [x ; y])
| [x ; y ; z] -> (false, [x ; y ; z])
| [x ; y ; z ; w] -> (false, [x ; y ; z ; w])
| x1 :: x2 :: x3 :: x4 :: x5 :: xs ->
match f (x1, x2, x3, x4, x5) with
| Some xs' -> let (_, xs') = peep5 f (xs' @ xs) in
(true, xs')
| None -> let (changed, xs') = peep5 f (x2 :: x3 :: x4 :: x5 :: xs) in
(changed, x1 :: xs')
(* apply f to all seqs *)
let rec peephole (f : michelson list -> bool * michelson list) : michelson -> bool * michelson =
let peep_args ~seq args =
@ -354,6 +368,34 @@ let opt_swap2 : peep2 = function
Some [comm_op]
| _ -> None
(* for inserted Michelson lambdas *)
let opt_beta3 : peep3 = function
(* PUSH (lambda ...) code ; SWAP ; EXEC ↦ f *)
| Prim (_, I_PUSH, [Prim(_, T_lambda, _, _); code], _),
Prim (_, I_SWAP, _, _),
Prim (_, I_EXEC, _, _) ->
(match flatten_seqs code with
| Seq (_, code) -> Some code
| _ -> None)
| _ -> None
let opt_beta5 : peep5 = function
(* PAIR ; DUP ; CDR ; SWAP ; CAR ↦ *)
| Prim (_, I_PAIR, _, _),
Prim (_, I_DUP, _, _),
Prim (_, I_CDR, _, _),
Prim (_, I_SWAP, _, _),
Prim (_, I_CAR, _, _) ->
Some []
(* PAIR ; DUP ; CAR ; SWAP ; CDR ↦ SWAP *)
| Prim (_, I_PAIR, _, _),
Prim (_, I_DUP, _, _),
Prim (_, I_CAR, _, _),
Prim (_, I_SWAP, _, _),
Prim (_, I_CDR, _, _) ->
Some [Prim(-1, I_SWAP, [], [])]
| _ -> None
(* This "optimization" deletes dead code produced by the compiler
after a FAILWITH, which is illegal in Michelson. This means we are
thwarting the intent of the Michelson tail fail restriction -- the
@ -431,6 +473,7 @@ let prim_type_args : prim -> int option = function
| I_EMPTY_MAP -> Some 2
| I_EMPTY_BIG_MAP -> Some 2
| I_LAMBDA -> Some 2
| I_PUSH -> Some 1
(* _not_ I_CONTRACT! annot is important there *)
(* but could include I_SELF, maybe? *)
| _ -> None
@ -482,6 +525,8 @@ let optimize : michelson -> michelson =
peephole @@ peep2 opt_dip2 ;
peephole @@ peep1 opt_dip1 ;
peephole @@ peep2 opt_swap2 ;
peephole @@ peep3 opt_beta3 ;
peephole @@ peep5 opt_beta5 ;
] in
let x = iterate_optimizer (sequence_optimizers optimizers) x in
let x = opt_combine_drops x in