From 9ae39bab974ba8532acd8ff51dd685650e1eed6f Mon Sep 17 00:00:00 2001
From: Tom Jack <tom@tomjack.co>
Date: Thu, 24 Oct 2019 23:23:29 -0500
Subject: [PATCH 1/4] Fix (latent?) Babylon bug in self_michelson pass

---
 src/passes/9-self_michelson/self_michelson.ml | 31 ++++++-------------
 1 file changed, 9 insertions(+), 22 deletions(-)

diff --git a/src/passes/9-self_michelson/self_michelson.ml b/src/passes/9-self_michelson/self_michelson.ml
index 50d5e6dc0..46c2b374d 100644
--- a/src/passes/9-self_michelson/self_michelson.ml
+++ b/src/passes/9-self_michelson/self_michelson.ml
@@ -271,15 +271,15 @@ let rec iterate_optimizer (f : michelson -> bool * michelson) : michelson -> mic
 
 let opt_drop2 : peep2 = function
   (* nullary_op ; DROP  ↦  *)
-  | Prim (_, p, _, _), Prim (_, I_DROP, _, _) when is_nullary_op p -> Some []
+  | Prim (_, p, _, _), Prim (_, I_DROP, [], _) when is_nullary_op p -> Some []
   (* DUP ; DROP  ↦  *)
-  | Prim (_, I_DUP, _, _), Prim (_, I_DROP, _, _) -> Some []
+  | Prim (_, I_DUP, _, _), Prim (_, I_DROP, [], _) -> Some []
   (* unary_op ; DROP  ↦  DROP *)
-  | Prim (_, p, _, _), Prim (_, I_DROP, _, _) when is_unary_op p -> Some [i_drop]
+  | Prim (_, p, _, _), Prim (_, I_DROP, [], _) when is_unary_op p -> Some [i_drop]
   (* binary_op ; DROP  ↦  DROP ; DROP *)
-  | Prim (_, p, _, _), Prim (_, I_DROP, _, _) when is_binary_op p -> Some [i_drop; i_drop]
+  | Prim (_, p, _, _), Prim (_, I_DROP, [], _) when is_binary_op p -> Some [i_drop; i_drop]
   (* ternary_op ; DROP  ↦  DROP ; DROP ; DROP *)
-  | Prim (_, p, _, _), Prim (_, I_DROP, _, _) when is_ternary_op p -> Some [i_drop; i_drop; i_drop]
+  | Prim (_, p, _, _), Prim (_, I_DROP, [], _) when is_ternary_op p -> Some [i_drop; i_drop; i_drop]
   | _ -> None
 
 let opt_drop4 : peep4 = function
@@ -287,7 +287,7 @@ let opt_drop4 : peep4 = function
   | Prim (_, I_DUP, _, _),
     (Prim (_, p, _, _) as unary_op),
     Prim (_, I_SWAP, _, _),
-    Prim (_, I_DROP, _, _)
+    Prim (_, I_DROP, [], _)
     when is_unary_op p ->
     Some [unary_op]
   | _ -> None
@@ -301,19 +301,6 @@ let opt_dip1 : peep1 = function
   (* DIP { unary_op }  ↦  SWAP ; unary_op ; SWAP *)
   | Prim (_, I_DIP, [Seq (_, [(Prim (_, p, _, _) as unary_op)])], _) when is_unary_op p ->
      Some [i_swap ; unary_op ; i_swap]
-  (* saves 5 bytes *)
-  (* DIP { DROP }  ↦  SWAP ; DROP *)
-  | Prim (_, I_DIP, [Seq (_, [Prim (_, I_DROP, _, _)])], _) ->
-     Some [i_swap; i_drop]
-  (* saves 3 bytes *)
-  (* DIP { DROP ; DROP }  ↦  SWAP ; DROP ; SWAP ; DROP *)
-  | Prim (_, I_DIP, [Seq (_, [Prim (_, I_DROP, _, _) ; Prim (_, I_DROP, _, _)])], _) ->
-     Some [i_swap; i_drop; i_swap; i_drop]
-  (* still saves 1 byte *)
-  (* DIP { DROP ; DROP ; DROP }  ↦  SWAP ; DROP ; SWAP ; DROP ; SWAP ; DROP *)
-  | Prim (_, I_DIP, [Seq (_, [Prim (_, I_DROP, _, _) ; Prim (_, I_DROP, _, _) ; Prim (_, I_DROP, _, _)])], _) ->
-     Some [i_swap; i_drop; i_swap; i_drop; i_swap; i_drop]
-  (* after this, DIP { DROP ; ... } is smaller *)
   | _ -> None
 
 let opt_dip2 : peep2 = function
