add micheline

src/bin/cli.ml

@@ -53,16 +53,25 @@ let display_format =
     info ~docv ~doc ["format" ; "display-format"] in
   value @@ opt string "human-readable" info
 
+let michelson_code_format =
+  let open Arg in
+  let info  =
+    let docv = "MICHELSON_FORMAT" in
+    let doc = "$(docv) is the format that will be used by compile-contract for the resulting Michelson. Available formats are 'micheline', and 'michelson' (default). Micheline is the format used by [XXX]." in
+    info ~docv ~doc ["michelson-format"] in
+  value @@ opt string "michelson" info
+
 let compile_file =
-  let f source entry_point syntax display_format =
+  let f source entry_point syntax display_format michelson_format =
     toplevel ~display_format @@
+    let%bind michelson_format = Main.Display.michelson_format_of_string michelson_format in
     let%bind contract =
       trace (simple_info "compiling contract to michelson") @@
       Ligo.Compile.Of_source.compile_file_contract_entry source entry_point (Syntax_name syntax) in
-    ok @@ Format.asprintf "%a\n" Tezos_utils.Michelson.pp contract.body
+    ok @@ Format.asprintf "%a\n" (Main.Display.michelson_pp michelson_format) contract
   in
   let term =
-    Term.(const f $ source 0 $ entry_point 1 $ syntax $ display_format) in
+    Term.(const f $ source 0 $ entry_point 1 $ syntax $ display_format $ michelson_code_format) in
   let cmdname = "compile-contract" in
   let docs = "Subcommand: compile a contract. See `ligo " ^ cmdname ^ " --help' for a list of options specific to this subcommand." in
   (term , Term.info ~docs cmdname)

src/main/compile/of_mini_c.ml

@@ -35,5 +35,18 @@ let compile_function_entry = fun program name ->
   let%bind aggregated = aggregate_entry program name false in
   compile_function aggregated
 
+let compile_contract_entry = fun program name ->
+  let%bind aggregated = aggregate_entry program name false in
+  let%bind compiled = compile_function aggregated in
+  let%bind (param_ty , storage_ty) =
+    let%bind fun_ty = get_t_function aggregated.type_value in
+    Mini_c.get_t_pair (fst fun_ty)
+  in
+  let%bind param_michelson = Compiler.Type.type_ param_ty in
+  let%bind storage_michelson = Compiler.Type.type_ storage_ty in
+  let contract = Michelson.contract param_michelson storage_michelson compiled.body in
+  ok contract
+
+
 let uncompile_value : Proto_alpha_utils.Memory_proto_alpha.X.ex_typed_value -> value result = fun x ->
   Compiler.Uncompiler.translate_value x

src/main/compile/of_simplified.ml

@@ -2,6 +2,10 @@ open Ast_simplified
 open Trace
 open Tezos_utils
 
+let compile_contract_entry (program : program) entry_point =
+  let%bind prog_typed = Typer.type_program program in
+  Of_typed.compile_contract_entry prog_typed entry_point
+
 let compile_function_entry (program : program) entry_point : _ result =
   let%bind prog_typed = Typer.type_program program in
   Of_typed.compile_function_entry prog_typed entry_point

src/main/compile/of_source.ml

@@ -15,7 +15,8 @@ let compile_file_entry : string -> string -> s_syntax -> _ result =
 let compile_file_contract_entry : string -> string -> s_syntax -> _ result =
   fun source_filename entry_point syntax ->
   let%bind simplified = parse_file_program source_filename syntax in
-  Of_simplified.compile_function_entry simplified entry_point
+  let%bind compiled_contract = Of_simplified.compile_contract_entry simplified entry_point in
+  ok compiled_contract
 
 let compile_file_contract_parameter : string -> string -> string -> s_syntax -> Michelson.t result =
   fun source_filename _entry_point expression syntax ->

src/main/compile/of_typed.ml

@@ -28,6 +28,10 @@ let compile_function_entry : program -> string -> _ = fun p entry ->
   let%bind prog_mini_c = Transpiler.transpile_program p in
   Of_mini_c.compile_function_entry prog_mini_c entry
 
+let compile_contract_entry : program -> string -> _ = fun p entry ->
+  let%bind prog_mini_c = Transpiler.transpile_program p in
+  Of_mini_c.compile_contract_entry prog_mini_c entry
+
 let compile_expression_as_function_entry : program -> string -> _ = fun p entry ->
   let%bind prog_mini_c = Transpiler.transpile_program p in
   Of_mini_c.compile_expression_as_function_entry prog_mini_c entry

src/main/display.ml

@@ -97,3 +97,18 @@ let formatted_string_result_pp (display_format : display_format) =
   | `Human_readable -> string_result_pp_hr
   | `Dev -> string_result_pp_dev
   | `Json -> string_result_pp_json
+
+type michelson_format = [
+  | `Michelson
+  | `Micheline
+]
+
+let michelson_format_of_string = fun s : michelson_format result ->
+  match s with
+  | "michelson" -> ok `Michelson
+  | "micheline" -> ok `Micheline
+  | _ -> simple_fail "bad michelson format"
+
+let michelson_pp (mf : michelson_format) = match mf with
+  | `Michelson -> Michelson.pp
+  | `Micheline -> Michelson.pp_json

src/test/test_helpers.ml

@@ -12,14 +12,14 @@ let wrap_test name f =
   match result with
   | Ok ((), annotations) -> ignore annotations; ()
   | Error err ->
-    Format.printf "%a\n%!" Ligo.Display.error_pp (err ()) ;
+    Format.printf "%a\n%!" (Ligo.Display.error_pp ~dev:true) (err ()) ;
     raise Alcotest.Test_error
 
 let wrap_test_raw f =
   match f () with
   | Trace.Ok ((), annotations) -> ignore annotations; ()
   | Error err ->
-    Format.printf "%a\n%!" Ligo.Display.error_pp (err ())
+    Format.printf "%a\n%!" (Ligo.Display.error_pp ~dev:true) (err ())
 
 let test name f =
   Test (

super-counter.pp.ligo

@@ -0,0 +1,65 @@
+# 1 "./src/test/contracts/super-counter.ligo"
+# 1 "<built-in>"
+# 1 "<command-line>"
+# 31 "<command-line>"
+# 1 "/usr/include/stdc-predef.h" 1 3 4
+
+# 17 "/usr/include/stdc-predef.h" 3 4
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+# 32 "<command-line>" 2
+# 1 "./src/test/contracts/super-counter.ligo"
+type action is
+| Increment of int
+| Decrement of int
+
+function main (const p : action ; const s : int) : (list(operation) * int) is
+  block {skip} with ((nil : list(operation)),
+    case p of
+    | Increment (n) -> s + n
+    | Decrement (n) -> s - n
+    end)

vendors/ligo-utils/tezos-utils/x_michelson.ml

@@ -86,6 +86,18 @@ let pp ppf (michelson:michelson) =
   let node = printable string_of_prim canonical in
   print_expr ppf node
 
+let pp_json ppf (michelson : michelson) =
+  let open Micheline_printer in
+  let canonical = strip_locations michelson in
+  let node = printable string_of_prim canonical in
+  let json = Tezos_data_encoding.(
+      Json.construct
+        (Micheline.erased_encoding ~variant:"???" {comment = None} Data_encoding.string)
+        node
+    )
+  in
+  Format.fprintf ppf "%a" Tezos_data_encoding.Json.pp json
+
 let pp_stripped ppf (michelson:michelson) =
   let open Micheline_printer in
   let michelson' = strip_nops @@ strip_annots michelson in