Merge branch 'dev' into site-redesign-init

.gitignore

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

.gitlab-ci.yml

@@ -50,9 +50,6 @@ stages:
   services:
     - docker:dind
 
-.docker_build: &docker_build
-  script:
-    - docker build -t $LIGO_REGISTRY_IMAGE:next -f ./docker/Dockerfile .
 
 .before_script: &before_script
   before_script:
@@ -74,17 +71,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
@@ -107,7 +93,9 @@ remote-repo-job:
 build-current-docker-image:
   stage: build_docker
   <<: *docker
-  <<: *docker_build
+  script:
+    - docker build -t $LIGO_REGISTRY_IMAGE:next -f ./docker/Dockerfile .
+    - sh scripts/test_cli.sh
   except:
     - master
     - dev
@@ -117,8 +105,9 @@ build-current-docker-image:
 build-and-publish-latest-docker-image:
   stage: build_and_deploy_docker
   <<: *docker
-  <<: *docker_build
+  script:
-  after_script:
+    - docker build -t $LIGO_REGISTRY_IMAGE:next -f ./docker/Dockerfile .
+    - sh scripts/test_cli.sh
     - docker login -u $LIGO_REGISTRY_USER -p $LIGO_REGISTRY_PASSWORD
     - docker push $LIGO_REGISTRY_IMAGE:next
   only:

gitlab-pages/website/pages/en/versions.js