@@ -323,16 +310,16 @@ let opt_dip2 : peep2 = function
   | Prim (_, I_DIP, [Seq (_, code1)], _), Prim (_, I_DIP, [Seq (_, code2)], _) ->
      Some [Prim (0, I_DIP, [Seq (0, code1 @ code2)], [])]
   (* DIP { code } ; DROP  ↦  DROP ; code *)
-  | Prim (_, I_DIP, code, _), (Prim (_, I_DROP, _, _) as drop) ->
+  | Prim (_, I_DIP, [Seq (_, code)], _), (Prim (_, I_DROP, [], _) as drop) ->
      Some (drop :: code)
   (* nullary_op ; DIP { code }  ↦  code ; nullary_op *)
   | (Prim (_, p, _, _) as nullary_op), Prim (_, I_DIP, [Seq (_, code)], _) when is_nullary_op p ->
      Some (code @ [nullary_op])
   (* DIP { code } ; unary_op  ↦  unary_op ; DIP { code } *)
-  | (Prim (_, I_DIP, _, _) as dip), (Prim (_, p, _, _) as unary_op) when is_unary_op p ->
+  | (Prim (_, I_DIP, [Seq _], _) as dip), (Prim (_, p, _, _) as unary_op) when is_unary_op p ->
      Some [unary_op; dip]
   (* unary_op ; DIP { code }  ↦  DIP { code } ; unary_op *)
-  (* | (Prim (_, p, _, _) as unary_op), (Prim (_, I_DIP, _, _) as dip) when is_unary_op p ->
+  (* | (Prim (_, p, _, _) as unary_op), (Prim (_, I_DIP, [Seq _], _) as dip) when is_unary_op p ->
    *    Some [dip; unary_op] *)
   | _ -> None
 

From dae4f582974349a9e79030272155967e233011db Mon Sep 17 00:00:00 2001
From: Tom Jack <tom@tomjack.co>
Date: Thu, 24 Oct 2019 23:56:26 -0500
Subject: [PATCH 2/4] Combine adjacent DROP

---
 src/passes/9-self_michelson/self_michelson.ml | 16 ++++++++++++++++
 vendors/ligo-utils/tezos-utils/x_michelson.ml |  1 +
 2 files changed, 17 insertions(+)

diff --git a/src/passes/9-self_michelson/self_michelson.ml b/src/passes/9-self_michelson/self_michelson.ml
index 46c2b374d..742e64341 100644
--- a/src/passes/9-self_michelson/self_michelson.ml
+++ b/src/passes/9-self_michelson/self_michelson.ml
@@ -365,6 +365,21 @@ let rec opt_tail_fail : michelson -> michelson =
      Prim (l, p, List.map opt_tail_fail args, annot)
   | x -> x
 
+let opt_combine_drops : peep2 = function
+  (* DROP ; DROP  ↦  DROP 2 *)
+  | Prim (_, I_DROP, [], _), Prim (_, I_DROP, [], _) ->
+    Some [i_dropn 2]
+  (* DROP ; DROP m  ↦  DROP 1+m *)
+  | Prim (_, I_DROP, [], _), Prim (_, I_DROP, [Int (_, m)], _) ->
+    Some [i_dropn (1 + Z.to_int m)]
+  (* DROP n ; DROP  ↦  DROP n+1 *)
+  | Prim (_, I_DROP, [Int (_, n)], _), Prim (_, I_DROP, [], _) ->
+    Some [i_dropn (Z.to_int n + 1)]
+  (* DROP n ; DROP m  ↦  DROP n+m *)
+  | Prim (_, I_DROP, [Int (_, n)], _), Prim (_, I_DROP, [Int (_, m)], _) ->
+    Some [i_dropn (Z.to_int n + Z.to_int m)]
+  | _ -> None
+
 let optimize : michelson -> michelson =
   fun x ->
   let x = use_lambda_instr x in
@@ -378,4 +393,5 @@ let optimize : michelson -> michelson =
                      peephole @@ peep2 opt_swap2 ;
                    ] in
   let x = iterate_optimizer (sequence_optimizers optimizers) x in
+  let x = iterate_optimizer (peephole @@ peep2 opt_combine_drops) x in
   x
diff --git a/vendors/ligo-utils/tezos-utils/x_michelson.ml b/vendors/ligo-utils/tezos-utils/x_michelson.ml
index a922fa382..e82237d00 100644
--- a/vendors/ligo-utils/tezos-utils/x_michelson.ml
+++ b/vendors/ligo-utils/tezos-utils/x_michelson.ml
@@ -58,6 +58,7 @@ let i_some = prim I_SOME
 let i_lambda arg ret body = prim ~children:[arg;ret;body] I_LAMBDA
 let i_empty_map src dst = prim ~children:[src;dst] I_EMPTY_MAP
 let i_drop = prim I_DROP
