From f3db37a7b1b5605245f0343a779ec8aba5ee1eb4 Mon Sep 17 00:00:00 2001
From: Galfour <gabriel.alfour@gmail.com>
Date: Wed, 8 May 2019 12:21:33 +0000
Subject: [PATCH] add compile-storage to the cli

---
 src/ligo/bin/cli.ml       | 37 ++++++++++++++++++++++++++++--
 src/ligo/main/contract.ml | 48 +++++++++++++++++++++++++++++++++++++++
 2 files changed, 83 insertions(+), 2 deletions(-)

diff --git a/src/ligo/bin/cli.ml b/src/ligo/bin/cli.ml
index fffef2bb7..a37d5ffcd 100644
--- a/src/ligo/bin/cli.ml
+++ b/src/ligo/bin/cli.ml
@@ -39,7 +39,7 @@ let compile_file =
   let docs = "Compile contracts." in
   (term , Term.info ~docs "compile-contract")
 
-let compile_expression =
+let compile_parameter =
   let f source entry_point expression =
     toplevel @@
     let%bind value =
@@ -71,4 +71,37 @@ let compile_expression =
   let docs = "Compile contracts parameters." in
   (term , Term.info ~docs "compile-parameter")
 
-let () = Term.exit @@ Term.eval_choice main [compile_file ; compile_expression]
+let compile_storage =
+  let f source entry_point expression =
+    toplevel @@
+    let%bind value =
+      trace (simple_error "compile-storage") @@
+      Ligo.Contract.compile_contract_storage source entry_point expression in
+    Format.printf "Storage:\n%s\n" value;
+    ok ()
+  in
+  let term =
+    let source =
+      let open Arg in
+      let docv = "SOURCE_FILE" in
+      let doc = "$(docv) is the path to the .ligo file of the contract." in
+      let info = info ~docv ~doc [] in
+      required @@ pos 0 (some string) None info in
+    let entry_point =
+      let open Arg in
+      let docv = "ENTRY_POINT" in
+      let doc = "$(docv) is the entry-point of the contract." in
+      let info = info ~docv ~doc [] in
+      required @@ pos 1 (some string) None info in
+    let expression =
+      let open Arg in
+      let docv = "EXPRESSION" in
+      let doc = "$(docv) is the expression that will be compiled." in
+      let info = info ~docv ~doc [] in
+      required @@ pos 2 (some string) None info in
+    Term.(const f $ source $ entry_point $ expression) in
+  let docs = "Compile contracts storage." in
+  (term , Term.info ~docs "compile-storage")
+
+
+let () = Term.exit @@ Term.eval_choice main [compile_file ; compile_parameter ; compile_storage]
diff --git a/src/ligo/main/contract.ml b/src/ligo/main/contract.ml
index c9c1b3814..ff3f8a98b 100644
--- a/src/ligo/main/contract.ml
+++ b/src/ligo/main/contract.ml
@@ -128,3 +128,51 @@ let compile_contract_parameter : string -> string -> string -> string result = f
     ok str
   in
   ok expr
+
+
+let compile_contract_storage : string -> string -> string -> string result = fun source entry_point expression ->
+  let%bind (program , storage_tv) =
+    let%bind raw =
+      trace (simple_error "parsing file") @@
+      Parser.parse_file source in
+    let%bind simplified =
+      trace (simple_error "simplifying file") @@
+      Simplify.Pascaligo.simpl_program raw in
+    let%bind () =
+      assert_entry_point_defined simplified entry_point in
+    let%bind typed =
+      trace (simple_error "typing file") @@
+      Typer.type_program simplified in
+    let%bind (_ , storage_ty) =
+      get_entry_point typed entry_point in
+    ok (typed , storage_ty)
+  in
+  let%bind expr =
+    let%bind raw =
+      trace (simple_error "parsing expression") @@
+      Parser.parse_expression expression in
+    let%bind simplified =
+      trace (simple_error "simplifying expression") @@
+      Simplify.Pascaligo.simpl_expression raw in
+    let%bind typed =
+      let env =
+        let last_declaration = Location.unwrap List.(hd @@ rev program) in
+        match last_declaration with
+        | Declaration_constant (_ , env) -> env
+      in
+      trace (simple_error "typing expression") @@
+      Typer.type_annotated_expression env simplified in
+    let%bind () =
+      trace (simple_error "expression type doesn't match type storage") @@
+      Ast_typed.assert_type_value_eq (storage_tv , typed.type_annotation) in
+    let%bind mini_c =
+      trace (simple_error "transpiling expression") @@
+      transpile_value typed in
+    let%bind michelson =
+      trace (simple_error "compiling expression") @@
+      Compiler.translate_value mini_c in
+    let str =
+      Format.asprintf "%a" Micheline.Michelson.pp_stripped michelson in
+    ok str
+  in
+  ok expr