solve conflict

.gitignore

@@ -1,6 +1,8 @@
 /_build/
 dune-project
 *~
+*.merlin
 cache/*
 Version.ml
 /_opam/
+/*.pp.ligo

.gitlab-ci.yml

@@ -74,17 +74,6 @@ local-dune-job:
     - scripts/build_ligo_local.sh
     - dune build @ligo-test
 
-# TODO: uncomment this
-
-# TODO
-# local-repo-job:
-#   <<: *before_script
-#   stage: test
-#   script:
-#     - scripts/install_vendors_deps.sh
-#     # TODO: also try from time to time with --build-test
-#     - opam install -y ligo
-
 remote-repo-job:
   <<: *before_script
   stage: test

src/bin/cli.ml

@@ -53,89 +53,100 @@ let amount =
     info ~docv ~doc ["amount"] in
   value @@ opt string "0" info
 
+let display_format =
+  let open Arg in
+  let info  =
+    let docv = "DISPLAY_FORMAT" in
+    let doc = "$(docv) is the format that will be used by the CLI. Available formats are 'dev', 'json', and 'human-readable' (default). When human-readable lacks details (we are still tweaking it), please contact us and use another format in the meanwhile." in
+    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 =
-    toplevel @@
+  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.Run.compile_contract_file source entry_point (Syntax_name syntax) in
-    Format.printf "%s\n" contract ;
-    ok ()
+      Ligo.Compile.Of_source.compile_file_contract_entry source entry_point (Syntax_name syntax) in
+    ok @@ Format.asprintf "%a\n" (Main.Display.michelson_pp michelson_format) contract
   in
   let term =
-    Term.(const f $ source 0 $ entry_point 1 $ syntax) 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)
 
 let compile_parameter =
-  let f source entry_point expression syntax =
-    toplevel @@
+  let f source entry_point expression syntax display_format =
+    toplevel ~display_format @@
     let%bind value =
       trace (simple_error "compile-input") @@
-      Ligo.Run.compile_contract_parameter source entry_point expression (Syntax_name syntax) in
-    Format.printf "%s\n" value;
-    ok ()
+      Ligo.Compile.Of_source.compile_file_contract_parameter source entry_point expression (Syntax_name syntax) in
+    ok @@ Format.asprintf "%a\n" Tezos_utils.Michelson.pp value
   in
   let term =
-    Term.(const f $ source 0 $ entry_point 1 $ expression "PARAMETER" 2 $ syntax) in
+    Term.(const f $ source 0 $ entry_point 1 $ expression "PARAMETER" 2 $ syntax $ display_format) in
   let cmdname = "compile-parameter" in
   let docs = "Subcommand: compile parameters to a michelson expression. The resulting michelson expression can be passed as an argument in a transaction which calls a contract. See `ligo " ^ cmdname ^ " --help' for a list of options specific to this subcommand." in
   (term , Term.info ~docs cmdname)
 
 let compile_storage =
-  let f source entry_point expression syntax bigmap =
-    toplevel @@
+  let f source entry_point expression syntax display_format bigmap =
+    toplevel ~display_format @@
     let%bind value =
       trace (simple_error "compile-storage") @@
-      Ligo.Run.compile_contract_storage ?bigmap:(Some bigmap) source entry_point expression (Syntax_name syntax) in
-    Format.printf "%s\n" value;
-    ok ()
+      Ligo.Compile.Of_source.compile_file_contract_storage ~bigmap source entry_point expression (Syntax_name syntax) in
+    ok @@ Format.asprintf "%a\n" Tezos_utils.Michelson.pp value
   in
   let term =
-    Term.(const f $ source 0 $ entry_point 1 $ expression "STORAGE" 2 $ syntax $ bigmap) in
+    Term.(const f $ source 0 $ entry_point 1 $ expression "STORAGE" 2 $ syntax $ display_format $ bigmap) in
   let cmdname = "compile-storage" in
   let docs = "Subcommand: compile an initial storage in ligo syntax to a michelson expression. The resulting michelson expression can be passed as an argument in a transaction which originates a contract. See `ligo " ^ cmdname ^ " --help' for a list of options specific to this subcommand." in
   (term , Term.info ~docs cmdname)
 
 let dry_run =
-  let f source entry_point storage input bigmap amount syntax =
-    toplevel @@
+  let f source entry_point storage input amount syntax display_format bigmap =
+    toplevel ~display_format @@
     let%bind output =
-      Ligo.Run.run_contract ~bigmap ~amount source entry_point storage input (Syntax_name syntax) in
-    Format.printf "%a\n" Ast_simplified.PP.expression output ;
-    ok ()
+      Ligo.Run.Of_source.run_contract ~amount ~bigmap source entry_point storage input (Syntax_name syntax) in
+    ok @@ Format.asprintf "%a\n" Ast_simplified.PP.expression output
   in
   let term =
-    Term.(const f $ source 0 $ entry_point 1 $ expression "PARAMETER" 2 $ expression "STORAGE" 3 $ bigmap $ amount $ syntax) in
+    Term.(const f $ source 0 $ entry_point 1 $ expression "PARAMETER" 2 $ expression "STORAGE" 3 $ amount $ syntax $ display_format $ bigmap) in
   let cmdname = "dry-run" in
   let docs = "Subcommand: run a smart-contract with the given storage and input." in
   (term , Term.info ~docs cmdname)
 
 let run_function =
-  let f source entry_point parameter amount syntax =
-    toplevel @@
+  let f source entry_point parameter amount syntax display_format =
+    toplevel ~display_format @@
     let%bind output =
-      Ligo.Run.run_function ~amount source entry_point parameter (Syntax_name syntax) in
-    Format.printf "%a\n" Ast_simplified.PP.expression output ;
-    ok ()
+      Ligo.Run.Of_source.run_function ~amount source entry_point parameter (Syntax_name syntax) in
+    ok @@ Format.asprintf "%a\n" Ast_simplified.PP.expression output
   in
   let term =
-    Term.(const f $ source 0 $ entry_point 1 $ expression "PARAMETER" 2 $ amount $ syntax) in
+    Term.(const f $ source 0 $ entry_point 1 $ expression "PARAMETER" 2 $ amount $ syntax $ display_format) in
   let cmdname = "run-function" in
   let docs = "Subcommand: run a function with the given parameter." in
   (term , Term.info ~docs cmdname)
 
 let evaluate_value =
-  let f source entry_point amount syntax =
-    toplevel @@
+  let f source entry_point amount syntax display_format =
+    toplevel ~display_format @@
     let%bind output =
-      Ligo.Run.evaluate_value ~amount source entry_point (Syntax_name syntax) in
-    Format.printf "%a\n" Ast_simplified.PP.expression output ;
-    ok ()
+      Ligo.Run.Of_source.evaluate ~amount source entry_point (Syntax_name syntax) in
+    ok @@ Format.asprintf "%a\n" Ast_simplified.PP.expression output
   in
   let term =
-    Term.(const f $ source 0 $ entry_point 1 $ amount $ syntax) in
+    Term.(const f $ source 0 $ entry_point 1 $ amount $ syntax $ display_format) in
   let cmdname = "evaluate-value" in
   let docs = "Subcommand: evaluate a given definition." in
   (term , Term.info ~docs cmdname)

src/bin/cli_helpers.ml

@@ -1,9 +1,12 @@
 open Trace
+open Main.Display
 
-let toplevel x =
-  match x with
-  | Trace.Ok ((), annotations) -> ignore annotations; ()
-  | Error ss -> (
-      Format.printf "%a%!" Ligo.Display.error_pp (ss ())
+let toplevel ~(display_format : string) (x : string result) =
+  let display_format =
+    try display_format_of_string display_format
+    with _ -> (
+        Format.printf "bad display format %s, try looking at DISPLAY_FORMAT in the man (--help)." display_format ;
+        failwith "Display format"
       )
-
+  in
+  Format.printf "%a" (formatted_string_result_pp display_format) x

src/contracts/annotation.ligo

@@ -1,5 +0,0 @@
-const lst : list(int) = list [] ;
-
-const address : address = "tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx" ;
-
-const address_2 : address = ("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx" : address) ;

src/dune

@@ -12,20 +12,3 @@
     (pps ppx_let)
   )
 )
-
-(alias
-  (name ligo-test)
-  (action (run test/test.exe))
-  (deps (glob_files contracts/*))
-)
-
-(alias
-  (name runtest)
-  (deps (alias ligo-test))
-)
-
-(alias
-  (name manual-test)
-  (action (run test/manual_test.exe))
-  (deps (glob_files contracts/*))  
-)

src/main/compile/dune

@@ -0,0 +1,22 @@
+(library
+  (name compile)
+  (public_name ligo.compile)
+  (libraries
+    simple-utils
+    tezos-utils
+    parser
+    simplify
+    ast_simplified
+    self_ast_simplified
+    typer
+    ast_typed
+    transpiler
+    mini_c
+    operators
+    compiler
+  )
+  (preprocess
+    (pps ppx_let)
+  )
+  (flags (:standard -w +1..62-4-9-44-40-42-48-30@39@33 -open Simple_utils -open Tezos_utils ))
+)

src/main/compile/helpers.ml

@@ -0,0 +1,76 @@
+open Trace
+
+type s_syntax = Syntax_name of string
+type v_syntax = Pascaligo | Cameligo
+
+let syntax_to_variant : s_syntax -> string option -> v_syntax result =
+  fun syntax source_filename ->
+  let subr s n =
+    String.sub s (String.length s - n) n in
+  let endswith s suffix =
+    let suffixlen = String.length suffix in
+    (  String.length s >= suffixlen
+       && String.equal (subr s suffixlen) suffix)
+  in
+  let (Syntax_name syntax) = syntax in
+  match (syntax , source_filename) with
+  | "auto" , Some sf when endswith sf ".ligo" -> ok Pascaligo
+  | "auto" , Some sf when endswith sf ".mligo" -> ok Cameligo
+  | "auto" , _ -> simple_fail "cannot auto-detect syntax, pleas use -s name_of_syntax"
+  | "pascaligo" , _ -> ok Pascaligo
+  | "cameligo" , _ -> ok Cameligo
+  | _ -> simple_fail "unrecognized parser"
+
+let parsify_pascaligo = fun source ->
+  let%bind raw =
+    trace (simple_error "parsing") @@
+    Parser.Pascaligo.parse_file source in
+  let%bind simplified =
+    trace (simple_error "simplifying") @@
+    Simplify.Pascaligo.simpl_program raw in
+  ok simplified
+
+let parsify_expression_pascaligo = fun source ->
+  let%bind raw =
+    trace (simple_error "parsing expression") @@
+    Parser.Pascaligo.parse_expression source in
+  let%bind simplified =
+    trace (simple_error "simplifying expression") @@
+    Simplify.Pascaligo.simpl_expression raw in
+  ok simplified
+
+let parsify_ligodity = fun source ->
+  let%bind raw =
+    trace (simple_error "parsing") @@
+    Parser.Ligodity.parse_file source in
+  let%bind simplified =
+    trace (simple_error "simplifying") @@
+    Simplify.Ligodity.simpl_program raw in
+  ok simplified
+
+let parsify_expression_ligodity = fun source ->
+  let%bind raw =
+    trace (simple_error "parsing expression") @@
+    Parser.Ligodity.parse_expression source in
+  let%bind simplified =
+    trace (simple_error "simplifying expression") @@
+    Simplify.Ligodity.simpl_expression raw in
+  ok simplified
+
+let parsify = fun (syntax : v_syntax) source_filename ->
+  let%bind parsify = match syntax with
+    | Pascaligo -> ok parsify_pascaligo
+    | Cameligo -> ok parsify_ligodity
+  in
+  let%bind parsified = parsify source_filename in
+  let%bind applied = Self_ast_simplified.convert_annotation_program parsified in
+  ok applied
+
+let parsify_expression = fun syntax source ->
+  let%bind parsify = match syntax with
+    | Pascaligo -> ok parsify_expression_pascaligo
+    | Cameligo -> ok parsify_expression_ligodity
+  in
+  let%bind parsified = parsify source in
+  let%bind applied = Self_ast_simplified.convert_annotation_expression parsified in
+  ok applied

src/main/compile/of_mini_c.ml

@@ -0,0 +1,52 @@
+open Trace
+open Mini_c
+open Tezos_utils
+
+let compile_value : value -> type_value -> Michelson.t result =
+  Compiler.Program.translate_value
+
+let compile_expression : expression -> _ result = fun e ->
+  Compiler.Program.translate_expression e Compiler.Environment.empty
+
+let compile_expression_as_function : expression -> _ result = fun e ->
+  let (input , output) = t_unit , e.type_value in
+  let%bind body = get_function e in
+  let%bind body = compile_value body (t_function input output) 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 = 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 (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
+
+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

@@ -0,0 +1,36 @@
+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
+
+let compile_expression_as_function_entry (program : program) entry_point : _ result =
+  let%bind typed_program = Typer.type_program program in
+  Of_typed.compile_expression_as_function_entry typed_program entry_point
+
+let compile_expression ?(env = Ast_typed.Environment.full_empty) ae : Michelson.t result =
+  let%bind typed = Typer.type_expression env ae in
+  Of_typed.compile_expression typed
+
+let uncompile_typed_program_entry_expression_result program entry ex_ty_value =
+  let%bind output_type =
+    let%bind entry_expression = Ast_typed.get_entry program entry in
+    ok entry_expression.type_annotation
+  in
+  let%bind typed = Of_typed.uncompile_value ex_ty_value output_type in
+  Typer.untype_expression typed
+
+let uncompile_typed_program_entry_function_result program entry ex_ty_value =
+  let%bind output_type =
+    let%bind entry_expression = Ast_typed.get_entry program entry in
+    let%bind (_ , output_type) = Ast_typed.get_t_function entry_expression.type_annotation in
+    ok output_type
+  in
+  let%bind typed = Of_typed.uncompile_value ex_ty_value output_type in
+  Typer.untype_expression typed

src/main/compile/of_source.ml

@@ -0,0 +1,60 @@
+open Trace
+open Helpers
+open Tezos_utils
+
+let parse_file_program source_filename syntax =
+  let%bind syntax = syntax_to_variant syntax (Some source_filename) in
+  let%bind simplified = parsify syntax source_filename in
+  ok simplified
+
+let compile_file_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 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
+  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 ->
+  let%bind syntax = syntax_to_variant syntax (Some source_filename) in
+  let%bind simplified = parsify_expression syntax expression in
+  Of_simplified.compile_expression simplified
+
+let compile_file_expression : string -> string -> string -> s_syntax -> Michelson.t result =
+  fun source_filename _entry_point expression syntax ->
+  let%bind syntax = syntax_to_variant syntax (Some source_filename) in
+  let%bind simplified = parsify_expression syntax expression in
+  Of_simplified.compile_expression simplified
+
+let compile_file_contract_storage : string -> string -> string -> s_syntax -> Michelson.t result =
+  fun source_filename _entry_point expression syntax ->
+  let%bind syntax = syntax_to_variant syntax (Some source_filename) in
+  let%bind simplified = parsify_expression syntax expression in
+  Of_simplified.compile_expression simplified
+
+let compile_file_contract_args =
+  fun source_filename _entry_point storage parameter syntax ->
+  let%bind syntax = syntax_to_variant syntax (Some source_filename) in
+  let%bind storage_simplified = parsify_expression syntax storage in
+  let%bind parameter_simplified = parsify_expression syntax parameter in
+  let args = Ast_simplified.e_pair storage_simplified parameter_simplified in
+  Of_simplified.compile_expression args
+
+let type_file ?(debug_simplify = false) ?(debug_typed = false)
+    syntax (source_filename:string) : Ast_typed.program result =
+  let%bind syntax = syntax_to_variant syntax (Some source_filename) in
+  let%bind simpl = parsify syntax source_filename in
+  (if debug_simplify then
+     Format.(printf "Simplified : %a\n%!" Ast_simplified.PP.program simpl)
+  ) ;
+  let%bind typed =
+    trace (simple_error "typing") @@
+    Typer.type_program simpl in
+  (if debug_typed then (
+      Format.(printf "Typed : %a\n%!" Ast_typed.PP.program typed)
+    )) ;
+  ok typed

src/main/compile/of_typed.ml

@@ -0,0 +1,57 @@
+open Trace
+open Ast_typed
+open Tezos_utils
+
+
+let compile_expression : annotated_expression -> Michelson.t result = fun e ->
+  let%bind mini_c_expression = Transpiler.transpile_annotated_expression e in
+  let%bind expr = Of_mini_c.compile_expression mini_c_expression in
+  ok expr
+
+let compile_expression_as_function : annotated_expression -> _ result = fun e ->
+  let%bind mini_c_expression = Transpiler.transpile_annotated_expression e in
+  let%bind expr = Of_mini_c.compile_expression_as_function mini_c_expression in
+  ok expr
+
+let compile_function : annotated_expression -> _ result = fun e ->
+  let%bind mini_c_expression = Transpiler.transpile_annotated_expression e in
+  let%bind expr = Of_mini_c.compile_function mini_c_expression in
+  ok expr
+
+(*
+   val compile_value : annotated_expression -> Michelson.t result
+   This requires writing a function
+   `transpile_expression_as_value : annotated_expression -> Mini_c.value result`
+ *)
+
+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
+
+let uncompile_value : _ -> _ -> annotated_expression result = fun x ty ->
+  let%bind mini_c = Of_mini_c.uncompile_value x in
+  let%bind typed = Transpiler.untranspile mini_c ty in
+  ok typed
+
+let uncompile_entry_function_result = fun program entry ex_ty_value ->
+  let%bind output_type =
+    let%bind entry_expression = get_entry program entry in
+    let%bind (_ , output_type) = get_t_function entry_expression.type_annotation in
+    ok output_type
+  in
+  uncompile_value ex_ty_value output_type
+
+let uncompile_entry_expression_result = fun program entry ex_ty_value ->
+  let%bind output_type =
+    let%bind entry_expression = get_entry program entry in
+    ok entry_expression.type_annotation
+  in
+  uncompile_value ex_ty_value output_type

src/main/display.ml

@@ -1,8 +1,6 @@
-open Trace
+open! Trace
 
-let dev = false
-
-let rec error_pp out (e : error) =
+let rec error_pp ?(dev = false) out (e : error) =
   let open JSON_string_utils in
   let message =
     let opt = e |> member "message" |> string in
@@ -50,7 +48,67 @@ let rec error_pp out (e : error) =
     print "%s%s%s%s%s" location title error_code message data
   ) else (
     print "%s%s%s.\n%s%s\n%a\n%a\n" title error_code message data location
-      (Format.pp_print_list error_pp) infos
-      (Format.pp_print_list error_pp) children
+      (Format.pp_print_list (error_pp ~dev)) infos
+      (Format.pp_print_list (error_pp ~dev)) children
   )
 
+let result_pp_hr f out (r : _ result) =
+  match r with
+  | Ok (s , _) -> Format.fprintf out "%a" f s
+  | Error e -> Format.fprintf out "%a" (error_pp ~dev:false) (e ())
+
+let string_result_pp_hr = result_pp_hr (fun out s -> Format.fprintf out "%s" s)
+
+let result_pp_dev f out (r : _ result) =
+  match r with
+  | Ok (s , _) -> Format.fprintf out "%a" f s
+  | Error e -> Format.fprintf out "%a" (error_pp ~dev:false) (e ())
+
+let string_result_pp_dev = result_pp_hr (fun out s -> Format.fprintf out "%s" s)
+
+let string_result_pp_json out (r : string result) =
+  let status_json status content : J.t = `Assoc ([
+      ("status" , `String status) ;
+      ("content" , content) ;
+    ]) in
+  match r with
+  | Ok (x , _) -> (
+      Format.fprintf out "%a" J.pp (status_json "ok" (`String x))
+    )
+  | Error e -> (
+      Format.fprintf out "%a" J.pp (status_json "error" (e ()))
+    )
+
+type display_format = [
+  | `Human_readable
+  | `Json
+  | `Dev
+]
+
+let display_format_of_string = fun s : display_format ->
+  match s with
+  | "dev" -> `Dev
+  | "json" -> `Json
+  | "human-readable" -> `Human_readable
+  | _ -> failwith "bad display_format"
+
+let formatted_string_result_pp (display_format : display_format) =
+  match display_format with
+  | `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/main/dune

@@ -2,17 +2,8 @@
   (name main)
   (public_name ligo.main)
   (libraries
-    simple-utils
-    tezos-utils
-    parser
-    simplify
-    ast_simplified
-    typer
-    ast_typed
-    transpiler
-    mini_c
-    operators
-    compiler
+    run
+    compile
   )
   (preprocess
     (pps ppx_let)

src/main/main.ml

@@ -1,137 +1,3 @@
-module Run_mini_c = Run_mini_c
-
-(* open Trace *)
-module Parser = Parser
-module AST_Raw = Parser.Pascaligo.AST
-module AST_Simplified = Ast_simplified
-module AST_Typed = Ast_typed
-module Mini_c = Mini_c
-module Typer = Typer
-module Transpiler = Transpiler
-
-module Run = struct
-  include Run_source
-  include Run_simplified
-  include Run_typed
-  include Run_mini_c
-end
-
+module Run = Run
+module Compile = Compile
 module Display = Display
-
-(* module Parser_multifix = Multifix
- * module Simplify_multifix = Simplify_multifix *)
-
-
-(* let simplify (p:AST_Raw.t) : Ast_simplified.program result = Simplify.Pascaligo.simpl_program p
- * let simplify_expr (e:AST_Raw.expr) : Ast_simplified.expression result = Simplify.Pascaligo.simpl_expression e
- * let unparse_simplified_expr (e:AST_Simplified.expression) : string result =
- *   ok @@ Format.asprintf "%a" AST_Simplified.PP.expression e
- * 
- * let type_ (p:AST_Simplified.program) : AST_Typed.program result = Typer.type_program p
- * let type_expression ?(env:Typer.Environment.t = Typer.Environment.full_empty)
- *     (e:AST_Simplified.expression) : AST_Typed.annotated_expression result =
- *   Typer.type_expression env e
- * let untype_expression (e:AST_Typed.annotated_expression) : AST_Simplified.expression result = Typer.untype_expression e
- * 
- * let transpile (p:AST_Typed.program) : Mini_c.program result = Transpiler.translate_program p
- * let transpile_entry (p:AST_Typed.program) (name:string) : Mini_c.anon_function result = Transpiler.translate_entry p name
- * let transpile_expression (e:AST_Typed.annotated_expression) : Mini_c.expression result = Transpiler.translate_annotated_expression e
- * 
- * let untranspile_value (v : Mini_c.value) (e:AST_Typed.type_value) : AST_Typed.annotated_expression result =
- *   Transpiler.untranspile v e
- * 
- * let compile : Mini_c.program -> string -> Compiler.Program.compiled_program result = Compiler.Program.translate_program
- * 
- * let easy_evaluate_typed (entry:string) (program:AST_Typed.program) : AST_Typed.annotated_expression result =
- *   let%bind result =
- *     let%bind mini_c_main =
- *       transpile_entry program entry in
- *     Run_mini_c.run_entry mini_c_main (Mini_c.Combinators.d_unit) in
- *   let%bind typed_result =
- *     let%bind typed_main = Ast_typed.get_entry program entry in
- *     untranspile_value result typed_main.type_annotation in
- *   ok typed_result
- * 
- * 
- * let easy_evaluate_typed = trace_f_2_ez easy_evaluate_typed (thunk "easy evaluate typed")
- * 
- * 
- * let easy_run_typed
- *     ?(debug_mini_c = false) ?options (entry:string)
- *     (program:AST_Typed.program) (input:AST_Typed.annotated_expression) : AST_Typed.annotated_expression result =
- *   let%bind () =
- *     let open Ast_typed in
- *     let%bind (Declaration_constant (d , _)) = get_declaration_by_name program entry in
- *     let%bind (arg_ty , _) =
- *       trace_strong (simple_error "entry-point doesn't have a function type") @@
- *       get_t_function @@ get_type_annotation d.annotated_expression in
- *     Ast_typed.assert_type_value_eq (arg_ty , (Ast_typed.get_type_annotation input))
- *   in
- * 
- *   let%bind mini_c_main =
- *     trace (simple_error "transpile mini_c entry") @@
- *     transpile_entry program entry in
- *   (if debug_mini_c then
- *      Format.(printf "Mini_c : %a\n%!" Mini_c.PP.function_ mini_c_main)
- *   ) ;
- * 
- *   let%bind mini_c_value = transpile_value input in
- * 
- *   let%bind mini_c_result =
- *     let error =
- *       let title () = "run Mini_c" in
- *       let content () =
- *         Format.asprintf "\n%a" Mini_c.PP.function_ mini_c_main
- *       in
- *       error title content in
- *     trace error @@
- *     Run_mini_c.run_entry ?options mini_c_main mini_c_value in
- *   let%bind typed_result =
- *     let%bind main_result_type =
- *       let%bind typed_main = Ast_typed.get_functional_entry program entry in
- *       match (snd typed_main).type_value' with
- *       | T_function (_, result) -> ok result
- *       | _ -> simple_fail "main doesn't have fun type" in
- *     untranspile_value mini_c_result main_result_type in
- *   ok typed_result
- * 
- * let easy_run_typed_simplified
- *     ?(debug_mini_c = false) ?(debug_michelson = false) ?options (entry:string)
- *     (program:AST_Typed.program) (input:Ast_simplified.expression) : Ast_simplified.expression result =
- *   let%bind mini_c_main =
- *     trace (simple_error "transpile mini_c entry") @@
- *     transpile_entry program entry in
- *   (if debug_mini_c then
- *      Format.(printf "Mini_c : %a\n%!" Mini_c.PP.function_ mini_c_main)
- *   ) ;
- * 
- *   let%bind typed_value =
- *     let env =
- *       let last_declaration = Location.unwrap List.(hd @@ rev program) in
- *       match last_declaration with
- *       | Declaration_constant (_ , (_ , post_env)) -> post_env
- *     in
- *     type_expression ~env input in
- *   let%bind mini_c_value = transpile_value typed_value in
- * 
- *   let%bind mini_c_result =
- *     let error =
- *       let title () = "run Mini_c" in
- *       let content () =
- *         Format.asprintf "\n%a" Mini_c.PP.function_ mini_c_main
- *       in
- *       error title content in
- *     trace error @@
- *     Run_mini_c.run_entry ~debug_michelson ?options mini_c_main mini_c_value in
- *   let%bind typed_result =
- *     let%bind main_result_type =
- *       let%bind typed_main = Ast_typed.get_functional_entry program entry in
- *       match (snd typed_main).type_value' with
- *       | T_function (_, result) -> ok result
- *       | _ -> simple_fail "main doesn't have fun type" in
- *     untranspile_value mini_c_result main_result_type in
- *   let%bind annotated_result = untype_expression typed_result in
- *   ok annotated_result *)
-
-
-(* module Contract = Contract *)

src/main/run/dune

@@ -0,0 +1,22 @@
+(library
+  (name run)
+  (public_name ligo.run)
+  (libraries
+    simple-utils
+    tezos-utils
+    parser
+    simplify
+    ast_simplified
+    typer
+    ast_typed
+    transpiler
+    mini_c
+    operators
+    compiler
+    compile
+  )
+  (preprocess
+    (pps ppx_let)
+  )
+  (flags (:standard -w +1..62-4-9-44-40-42-48-30@39@33 -open Simple_utils -open Tezos_utils ))
+)

src/main/run/of_michelson.ml

@@ -0,0 +1,50 @@
+open Proto_alpha_utils
+open Trace
+open Compiler.Program
+open Memory_proto_alpha.Protocol.Script_ir_translator
+open Memory_proto_alpha.X
+
+type options = Memory_proto_alpha.options
+
+let run ?options ?(is_input_value = false) (program:compiled_program) (input_michelson:Michelson.t) : ex_typed_value result =
+  let Compiler.Program.{input;output;body} : compiled_program = program in
+  let (Ex_ty input_ty) = input in
+  let (Ex_ty output_ty) = output in
+  let%bind input_ty_mich =
+    Trace.trace_tzresult_lwt (simple_error "error unparsing input ty") @@
+    Memory_proto_alpha.unparse_michelson_ty input_ty in
+  let%bind output_ty_mich =
+    Trace.trace_tzresult_lwt (simple_error "error unparsing output ty") @@
+    Memory_proto_alpha.unparse_michelson_ty output_ty in
+  Format.printf "code: %a\n" Michelson.pp program.body ;
+  Format.printf "input_ty: %a\n" Michelson.pp input_ty_mich ;
+  Format.printf "output_ty: %a\n" Michelson.pp output_ty_mich ;
+  Format.printf "input: %a\n" Michelson.pp input_michelson ;
+  let%bind input =
+    if is_input_value then (
+      Trace.trace_tzresult_lwt (simple_error "error parsing input") @@
+      Memory_proto_alpha.parse_michelson_data input_michelson input_ty
+    ) else (
+      let input_michelson = Michelson.(seq [ input_michelson ; dip i_drop ]) in
+      let body = Michelson.(strip_nops @@ strip_annots input_michelson) in
+      let%bind descr =
+        Trace.trace_tzresult_lwt (simple_error "error parsing input code") @@
+        Memory_proto_alpha.parse_michelson body
+          (Item_t (Memory_proto_alpha.Protocol.Script_typed_ir.Unit_t None, Empty_t, None)) (Item_t (input_ty, Empty_t, None)) in
+      let%bind (Item(output, Empty)) =
+        Trace.trace_tzresult_lwt (simple_error "input error of execution") @@
+        Memory_proto_alpha.interpret ?options descr (Item((), Empty)) in
+      ok output
+    ) in
+  let body = Michelson.(strip_nops @@ strip_annots body) in
+  let%bind descr =
+    Trace.trace_tzresult_lwt (simple_error "error parsing program code") @@
+    Memory_proto_alpha.parse_michelson body
+      (Item_t (input_ty, Empty_t, None)) (Item_t (output_ty, Empty_t, None)) in
+  let open! Memory_proto_alpha.Protocol.Script_interpreter in
+  let%bind (Item(output, Empty)) =
+    Trace.trace_tzresult_lwt (simple_error "error of execution") @@
+    Memory_proto_alpha.interpret ?options descr (Item(input, Empty)) in
+  ok (Ex_typed_value (output_ty, output))
+
+let evaluate ?options program = run ?options ~is_input_value:true program Michelson.d_unit

src/main/run/of_mini_c.ml

@@ -0,0 +1,53 @@
+open Proto_alpha_utils
+open Memory_proto_alpha.X
+open Trace
+open Mini_c
+open! Compiler.Program
+
+module Errors = struct
+
+  let entry_error =
+    simple_error "error translating entry point"
+
+end
+
+type options = {
+  entry_point : anon_function ;
+  input_type : type_value ;
+  output_type : type_value ;
+  input : value ;
+  michelson_options : Of_michelson.options ;
+}
+
+let evaluate ?options expression =
+  let%bind code = Compile.Of_mini_c.compile_expression_as_function expression in
+  let%bind ex_ty_value = Of_michelson.evaluate ?options code in
+  Compile.Of_mini_c.uncompile_value ex_ty_value
+
+let evaluate_entry ?options program entry =
+  let%bind code = Compile.Of_mini_c.compile_expression_as_function_entry program entry in
+  let%bind ex_ty_value = Of_michelson.evaluate ?options code in
+  Compile.Of_mini_c.uncompile_value ex_ty_value
+
+let run_function ?options expression input ty =
+  let%bind code = Compile.Of_mini_c.compile_function expression in
+  let%bind input = Compile.Of_mini_c.compile_value input ty in
+  let%bind ex_ty_value = Of_michelson.run ?options code input in
+  Compile.Of_mini_c.uncompile_value ex_ty_value
+
+let run_function_value ?options expression input ty =
+  let%bind code = Compile.Of_mini_c.compile_function expression in
+  let%bind input = Compile.Of_mini_c.compile_value input ty in
+  let%bind ex_ty_value = Of_michelson.run ~is_input_value:true ?options code input in
+  Compile.Of_mini_c.uncompile_value ex_ty_value
+
+let run_function_entry ?options program entry input =
+  let%bind code = Compile.Of_mini_c.compile_function_entry program entry in
+  let%bind input_michelson =
+    let%bind code = Compile.Of_mini_c.compile_expression_as_function input in
+    let%bind (Ex_typed_value (ty , value)) = Of_michelson.evaluate ?options code in
+    Trace.trace_tzresult_lwt (simple_error "error unparsing input") @@
+    Memory_proto_alpha.unparse_michelson_data ty value
+  in
+  let%bind ex_ty_value = Of_michelson.run ?options code input_michelson in
+  Compile.Of_mini_c.uncompile_value ex_ty_value

src/main/run/of_simplified.ml

@@ -0,0 +1,27 @@
+open Trace
+open Ast_simplified
+
+let get_final_environment program =
+  let last_declaration = Location.unwrap List.(hd @@ rev program) in
+  let (Ast_typed.Declaration_constant (_ , (_ , post_env))) = last_declaration in
+  post_env
+
+let run_typed_program
+    ?options
+    (program : Ast_typed.program) (entry : string)
+    (input : expression) : expression result =
+  let%bind code = Compile.Of_typed.compile_function_entry program entry in
+  let%bind input =
+    let env = get_final_environment program in
+    Compile.Of_simplified.compile_expression ~env input
+  in
+  let%bind ex_ty_value = Of_michelson.run ?options code input in
+  Compile.Of_simplified.uncompile_typed_program_entry_function_result program entry ex_ty_value
+
+let evaluate_typed_program_entry
+    ?options
+    (program : Ast_typed.program) (entry : string)
+  : Ast_simplified.expression result =
+  let%bind code = Compile.Of_typed.compile_expression_as_function_entry program entry in
+  let%bind ex_ty_value = Of_michelson.evaluate ?options code in
+  Compile.Of_simplified.uncompile_typed_program_entry_expression_result program entry ex_ty_value

src/main/run/of_source.ml

@@ -0,0 +1,92 @@
+open Trace
+
+include struct
+  open Ast_simplified
+
+  let assert_entry_point_defined : program -> string -> unit result =
+    fun program entry_point ->
+      let aux : declaration -> bool = fun declaration ->
+        match declaration with
+        | Declaration_type _ -> false
+        | Declaration_constant (name , _ , _) -> name = entry_point
+      in
+      trace_strong (simple_error "no entry-point with given name") @@
+      Assert.assert_true @@ List.exists aux @@ List.map Location.unwrap program
+end
+
+include struct
+  open Ast_typed
+  open Combinators
+
+  let get_entry_point_type : type_value -> (type_value * type_value) result = fun t ->
+    let%bind (arg , result) =
+      trace_strong (simple_error "entry-point doesn't have a function type") @@
+      get_t_function t in
+    let%bind (arg' , storage_param) =
+      trace_strong (simple_error "entry-point doesn't have 2 parameters") @@
+      get_t_pair arg in
+    let%bind (ops , storage_result) =
+      trace_strong (simple_error "entry-point doesn't have 2 results") @@
+      get_t_pair result in
+    let%bind () =
+      trace_strong (simple_error "entry-point doesn't have a list of operation as first result") @@
+      assert_t_list_operation ops in
+    let%bind () =
+      trace_strong (simple_error "entry-point doesn't identical type (storage) for second parameter and second result") @@
+      assert_type_value_eq (storage_param , storage_result) in
+    ok (arg' , storage_param)
+
+  let get_entry_point : program -> string -> (type_value * type_value) result = fun p e ->
+    let%bind declaration = get_declaration_by_name p e in
+    match declaration with
+    | Declaration_constant (d , _) -> get_entry_point_type d.annotated_expression.type_annotation
+
+  let assert_valid_entry_point = fun p e ->
+    let%bind _ = get_entry_point p e in
+    ok ()
+end
+
+let run_contract ?amount source_filename entry_point storage parameter syntax =
+  let%bind program = Compile.Of_source.type_file syntax source_filename in
+  let%bind code = Compile.Of_typed.compile_function_entry program entry_point in
+  let%bind args = Compile.Of_source.compile_file_contract_args source_filename entry_point storage parameter syntax in
+  let%bind ex_value_ty =
+    let options =
+      let open Proto_alpha_utils.Memory_proto_alpha in
+      let amount = Option.bind (fun amount -> Protocol.Alpha_context.Tez.of_string amount) amount in
+      (make_options ?amount ())
+    in
+    Of_michelson.run ~options code args
+  in
+  Compile.Of_simplified.uncompile_typed_program_entry_function_result program entry_point ex_value_ty
+
+let run_function ?amount source_filename entry_point input syntax =
+  let%bind program = Compile.Of_source.type_file syntax source_filename in
+  let%bind code = Compile.Of_typed.compile_function_entry program entry_point in
+  let%bind args = Compile.Of_source.compile_file_expression source_filename entry_point input syntax in
+  let%bind ex_value_ty =
+    let options =
+      let open Proto_alpha_utils.Memory_proto_alpha in
+      let amount = Option.bind (fun amount -> Protocol.Alpha_context.Tez.of_string amount) amount in
+      (make_options ?amount ())
+    in
+    Of_michelson.run ~options code args
+  in
+  Compile.Of_simplified.uncompile_typed_program_entry_function_result program entry_point ex_value_ty
+
+let evaluate ?amount source_filename entry_point syntax =
+  let%bind program = Compile.Of_source.type_file syntax source_filename in
+  let%bind code = Compile.Of_typed.compile_expression_as_function_entry program entry_point in
+  let%bind input =
+    let fake_input = Ast_simplified.e_unit () in
+    Compile.Of_simplified.compile_expression fake_input
+  in
+  let%bind ex_value_ty =
+    let options =
+      let open Proto_alpha_utils.Memory_proto_alpha in
+      let amount = Option.bind (fun amount -> Protocol.Alpha_context.Tez.of_string amount) amount in
+      (make_options ?amount ())
+    in
+    Of_michelson.run ~options code input
+  in
+  Compile.Of_simplified.uncompile_typed_program_entry_expression_result program entry_point ex_value_ty

src/main/run/of_typed.ml

@@ -0,0 +1,30 @@
+open Trace
+open Ast_typed
+
+let run_function ?options f input =
+  let%bind code = Compile.Of_typed.compile_function f in
+  let%bind input = Compile.Of_typed.compile_expression input in
+  let%bind ex_ty_value = Of_michelson.run ?options code input in
+  let%bind ty =
+    let%bind (_ , output_ty) = get_t_function f.type_annotation in
+    ok output_ty
+  in
+  Compile.Of_typed.uncompile_value ex_ty_value ty
+
+let run_entry
+    ?options (entry : string)
+    (program : Ast_typed.program) (input : Ast_typed.annotated_expression) : Ast_typed.annotated_expression result =
+  let%bind code = Compile.Of_typed.compile_function_entry program entry in
+  let%bind input = Compile.Of_typed.compile_expression input in
+  let%bind ex_ty_value = Of_michelson.run ?options code input in
+  Compile.Of_typed.uncompile_entry_function_result program entry ex_ty_value
+
+let evaluate ?options (e : annotated_expression) : annotated_expression result =
+  let%bind code = Compile.Of_typed.compile_expression_as_function e in
+  let%bind ex_ty_value = Of_michelson.evaluate ?options code in
+  Compile.Of_typed.uncompile_value ex_ty_value e.type_annotation
+
+let evaluate_entry ?options program entry =
+  let%bind code = Compile.Of_typed.compile_expression_as_function_entry program entry in
+  let%bind ex_ty_value = Of_michelson.evaluate ?options code in
+  Compile.Of_typed.uncompile_entry_expression_result program entry ex_ty_value

src/main/run/run.ml

@@ -0,0 +1,5 @@
+module Of_source = Of_source
+module Of_typed = Of_typed
+module Of_simplified = Of_simplified
+module Of_mini_c = Of_mini_c
+module Of_michelson = Of_michelson

src/main/run_mini_c.ml

@@ -1,55 +0,0 @@
-open Proto_alpha_utils
-open Trace
-open Mini_c
-open! Compiler.Program
-open Memory_proto_alpha.Protocol.Script_ir_translator
-open Memory_proto_alpha.X
-
-let run_aux ?options (program:compiled_program) (input_michelson:Michelson.t) : ex_typed_value result =
-  let Compiler.Program.{input;output;body} : compiled_program = program in
-  let (Ex_ty input_ty) = input in
-  let (Ex_ty output_ty) = output in
-  let%bind input =
-    Trace.trace_tzresult_lwt (simple_error "error parsing input") @@
-    Memory_proto_alpha.parse_michelson_data input_michelson input_ty in
-  let body = Michelson.strip_annots body in
-  let%bind descr =
-    Trace.trace_tzresult_lwt (simple_error "error parsing program code") @@
-    Memory_proto_alpha.parse_michelson body
-      (Item_t (input_ty, Empty_t, None)) (Item_t (output_ty, Empty_t, None)) in
-  let open! Memory_proto_alpha.Protocol.Script_interpreter in
-  let%bind (Item(output, Empty)) =
-    Trace.trace_tzresult_lwt (simple_error "error of execution") @@
-    Memory_proto_alpha.interpret ?options descr (Item(input, Empty)) in
-  ok (Ex_typed_value (output_ty, output))
-
-let run_entry ?(debug_michelson = false) ?options ?bm_opt (entry:anon_function) ty (input:value) : value result =
-  let%bind compiled =
-    let error =
-      let title () = "compile entry" in
-      let content () =
-        Format.asprintf "%a" PP.function_ entry
-      in
-      error title content in
-    trace error @@
-    translate_entry entry ty in
-  let%bind input_michelson = translate_value input (fst ty) in
-  if debug_michelson then (
-    Format.printf "Program: %a\n" Michelson.pp compiled.body ;
-    Format.printf "Expression: %a\n" PP.expression entry.result ;
-    Format.printf "Input: %a\n" PP.value input ;
-    Format.printf "Input Type: %a\n" PP.type_ (fst ty) ;
-    Format.printf "Compiled Input: %a\n" Michelson.pp input_michelson ;
-  ) ;
-  let%bind ex_ty_value = run_aux ?options compiled input_michelson in
-  if debug_michelson then (
-    let (Ex_typed_value (ty , v)) = ex_ty_value in
-    ignore @@
-    let%bind michelson_value =
-      trace_tzresult_lwt (simple_error "debugging run_mini_c") @@
-      Proto_alpha_utils.Memory_proto_alpha.unparse_michelson_data ty v in
-    Format.printf "Compiled Output: %a\n" Michelson.pp michelson_value ;
-    ok ()
-  ) ;
-  let%bind (result : value) = Compiler.Uncompiler.translate_value ?bm_opt ex_ty_value in
-  ok result

src/main/run_simplified.ml

@@ -1,27 +0,0 @@
-open Trace
-
-let run_simplityped
-    ?input_to_value ?options
-    ?(debug_mini_c = false) ?(debug_michelson = false)
-    (program : Ast_typed.program) (entry : string)
-    (input : Ast_simplified.expression) : Ast_simplified.expression result =
-  let%bind typed_input =
-    let env =
-      let last_declaration = Location.unwrap List.(hd @@ rev program) in
-      match last_declaration with
-      | Declaration_constant (_ , (_ , post_env)) -> post_env
-    in
-    Typer.type_expression env input in
-  let%bind typed_result =
-    Run_typed.run_typed ?input_to_value ?options ~debug_mini_c ~debug_michelson entry program typed_input in
-  let%bind annotated_result = Typer.untype_expression typed_result in
-  ok annotated_result
-
-let evaluate_simplityped
-    ?options
-    ?(debug_mini_c = false) ?(debug_michelson = false)
-    (program : Ast_typed.program) (entry : string)
-  : Ast_simplified.expression result =
-  let%bind typed_result = Run_typed.evaluate_typed ?options ~debug_mini_c ~debug_michelson entry program in
-  let%bind annotated_result = Typer.untype_expression typed_result in
-  ok annotated_result

src/main/run_source.ml

@@ -1,311 +0,0 @@
-open Trace
-
-include struct
-  open Ast_simplified
-
-  let assert_entry_point_defined : program -> string -> unit result =
-    fun program entry_point ->
-      let aux : declaration -> bool = fun declaration ->
-        match declaration with
-        | Declaration_type _ -> false
-        | Declaration_constant (name , _ , _) -> name = entry_point
-      in
-      trace_strong (simple_error "no entry-point with given name") @@
-      Assert.assert_true @@ List.exists aux @@ List.map Location.unwrap program
-end
-
-include struct
-  open Ast_typed
-  open Combinators
-
-  let get_entry_point_type : type_value -> (type_value * type_value) result = fun t ->
-    let%bind (arg , result) =
-      trace_strong (simple_error "entry-point doesn't have a function type") @@
-      get_t_function t in
-    let%bind (arg' , storage_param) =
-      trace_strong (simple_error "entry-point doesn't have 2 parameters") @@
-      get_t_pair arg in
-    let%bind (ops , storage_result) =
-      trace_strong (simple_error "entry-point doesn't have 2 results") @@
-      get_t_pair result in
-    let%bind () =
-      trace_strong (simple_error "entry-point doesn't have a list of operation as first result") @@
-      assert_t_list_operation ops in
-    let%bind () =
-      trace_strong (simple_error "entry-point doesn't identitcal type (storage) for second parameter and second result") @@
-      assert_type_value_eq (storage_param , storage_result) in
-    ok (arg' , storage_param)
-
-  let get_entry_point : program -> string -> (type_value * type_value) result = fun p e ->
-    let%bind declaration = get_declaration_by_name p e in
-    match declaration with
-    | Declaration_constant (d , _) -> get_entry_point_type d.annotated_expression.type_annotation
-
-  let assert_valid_entry_point = fun p e ->
-    let%bind _ = get_entry_point p e in
-    ok ()
-end
-
-let transpile_value_literals 
-    (e:Ast_typed.annotated_expression) : (Mini_c.value * _) result =
-  let%bind (_ , ty) =
-    let open Transpiler in
-    let (f , _) = functionalize e in
-    let%bind main = translate_main f e.location in
-    ok main
-  in
-  let%bind lit = Run_typed.convert_to_literals e in
-  ok (lit , snd ty)
-
-let transpile_value
-    (e:Ast_typed.annotated_expression) : (Mini_c.value * _) result =
-  let%bind (f , ty) =
-    let open Transpiler in
-    let (f , _) = functionalize e in
-    let%bind main = translate_main f e.location in
-    ok main
-  in
-
-  let input = Mini_c.Combinators.d_unit in
-  let%bind r = Run_mini_c.run_entry f ty input in
-  ok (r , snd ty)
-
-let parsify_pascaligo = fun source ->
-  let%bind raw =
-    trace (simple_error "parsing") @@
-    Parser.Pascaligo.parse_file source in
-  let%bind simplified =
-    trace (simple_error "simplifying") @@
-    Simplify.Pascaligo.simpl_program raw in
-  ok simplified
-
-let parsify_expression_pascaligo = fun source ->
-  let%bind raw =
-    trace (simple_error "parsing expression") @@
-    Parser.Pascaligo.parse_expression source in
-  let%bind simplified =
-    trace (simple_error "simplifying expression") @@
-    Simplify.Pascaligo.simpl_expression raw in
-  ok simplified
-
-let parsify_ligodity = fun source ->
-  let%bind raw =
-    trace (simple_error "parsing") @@
-    Parser.Ligodity.parse_file source in
-  let%bind simplified =
-    trace (simple_error "simplifying") @@
-    Simplify.Ligodity.simpl_program raw in
-  ok simplified
-
-let parsify_expression_ligodity = fun source ->
-  let%bind raw =
-    trace (simple_error "parsing expression") @@
-    Parser.Ligodity.parse_expression source in
-  let%bind simplified =
-    trace (simple_error "simplifying expression") @@
-    Simplify.Ligodity.simpl_expression raw in
-  ok simplified
-
-type s_syntax = Syntax_name of string
-type v_syntax =  [`pascaligo | `cameligo ]
-
-let syntax_to_variant : s_syntax -> string option -> v_syntax result =
-  fun syntax source_filename ->
-  let subr s n =
-    String.sub s (String.length s - n) n in
-  let endswith s suffix =
-    let suffixlen = String.length suffix in
-    (  String.length s >= suffixlen
-       && String.equal (subr s suffixlen) suffix)
-  in
-  match syntax with
-    Syntax_name syntax ->
-    begin
-      if String.equal syntax "auto" then
-        begin
-          match source_filename with
-          | Some source_filename
-            when endswith source_filename ".ligo"
-            -> ok `pascaligo
-          | Some source_filename
-            when endswith source_filename ".mligo"
-            -> ok `cameligo
-          | _ -> simple_fail "cannot auto-detect syntax, pleas use -s name_of_syntax"
-        end
-      else if String.equal syntax "pascaligo" then ok `pascaligo
-      else if String.equal syntax "cameligo" then ok `cameligo
-      else simple_fail "unrecognized parser"
-    end
-
-let parsify = fun (syntax : v_syntax) source_filename ->
-  let%bind parsify = match syntax with
-    | `pascaligo -> ok parsify_pascaligo
-    | `cameligo -> ok parsify_ligodity
-  in
-  parsify source_filename
-
-let parsify_expression = fun syntax source ->
-  let%bind parsify = match syntax with
-    | `pascaligo -> ok parsify_expression_pascaligo
-    | `cameligo -> ok parsify_expression_ligodity
-  in
-  parsify source
-
-let compile_contract_file : string -> string -> s_syntax -> string result = fun source_filename entry_point syntax ->
-  let%bind syntax = syntax_to_variant syntax (Some source_filename) in
-  let%bind simplified = parsify syntax source_filename in
-  let%bind () =
-    assert_entry_point_defined simplified entry_point in
-  let%bind typed =
-    trace (simple_error "typing") @@
-    Typer.type_program simplified in
-  let%bind (mini_c , mini_c_ty) =
-    trace (simple_error "transpiling") @@
-    Transpiler.translate_entry typed entry_point in
-  let%bind michelson =
-    trace (simple_error "compiling") @@
-    Compiler.translate_contract mini_c mini_c_ty in
-  let str =
-    Format.asprintf "%a" Michelson.pp_stripped michelson in
-  ok str
-
-let compile_contract_parameter : string -> string -> string -> s_syntax -> string result = fun source_filename entry_point expression syntax ->
-  let%bind syntax = syntax_to_variant syntax (Some source_filename) in
-  let%bind (program , parameter_tv) =
-    let%bind simplified = parsify syntax source_filename 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 (param_ty , _) =
-      get_entry_point typed entry_point in
-    ok (typed , param_ty)
-  in
-  let%bind expr =
-    let%bind typed =
-      let%bind simplified = parsify_expression syntax expression in
-      let env =
-        let last_declaration = Location.unwrap List.(hd @@ rev program) in
-        match last_declaration with
-        | Declaration_constant (_ , (_ , post_env)) -> post_env
-      in
-      trace (simple_error "typing expression") @@
-      Typer.type_expression env simplified in
-    let%bind () =
-      trace (simple_error "expression type doesn't match type parameter") @@
-      Ast_typed.assert_type_value_eq (parameter_tv , typed.type_annotation) in
-    let%bind (mini_c , mini_c_ty) =
-      trace (simple_error "transpiling expression") @@
-      transpile_value typed in
-    let%bind michelson =
-      trace (simple_error "compiling expression") @@
-      Compiler.translate_value mini_c mini_c_ty in
-    let str =
-      Format.asprintf "%a" Michelson.pp_stripped michelson in
-    ok str
-  in
-  ok expr
-
-(* Replace occurrences of E_map with E_big_map in the AST  *)
-let rec transform_map_to_big_map (e: Ast_simplified.expression) : Ast_simplified.expression result = 
-  let open Ast_simplified in
-  match e.wrap_content with
-  | E_tuple [fst;snd] ->
-    let%bind tr_fst = transform_map_to_big_map fst in
-    let new_tuple = Location.wrap (E_tuple [tr_fst;snd]) in
-    ok @@ new_tuple
-  | E_map lst ->
-    let tr_map = Location.wrap (E_big_map lst) in
-    ok @@ tr_map
-  | _ -> fail @@ simple_error "can not replace map with big_map"
-
-let compile_contract_storage ?(bigmap = false) source_filename entry_point expression syntax : string result =
-  let%bind syntax = syntax_to_variant syntax (Some source_filename) in
-  let%bind (program , storage_tv) =
-    let%bind simplified = parsify syntax source_filename 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 simplified = parsify_expression syntax expression in
-    let%bind simplified = if bigmap then transform_map_to_big_map simplified else ok @@ simplified in
-    let%bind typed =
-      let env =
-        let last_declaration = Location.unwrap List.(hd @@ rev program) in
-        match last_declaration with
-        | Declaration_constant (_ , (_ , post_env)) -> post_env
-      in
-      trace (simple_error "typing expression") @@
-      Typer.type_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 , mini_c_ty) =
-      trace (simple_error "transpiling expression") @@
-      (if bigmap then transpile_value_literals typed else transpile_value typed) in
-    let%bind michelson =
-      trace (simple_error "compiling expression") @@
-      Compiler.translate_value mini_c mini_c_ty in
-    let str =
-      Format.asprintf "%a" Michelson.pp_stripped michelson in
-    ok str
-  in
-  ok expr
-
-let type_file ?(debug_simplify = false) ?(debug_typed = false)
-    syntax (source_filename:string) : Ast_typed.program result =
-  let%bind simpl = parsify syntax source_filename in
-  (if debug_simplify then
-     Format.(printf "Simplified : %a\n%!" Ast_simplified.PP.program simpl)
-  ) ;
-  let%bind typed =
-    trace (simple_error "typing") @@
-    Typer.type_program simpl in
-  (if debug_typed then (
-      Format.(printf "Typed : %a\n%!" Ast_typed.PP.program typed)
-    )) ;
-  ok typed
-
-let run_contract ?(bigmap = false) ?amount source_filename entry_point storage input syntax =
-  let%bind syntax = syntax_to_variant syntax (Some source_filename) in
-  let%bind typed =
-    type_file syntax source_filename in
-  let%bind storage_simpl =
-    parsify_expression syntax storage in
-  let%bind input_simpl =
-    parsify_expression syntax input in
-  let%bind input_simpl = if bigmap then transform_map_to_big_map input_simpl else ok @@ input_simpl in
-  let options =
-    let open Proto_alpha_utils.Memory_proto_alpha in
-    let amount = Option.bind (fun amount -> Protocol.Alpha_context.Tez.of_string amount) amount in
-    (make_options ?amount ()) in
-  Run_simplified.run_simplityped ?input_to_value:(Some bigmap) ~options typed entry_point (Ast_simplified.e_pair storage_simpl input_simpl)
-
-let run_function ?amount source_filename entry_point parameter syntax =
-  let%bind syntax = syntax_to_variant syntax (Some source_filename) in
-  let%bind typed =
-    type_file syntax source_filename in
-  let%bind parameter' =
-    parsify_expression syntax parameter in
-  let options =
-    let open Proto_alpha_utils.Memory_proto_alpha in
-    let amount = Option.bind (fun amount -> Protocol.Alpha_context.Tez.of_string amount) amount in
-    (make_options ?amount ()) in
-  Run_simplified.run_simplityped ~options typed entry_point parameter'
-
-let evaluate_value ?amount source_filename entry_point syntax =
-  let%bind syntax = syntax_to_variant syntax (Some source_filename) in
-  let%bind typed =
-    type_file syntax source_filename in
-  let options =
-    let open Proto_alpha_utils.Memory_proto_alpha in
-    let amount = Option.bind (fun amount -> Protocol.Alpha_context.Tez.of_string amount) amount in
-    (make_options ?amount ()) in
-  Run_simplified.evaluate_simplityped ~options typed entry_point

src/main/run_typed.ml

@@ -1,150 +0,0 @@
-open Trace
-
-let transpile_value
-    (e:Ast_typed.annotated_expression) : Mini_c.value result =
-  let%bind (f , ty) =
-    let open Transpiler in
-    let (f , _) = functionalize e in
-    let%bind main = translate_main f e.location in
-    ok main
-  in
-
-  let input = Mini_c.Combinators.d_unit in
-  let%bind r = Run_mini_c.run_entry f ty input in
-  ok r
-
-let evaluate_typed
-    ?(debug_mini_c = false) ?(debug_michelson = false)
-    ?options (entry:string) (program:Ast_typed.program) : Ast_typed.annotated_expression result =
-  trace (simple_error "easy evaluate typed") @@
-  let%bind result =
-    let%bind (mini_c_main , ty) =
-      Transpiler.translate_entry program entry in
-    (if debug_mini_c then
-       Format.(printf "Mini_c : %a\n%!" Mini_c.PP.function_ mini_c_main)
-    ) ;
-    Run_mini_c.run_entry ?options ~debug_michelson mini_c_main ty (Mini_c.Combinators.d_unit)
-  in
-  let%bind typed_result =
-    let%bind typed_main = Ast_typed.get_entry program entry in
-    Transpiler.untranspile result typed_main.type_annotation in
-  ok typed_result
-
-(* returns a big_map if any. used to reconstruct the map from the diff when uncompiling *)
-let rec fetch_big_map (v: Mini_c.value) : Mini_c.value option =
-  match v with
-  | D_pair (l , r) ->
-    begin
-    match (fetch_big_map l) with
-    | Some _ as s -> s
-    | None -> fetch_big_map r 
-    end
-  | D_big_map _ as bm -> Some bm 
-  | _ -> None
-
-(* try to convert expression to a literal *)
-let rec exp_to_value (exp: Mini_c.expression) : Mini_c.value result =
-  let open! Mini_c in
-  match exp.content with
-    | E_literal v -> ok @@ v
-    | E_constant ("map" , lst) ->
-      let aux el =
-        let%bind l = exp_to_value el in
-        match l with
-          | D_pair (a , b) -> ok @@ (a , b)
-          | _ -> fail @@ simple_error "??" in
-      let%bind lstl = bind_map_list aux lst in
-      ok @@ D_map lstl
-    | E_constant ("big_map" , lst) ->
-      let aux el =
-        let%bind l = exp_to_value el in
-        match l with
-          | D_pair (a , b) -> ok @@ (a , b)
-          | _ -> fail @@ simple_error "??" in
-      let%bind lstl = bind_map_list aux lst in
-      ok @@ D_big_map lstl
-    | E_constant ("PAIR" , fst::snd::[]) ->
-      let%bind fstl = exp_to_value fst in
-      let%bind sndl = exp_to_value snd in
-      ok @@ D_pair (fstl , sndl)
-    | E_constant ("UNIT", _) -> ok @@ D_unit
-    | E_constant ("UPDATE", _) ->
-      let rec handle_prev upd =
-        match upd.content with
-        | E_constant ("UPDATE" , [k;v;prev]) ->
-          begin
-            match v.content with
-              | E_constant ("SOME" , [i]) ->
-                let%bind kl = exp_to_value k in
-                let%bind il  = exp_to_value i in
-                let%bind prevl = handle_prev prev in
-                ok @@ (kl,il)::prevl
-              | E_constant ("NONE" , []) ->
-                let%bind prevl = handle_prev prev in
-                ok @@ prevl
-              | _ -> failwith "UPDATE second parameter is not an option"
-          end
-        | E_make_empty_map _ ->
-          ok @@ []
-        | _ -> failwith "Ill-constructed map"
-      in
-      begin
-      match exp.type_value with
-        | T_big_map _ ->
-          let%bind kvl = handle_prev exp in
-          ok @@ D_big_map kvl
-        | T_map _ ->
-          let%bind kvl = handle_prev exp in
-          ok @@ D_map kvl
-        | _ -> failwith "UPDATE with a non-map type_value"
-      end
-    | _ as nl -> 
-      let expp = Format.asprintf "'%a'" Mini_c.PP.expression' nl in
-      fail @@ simple_error ("Can not convert expression "^expp^" to literal")
-
-let convert_to_literals (e:Ast_typed.annotated_expression) : Mini_c.value result =
-  let open Transpiler in
-  let%bind exp = translate_annotated_expression e in (*Mini_c.expression*)
-  let%bind value = exp_to_value exp in
-  ok @@ value
-
-let run_typed
-    ?(input_to_value = false) ?(debug_mini_c = false) ?(debug_michelson = false) ?options (entry:string)
-    (program:Ast_typed.program) (input:Ast_typed.annotated_expression) : Ast_typed.annotated_expression result =
-  let%bind () =
-    let open Ast_typed in
-    let%bind (Declaration_constant (d , _)) = get_declaration_by_name program entry in
-    let%bind (arg_ty , _) =
-      trace_strong (simple_error "entry-point doesn't have a function type") @@
-      get_t_function @@ get_type_annotation d.annotated_expression in
-    Ast_typed.assert_type_value_eq (arg_ty , (Ast_typed.get_type_annotation input))
-  in
-
-  let%bind (mini_c_main , ty) =
-    trace (simple_error "transpile mini_c entry") @@
-    Transpiler.translate_entry program entry in
-  (if debug_mini_c then
-     Format.(printf "Mini_c : %a\n%!" Mini_c.PP.function_ mini_c_main)
-  ) ;
-
-  let%bind mini_c_value = if input_to_value then 
-    convert_to_literals input else transpile_value input in
-  let bm_opt = if input_to_value then fetch_big_map mini_c_value else None in
-
-  let%bind mini_c_result =
-    let error =
-      let title () = "run Mini_c" in
-      let content () =
-        Format.asprintf "\n%a" Mini_c.PP.function_ mini_c_main
-      in
-      error title content in
-    trace error @@
-    Run_mini_c.run_entry ~debug_michelson ?options ?bm_opt mini_c_main ty mini_c_value in
-  let%bind typed_result =
-    let%bind main_result_type =
-      let%bind typed_main = Ast_typed.get_functional_entry program entry in
-      match (snd typed_main).type_value' with
-      | T_function (_, result) -> ok result
-      | _ -> simple_fail "main doesn't have fun type" in
-    Transpiler.untranspile mini_c_result main_result_type in
-  ok typed_result