+let i_dropn n = prim I_DROP ~children:[int (Z.of_int n)]
 let i_exec = prim I_EXEC
 
 let i_if a b = prim ~children:[seq [a] ; seq[b]] I_IF

From 7c99affd4b1981b55866552959b41c97acd82b34 Mon Sep 17 00:00:00 2001
From: Tom Jack <tom@tomjack.co>
Date: Thu, 24 Oct 2019 23:56:34 -0500
Subject: [PATCH 3/4] Organize prims by their strangeness

---
 src/passes/9-self_michelson/self_michelson.ml | 61 +++++++++++--------
 1 file changed, 34 insertions(+), 27 deletions(-)

diff --git a/src/passes/9-self_michelson/self_michelson.ml b/src/passes/9-self_michelson/self_michelson.ml
index 742e64341..a10096478 100644
--- a/src/passes/9-self_michelson/self_michelson.ml
+++ b/src/passes/9-self_michelson/self_michelson.ml
@@ -14,13 +14,44 @@ open Tezos_utils.Michelson
    without effects other than gas consumption. It must never fail. *)
 
 let arity : prim -> int option = function
+ (* stack things *)
+ | I_DIP -> None
+ | I_DROP -> None
+ | I_DUP -> None
+ | I_SWAP -> None
+ | I_DIG -> None
+ | I_DUG -> None
+ (* control *)
+ | I_FAILWITH -> None
+ | I_EXEC -> None
+ | I_IF -> None
+ | I_IF_CONS -> None
+ | I_IF_LEFT -> None
+ | I_IF_NONE -> None
+ | I_LOOP -> None
+ | I_MAP -> None
+ | I_ITER -> None
+ | I_LOOP_LEFT -> None
+ (* internal ops *)
+ | I_CREATE_ACCOUNT -> None
+ | I_CREATE_CONTRACT -> None
+ | I_TRANSFER_TOKENS -> None
+ | I_SET_DELEGATE -> None
+ (* tez arithmetic (can fail) *)
+ | I_ADD -> None
+ | I_MUL -> None
+ | I_SUB -> None (* can fail for tez *)
+ (* etc *)
+ | I_CONCAT -> None (* sometimes 1, sometimes 2 :( *)
+ | I_CAST -> None
+ | I_RENAME -> None
+ (* stuff *)
  | I_PACK -> Some 1
  | I_UNPACK -> Some 1
  | I_BLAKE2B -> Some 1
  | I_SHA256 -> Some 1
  | I_SHA512 -> Some 1
  | I_ABS -> Some 1
- | I_ADD -> None (* can fail for tez *)
  | I_AMOUNT -> Some 0
  | I_AND -> Some 2
  | I_BALANCE -> Some 0
@@ -28,39 +59,24 @@ let arity : prim -> int option = function
  | I_CDR -> Some 1
  | I_CHECK_SIGNATURE -> Some 3
  | I_COMPARE -> Some 2
- | I_CONCAT -> None (* sometimes 1, sometimes 2 :( *)
  | I_CONS -> Some 2
- | I_CREATE_ACCOUNT -> None (* effects, kind of *)
- | I_CREATE_CONTRACT -> None (* effects, kind of *)
  | I_IMPLICIT_ACCOUNT -> Some 1
- | I_DIP -> None
- | I_DROP -> None
- | I_DUP -> None
  | I_EDIV -> Some 2
  | I_EMPTY_MAP -> Some 0
  | I_EMPTY_SET -> Some 0
  | I_EQ -> Some 1
- | I_EXEC -> None (* effects *)
- | I_FAILWITH -> None
  | I_GE -> Some 1
  | I_GET -> Some 2
  | I_GT -> Some 1
  | I_HASH_KEY -> Some 1
- | I_IF -> None
- | I_IF_CONS -> None
- | I_IF_LEFT -> None
- | I_IF_NONE -> None
  | I_INT -> Some 1
  | I_LAMBDA -> Some 0
  | I_LE -> Some 1
  | I_LEFT -> Some 1
- | I_LOOP -> None
  | I_LSL -> Some 1
  | I_LSR -> Some 1
  | I_LT -> Some 1
- | I_MAP -> None
  | I_MEM -> Some 2
- | I_MUL -> None (* can fail for tez *)
  | I_NEG -> Some 1
  | I_NEQ -> Some 1
  | I_NIL -> Some 0
@@ -78,26 +94,17 @@ let arity : prim -> int option = function
  | I_SELF -> Some 0
  | I_SLICE -> Some 3
  | I_STEPS_TO_QUOTA -> Some 0
- | I_SUB -> None (* can fail for tez *)
- | I_SWAP -> None
- | I_TRANSFER_TOKENS -> None (* effects, kind of *)
- | I_SET_DELEGATE -> None (* effects, kind of *)
  | I_UNIT -> Some 0
  | I_UPDATE -> Some 3
  | I_XOR -> Some 2
- | I_ITER -> None
- | I_LOOP_LEFT -> None
  | I_ADDRESS -> Some 1
  | I_CONTRACT -> Some 1
  | I_ISNAT -> Some 1
- | I_CAST -> None
- | I_RENAME -> None
  | I_CHAIN_ID -> Some 0
  | I_EMPTY_BIG_MAP -> Some 0
- | I_APPLY -> None
- | I_DIG -> None
- | I_DUG -> None
+ | I_APPLY -> Some 2
 
+ (* not instructions *)
  | K_parameter
  | K_storage
  | K_code

From afbf2ba2dbcae481f431099d11c66c1ccee57c0d Mon Sep 17 00:00:00 2001
From: Tom Jack <tom@tomjack.co>
Date: Fri, 25 Oct 2019 00:42:31 -0500
Subject: [PATCH 4/4] Less stupid way to combine adjacent drops

---
 src/passes/9-self_michelson/self_michelson.ml | 33 ++++++++++---------
 1 file changed, 18 insertions(+), 15 deletions(-)

diff --git a/src/passes/9-self_michelson/self_michelson.ml b/src/passes/9-self_michelson/self_michelson.ml
index a10096478..711bf64f2 100644
--- a/src/passes/9-self_michelson/self_michelson.ml
+++ b/src/passes/9-self_michelson/self_michelson.ml
@@ -372,20 +372,23 @@ let rec opt_tail_fail : michelson -> michelson =
      Prim (l, p, List.map opt_tail_fail args, annot)
   | x -> x
 
-let opt_combine_drops : peep2 = function
-  (* DROP ; DROP  ↦  DROP 2 *)
-  | Prim (_, I_DROP, [], _), Prim (_, I_DROP, [], _) ->
-    Some [i_dropn 2]
-  (* DROP ; DROP m  ↦  DROP 1+m *)
-  | Prim (_, I_DROP, [], _), Prim (_, I_DROP, [Int (_, m)], _) ->
-    Some [i_dropn (1 + Z.to_int m)]
-  (* DROP n ; DROP  ↦  DROP n+1 *)
-  | Prim (_, I_DROP, [Int (_, n)], _), Prim (_, I_DROP, [], _) ->
-    Some [i_dropn (Z.to_int n + 1)]
-  (* DROP n ; DROP m  ↦  DROP n+m *)
-  | Prim (_, I_DROP, [Int (_, n)], _), Prim (_, I_DROP, [Int (_, m)], _) ->
-    Some [i_dropn (Z.to_int n + Z.to_int m)]
-  | _ -> None
+let rec opt_combine_drops (x : michelson) : michelson =
+  let rec combine : michelson list -> michelson list = function
+    | [] -> []
+    | Prim (_, I_DROP, [], []) :: xs ->
+      let xs' = combine xs in
+      begin match xs' with
+      | [] -> [Prim (-1, I_DROP, [], [])]
+      | Prim (_, I_DROP, [], []) :: xs' -> Prim (-1, I_DROP, [Int (-1, Z.of_int 2)], []) :: xs'
+      | Prim (_, I_DROP, [Int (_, n)], []) :: xs' -> Prim (-1, I_DROP, [Int (-1, Z.of_int (1 + Z.to_int n))], []) :: xs'
+      | x' :: xs' -> Prim (-1, I_DROP, [], []) :: x' :: xs'
+      end
+    | x :: xs -> x :: combine xs in
+  match x with
+  | Seq (l, args) -> Seq (l, combine (List.map opt_combine_drops args))
+  | Prim (l, p, args, annot) ->
+    Prim (l, p, List.map opt_combine_drops args, annot)
+  | x -> x
 
 let optimize : michelson -> michelson =
   fun x ->
@@ -400,5 +403,5 @@ let optimize : michelson -> michelson =
                      peephole @@ peep2 opt_swap2 ;
                    ] in
   let x = iterate_optimizer (sequence_optimizers optimizers) x in
-  let x = iterate_optimizer (peephole @@ peep2 opt_combine_drops) x in
+  let x = opt_combine_drops x in
   x