@@ -18,9 +18,7 @@ const versions = require(`${CWD}/versions.json`);
 function Versions(props) {
   const {config: siteConfig} = props;
   const latestVersion = versions[0];
-  const repoUrl = `https://github.com/${siteConfig.organizationName}/${
+  const repoUrl = `${siteConfig.repoUrl}`;
-    siteConfig.projectName
-  }`;
   return (
     <div className="docMainWrapper wrapper">
       <Container className="mainContainer versionsContainer">

scripts/ligo_ci.sh

@@ -0,0 +1 @@
+docker run -i -v "$PWD":"$PWD" -w "$PWD" ligolang/ligo:next "$@"

scripts/test_cli.sh

@@ -0,0 +1,29 @@
+#!/bin/sh
+set -e
+compiled_contract=$(./scripts/ligo_ci.sh compile-contract src/test/contracts/website2.ligo main);
+compiled_storage=$(./scripts/ligo_ci.sh compile-storage src/test/contracts/website2.ligo main 1);
+compiled_parameter=$(./scripts/ligo_ci.sh compile-parameter src/test/contracts/website2.ligo main "Increment(1)");
+dry_run_output=$(./scripts/ligo_ci.sh dry-run src/test/contracts/website2.ligo main "Increment(1)" 1);
+
+expected_compiled_parameter="(Right 1)";
+expected_compiled_storage=1;
+expected_dry_run_output="tuple[   list[]
+         2
+]";
+
+if [ "$compiled_storage" != "$expected_compiled_storage" ]; then
+    echo "Expected $expected_compiled_storage as compile-storage output, got $compiled_storage instead";
+    exit 1;
+fi
+
+if [ "$compiled_parameter" != "$expected_compiled_parameter" ]; then
+    echo "Expected $expected_compiled_parameter as compile-parameter output, got $compiled_parameter instead";
+    exit 1;
+fi
+
+if [ "$dry_run_output" != "$expected_dry_run_output" ]; then
+    echo "Expected $expected_dry_run_output as dry-run output, got $dry_run_output instead";
+    exit 1;
+fi
+
+echo "CLI tests passed";

src/bin/cli.ml

@@ -37,6 +37,14 @@ let syntax =
     info ~docv ~doc ["syntax" ; "s"] in
   value @@ opt string "auto" info
 
+let bigmap =
+  let open Arg in
+  let info =
+    let docv = "BIGMAP" in
+    let doc = "$(docv) is necessary when your storage embeds a big_map." in
+    info ~docv ~doc ["bigmap"] in
+  value @@ flag info
+
 let amount =
   let open Arg in
   let info =
@@ -45,98 +53,124 @@ 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 =
+  let f source entry_point syntax display_format michelson_format =
-    toplevel @@
+    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
+      Ligo.Compile.Of_source.compile_file_contract_entry source entry_point (Syntax_name syntax) in
-    Format.printf "%s\n" contract ;
+    ok @@ Format.asprintf "%a\n" (Main.Display.michelson_pp michelson_format) contract
-    ok ()
   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 =
+  let f source entry_point expression syntax display_format =
-    toplevel @@
+    toplevel ~display_format @@
     let%bind value =
       trace (simple_error "compile-input") @@
-      Ligo.Run.compile_contract_parameter source entry_point expression (Syntax_name syntax) in
+      Ligo.Run.Of_source.compile_file_contract_parameter source entry_point expression (Syntax_name syntax) in
-    Format.printf "%s\n" value;
+    ok @@ Format.asprintf "%a\n" Tezos_utils.Michelson.pp value
-    ok ()
   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 =
+  let f source entry_point expression syntax display_format bigmap =
-    toplevel @@
+    toplevel ~display_format @@
     let%bind value =
       trace (simple_error "compile-storage") @@
-      Ligo.Run.compile_contract_storage source entry_point expression (Syntax_name syntax) in
+      Ligo.Run.Of_source.compile_file_contract_storage ~value:bigmap source entry_point expression (Syntax_name syntax) in
-    Format.printf "%s\n" value;
+    ok @@ Format.asprintf "%a\n" Tezos_utils.Michelson.pp value
-    ok ()
   in
   let term =
-    Term.(const f $ source 0 $ entry_point 1 $ expression "STORAGE" 2 $ syntax) 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 amount syntax =
+  let f source entry_point storage input amount syntax display_format bigmap =
-    toplevel @@
+    toplevel ~display_format @@
     let%bind output =
-      Ligo.Run.run_contract ~amount source entry_point storage input (Syntax_name syntax) in
+      Ligo.Run.Of_source.run_contract ~amount ~storage_value:bigmap source entry_point storage input (Syntax_name syntax) in
-    Format.printf "%a\n" Ast_simplified.PP.expression output ;
+    ok @@ Format.asprintf "%a\n" Ast_simplified.PP.expression output
-    ok ()
   in
   let term =
-    Term.(const f $ source 0 $ entry_point 1 $ expression "PARAMETER" 2 $ expression "STORAGE" 3 $ 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 =
+  let f source entry_point parameter amount syntax display_format =
-    toplevel @@
+    toplevel ~display_format @@
     let%bind output =
-      Ligo.Run.run_function ~amount source entry_point parameter (Syntax_name syntax) in
+      Ligo.Run.Of_source.run_function_entry ~amount source entry_point parameter (Syntax_name syntax) in
-    Format.printf "%a\n" Ast_simplified.PP.expression output ;
+    ok @@ Format.asprintf "%a\n" Ast_simplified.PP.expression output
-    ok ()
   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 =
+  let f source entry_point amount syntax display_format =
-    toplevel @@
+    toplevel ~display_format @@
     let%bind output =
-      Ligo.Run.evaluate_value ~amount source entry_point (Syntax_name syntax) in
+      Ligo.Run.Of_source.evaluate_entry ~amount source entry_point (Syntax_name syntax) in
-    Format.printf "%a\n" Ast_simplified.PP.expression output ;
+    ok @@ Format.asprintf "%a\n" Ast_simplified.PP.expression output
-    ok ()
   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)
 
+let compile_expression =
+  let f expression syntax display_format =
+    toplevel ~display_format @@
+    let%bind value =
+      trace (simple_error "compile-input") @@
+      Ligo.Run.Of_source.compile_expression expression (Syntax_name syntax) in
+    ok @@ Format.asprintf "%a\n" Tezos_utils.Michelson.pp value
+  in
+  let term =
+    Term.(const f $ expression "" 0 $ syntax $ display_format) in
+  let cmdname = "compile-expression" in
+  let docs = "Subcommand: compile to a michelson value." in
+  (term , Term.info ~docs cmdname)
+
 
 let () = Term.exit @@ Term.eval_choice main [
     compile_file ;
     compile_parameter ;
     compile_storage ;
+    compile_expression ;
     dry_run ;
     run_function ;
     evaluate_value ;

src/bin/cli_helpers.ml

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

src/contracts/annotation.ligo

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

src/contracts/closure-3.ligo

@@ -1,6 +0,0 @@
-function foobar(const i : int) : int is
-  const j : int = 3 ;
-  const k : int = 4 ;
-  function toto(const l : int) : int is
-    block { skip } with i + j + k + l;
-  block { skip } with toto(42)

src/contracts/error_type.ligo

@@ -1 +0,0 @@
-const foo : nat = 42 + "bar"

src/contracts/included.ligo

@@ -1 +0,0 @@
-const foo : int = 144

src/contracts/includer.ligo

@@ -1,3 +0,0 @@
-#include "included.ligo"
-
-const bar : int = foo

src/contracts/list.mligo

@@ -1,10 +0,0 @@
-type storage = int * int list
-
-type param = int list
-
-let%entry main (p : param) storage =
-  let storage =
-    match p with
-      [] -> storage
-    | hd::tl -> storage.(0) + hd, tl
-  in (([] : operation list), storage)

src/contracts/set_arithmetic-1.ligo

@@ -1,9 +0,0 @@
-function iter_op (const s : set(int)) : int is
-  var r : int := 0 ;
-  function aggregate (const i : int) : unit is
-  begin
-    r := r + i ;
-  end with unit
-  begin
-    set_iter(s , aggregate) ;
-  end with r

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
+    compiler
+    self_michelson
+  )
+  (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.all_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.all_expression parsified in
+  ok applied

src/main/compile/of_mini_c.ml

@@ -0,0 +1,56 @@
+open Trace
+open Mini_c
+open Tezos_utils
+
+let compile_value : value -> type_value -> Michelson.t result = fun x a ->
+  let%bind body = Compiler.Program.translate_value x a in
+  let body = Self_michelson.optimize body in
+  ok body
+
+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 result = Self_michelson.optimize 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 body = Self_michelson.optimize 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
+  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 body = Self_michelson.optimize 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_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,40 @@
+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_as_value ?(env = Ast_typed.Environment.full_empty) ae : Michelson.t result =
+  let%bind typed = Typer.type_expression env ae in
+  Of_typed.compile_expression_as_value typed
+
+let compile_expression_as_function ?(env = Ast_typed.Environment.full_empty) ae : _ result =
+  let%bind typed = Typer.type_expression env ae in
+  Of_typed.compile_expression_as_function 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,39 @@
+open Trace
+open Helpers
+
+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_expression_as_function : string -> s_syntax -> _ result =
+  fun expression syntax ->
+  let%bind syntax = syntax_to_variant syntax None in
+  let%bind simplified = parsify_expression syntax expression in
+  Of_simplified.compile_expression_as_function simplified
+
+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_as_value : 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_as_value 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 ?(dev = false) out (e : error) =
-
-let rec error_pp out (e : error) =
   let open JSON_string_utils in
   let message =
     let opt = e |> member "message" |> string in
@@ -50,7 +48,69 @@ 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 ~dev)) infos
-      (Format.pp_print_list error_pp) children
+      (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 json_pp out x = Format.fprintf out "%s" (J.to_string x)
+
+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" json_pp (status_json "ok" (`String x))
+    )
+  | Error e -> (
+      Format.fprintf out "%a" json_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
+    run
-    tezos-utils
+    compile
-    parser
-    simplify
-    ast_simplified
-    typer
-    ast_typed
-    transpiler
-    mini_c
-    operators
-    compiler
   )
   (preprocess
     (pps ppx_let)

src/main/main.ml

@@ -1,137 +1,3 @@
-module Run_mini_c = Run_mini_c
+module Run = Run
-
+module Compile = Compile
-(* 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 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,47 @@
+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 =
+    Trace.trace_tzresult_lwt (simple_error "error parsing input") @@
+    Memory_proto_alpha.parse_michelson_data input_michelson input_ty
+  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 program Michelson.d_unit
+
+let ex_value_ty_to_michelson (v : ex_typed_value) : Michelson.t result =
+  let (Ex_typed_value (value , ty)) = v in
+  Trace.trace_tzresult_lwt (simple_error "error unparsing michelson result") @@
+  Memory_proto_alpha.unparse_michelson_data value ty
+
+let evaluate_michelson ?options program =
+  let%bind etv = evaluate ?options program in
+  ex_value_ty_to_michelson etv

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 ?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,32 @@
+open Trace
+open Ast_simplified
+
+let compile_expression ?(value = false) ?env expr =
+  if value
+  then (
+    Compile.Of_simplified.compile_expression_as_value ?env expr
+  )
+  else (
+    let%bind code = Compile.Of_simplified.compile_expression_as_function ?env expr in
+    Of_michelson.evaluate_michelson code
+  )
+
+let run_typed_program
+    ?options ?input_to_value
+    (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 = Ast_typed.program_environment program in
+    compile_expression ?value:input_to_value ~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,137 @@
+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
+
+(* open Tezos_utils *)
+
+let compile_file_contract_parameter : string -> string -> string -> Compile.Helpers.s_syntax -> Michelson.t result =
+  fun source_filename _entry_point expression syntax ->
+  let%bind program = Compile.Of_source.type_file syntax source_filename in
+  let env = Ast_typed.program_environment program in
+  let%bind syntax = Compile.Helpers.syntax_to_variant syntax (Some source_filename) in
+  let%bind simplified = Compile.Helpers.parsify_expression syntax expression in
+  Of_simplified.compile_expression simplified ~env
+
+let compile_file_expression : string -> string -> string -> Compile.Helpers.s_syntax -> Michelson.t result =
+  fun source_filename _entry_point expression syntax ->
+  let%bind program = Compile.Of_source.type_file syntax source_filename in
+  let env = Ast_typed.program_environment program in
+  let%bind syntax = Compile.Helpers.syntax_to_variant syntax (Some source_filename) in
+  let%bind simplified = Compile.Helpers.parsify_expression syntax expression in
+  Of_simplified.compile_expression simplified ~env
+
+let compile_expression : string -> Compile.Helpers.s_syntax -> Michelson.t result =
+  fun expression syntax ->
+  let%bind syntax = Compile.Helpers.syntax_to_variant syntax None in
+  let%bind simplified = Compile.Helpers.parsify_expression syntax expression in
+  Of_simplified.compile_expression simplified
+
+let compile_file_contract_storage ~value : string -> string -> string -> Compile.Helpers.s_syntax -> Michelson.t result =
+  fun source_filename _entry_point expression syntax ->
+  let%bind program = Compile.Of_source.type_file syntax source_filename in
+  let env = Ast_typed.program_environment program in
+  let%bind syntax = Compile.Helpers.syntax_to_variant syntax (Some source_filename) in
+  let%bind simplified = Compile.Helpers.parsify_expression syntax expression in
+  Of_simplified.compile_expression ~value simplified ~env
+
+let compile_file_contract_args =
+  fun ?value source_filename _entry_point storage parameter syntax ->
+  let%bind program = Compile.Of_source.type_file syntax source_filename in
+  let env = Ast_typed.program_environment program in
+  let%bind syntax = Compile.Helpers.syntax_to_variant syntax (Some source_filename) in
+  let%bind storage_simplified = Compile.Helpers.parsify_expression syntax storage in
+  let%bind parameter_simplified = Compile.Helpers.parsify_expression syntax parameter in
+  let args = Ast_simplified.e_pair storage_simplified parameter_simplified in
+  Of_simplified.compile_expression ?value args ~env
+
+
+let run_contract ?amount ?storage_value 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_file_contract_args ?value:storage_value 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_entry ?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_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_entry ?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 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.evaluate ~options code
+  in
+  Compile.Of_simplified.uncompile_typed_program_entry_expression_result program entry_point ex_value_ty
+
+let evaluate_michelson expression syntax =
+  let%bind code = Compile.Of_source.compile_expression_as_function expression syntax in
+  Of_michelson.evaluate_michelson code
+
+

src/main/run/of_typed.ml

@@ -0,0 +1,42 @@
+open Trace
+open Ast_typed
+
+let compile_expression ?(value = false) expr =
+  if value
+  then (
+    Compile.Of_typed.compile_expression_as_value expr
+  )
+  else (
+    let%bind code = Compile.Of_typed.compile_expression_as_function expr in
+    Of_michelson.evaluate_michelson code
+  )
+
+let run_function ?options f input =
+  let%bind code = Compile.Of_typed.compile_function f in
+  let%bind input = 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_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 (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 ex_ty_value in
-  ok result

src/main/run_simplified.ml

@@ -1,27 +0,0 @@
-open Trace
-
-let run_simplityped
-    ?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 ?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,286 +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
-    (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
-
-
-let compile_contract_storage : 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 , 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 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") @@
-      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 ?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 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 (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,70 +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
-
-let run_typed
-    ?(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 = 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 ~debug_michelson ?options 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