From be75fd48304f8a08f64b5cb17b5832c5134da37e Mon Sep 17 00:00:00 2001
From: galfour <gabriel.alfour@gmail.com>
Date: Wed, 25 Sep 2019 17:21:44 +0200
Subject: [PATCH] fixed minor bug

---
 src/main/compile/dune                         |  3 +-
 src/main/compile/of_mini_c.ml                 |  6 ++--
 src/passes/9-self_michelson/dune              | 12 +++++++
 src/passes/9-self_michelson/helpers.ml        | 19 ++++++++++++
 src/passes/9-self_michelson/main.ml           |  0
 src/passes/9-self_michelson/self_michelson.ml | 31 +++++++++++++++++++
 6 files changed, 67 insertions(+), 4 deletions(-)
 create mode 100644 src/passes/9-self_michelson/dune
 create mode 100644 src/passes/9-self_michelson/helpers.ml
 create mode 100644 src/passes/9-self_michelson/main.ml
 create mode 100644 src/passes/9-self_michelson/self_michelson.ml

diff --git a/src/main/compile/dune b/src/main/compile/dune
index e8520e473..a3c992c69 100644
--- a/src/main/compile/dune
+++ b/src/main/compile/dune
@@ -12,8 +12,9 @@
     ast_typed
     transpiler
     mini_c
-    operators
     compiler
+    self_michelson
+    operators
   )
   (preprocess
     (pps ppx_let)
diff --git a/src/main/compile/of_mini_c.ml b/src/main/compile/of_mini_c.ml
index fd8de3570..1a385040f 100644
--- a/src/main/compile/of_mini_c.ml
+++ b/src/main/compile/of_mini_c.ml
@@ -8,11 +8,13 @@ let compile_value : value -> type_value -> Michelson.t result =
 let compile_expression_as_value  : expression -> _ result = fun e ->
   let%bind value = expression_to_value e in
   let%bind result = compile_value value e.type_value in
+  let%bind result = Self_michelson.all_expression result in
   ok result
 
 let compile_expression_as_function : expression -> _ result = fun e ->
   let (input , output) = t_unit , e.type_value in
   let%bind body = Compiler.Program.translate_expression e Compiler.Environment.empty in
+  let%bind body = Self_michelson.all_expression body in
   let body = Michelson.(seq [ i_drop ; body ]) in
   let%bind (input , output) = bind_map_pair Compiler.Type.Ty.type_ (input , output) in
   let open! Compiler.Program in
@@ -22,13 +24,11 @@ let compile_function = fun e ->
   let%bind (input , output) = get_t_function e.type_value in
   let%bind body = get_function e in
   let%bind body = compile_value body (t_function input output) in
+  let%bind body = Self_michelson.all_expression body in
   let%bind (input , output) = bind_map_pair Compiler.Type.Ty.type_ (input , output) in
   let open! Compiler.Program in
   ok { input ; output ; body }
 
-(* let compile_function : anon_function -> (type_value * type_value) -> Compiler.Program.compiled_program result = fun f io ->
- *   Compiler.Program.translate_entry f io *)
-
 let compile_expression_as_function_entry = fun program name ->
   let%bind aggregated = aggregate_entry program name true in
   compile_function aggregated
diff --git a/src/passes/9-self_michelson/dune b/src/passes/9-self_michelson/dune
new file mode 100644
index 000000000..047fe33a4
--- /dev/null
+++ b/src/passes/9-self_michelson/dune
@@ -0,0 +1,12 @@
+(library
+  (name self_michelson)
+  (public_name ligo.self_michelson)
+  (libraries
+    simple-utils
+    tezos-utils
+  )
+  (preprocess
+    (pps ppx_let)
+  )
+  (flags (:standard -w +1..62-4-9-44-40-42-48-30@39@33 -open Simple_utils ))
+)
diff --git a/src/passes/9-self_michelson/helpers.ml b/src/passes/9-self_michelson/helpers.ml
new file mode 100644
index 000000000..4ce8670c1
--- /dev/null
+++ b/src/passes/9-self_michelson/helpers.ml
@@ -0,0 +1,19 @@
+open Trace
+open Tezos_utils
+open Michelson
+open Tezos_micheline.Micheline
+
+type mapper = michelson -> michelson result
+let rec map_expression : mapper -> michelson -> michelson result = fun f e ->
+  let self = map_expression f in
+  let%bind e' = f e in
+  match e' with
+  | Prim (l , p , lst , a) -> (
+      let%bind lst' = bind_map_list self lst in
+      ok @@ Prim (l , p , lst' , a)
+    )
+  | Seq (l , lst) -> (
+      let%bind lst' = bind_map_list self lst in
+      ok @@ Seq (l , lst')
+    )
+  | x -> ok x
diff --git a/src/passes/9-self_michelson/main.ml b/src/passes/9-self_michelson/main.ml
new file mode 100644
index 000000000..e69de29bb
diff --git a/src/passes/9-self_michelson/self_michelson.ml b/src/passes/9-self_michelson/self_michelson.ml
new file mode 100644
index 000000000..07d8e4f64
--- /dev/null
+++ b/src/passes/9-self_michelson/self_michelson.ml
@@ -0,0 +1,31 @@
+open Trace
+open Tezos_micheline.Micheline
+open Memory_proto_alpha.Protocol.Michelson_v1_primitives
+
+let strip_annots = fun e ->
+  match e with
+  | Prim (l , p , lst , _) -> ok @@ Prim (l , p , lst , [])
+  | x -> ok x
+
+let strip_nops = fun e ->
+  match e with
+  | Seq(l, [Prim (_, I_UNIT, _, _) ; Prim(_, I_DROP, _, _)]) -> ok @@ Seq (l, [])
+  | x -> ok x
+
+
+let all = [
+  strip_annots ;
+  strip_nops ;
+]
+
+let rec bind_chain : ('a -> 'a result) list -> 'a -> 'a result = fun fs x ->
+  match fs with
+  | [] -> ok x
+  | hd :: tl -> (
+      let aux : 'a -> 'a result = fun x -> bind (bind_chain tl) (hd x) in
+      bind aux (ok x)
+    )
+
+let all_expression =
+  let all_expr = List.map Helpers.map_expression all in
+  bind_chain all_expr