Merge branch 'dev' into site-redesign-init
This commit is contained in:
commit
a2701336e7
2
.gitignore
vendored
2
.gitignore
vendored
@ -1,6 +1,8 @@
|
||||
/_build/
|
||||
dune-project
|
||||
*~
|
||||
*.merlin
|
||||
cache/*
|
||||
Version.ml
|
||||
/_opam/
|
||||
/*.pp.ligo
|
||||
|
@ -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
|
||||
after_script:
|
||||
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:
|
||||
|
@ -18,15 +18,13 @@ const versions = require(`${CWD}/versions.json`);
|
||||
function Versions(props) {
|
||||
const {config: siteConfig} = props;
|
||||
const latestVersion = versions[0];
|
||||
const repoUrl = `https://github.com/${siteConfig.organizationName}/${
|
||||
siteConfig.projectName
|
||||
}`;
|
||||
const repoUrl = `${siteConfig.repoUrl}`;
|
||||
return (
|
||||
<div className="docMainWrapper wrapper">
|
||||
<Container className="mainContainer versionsContainer">
|
||||
<div className="post">
|
||||
<header className="postHeader">
|
||||
<h1>{siteConfig.title} Versions</h1>
|
||||
<h1>{siteConfig.title} Versions </h1>
|
||||
</header>
|
||||
<h3 id="latest">Current version</h3>
|
||||
<table className="versions">
|
||||
|
1
scripts/ligo_ci.sh
Executable file
1
scripts/ligo_ci.sh
Executable file
@ -0,0 +1 @@
|
||||
docker run -i -v "$PWD":"$PWD" -w "$PWD" ligolang/ligo:next "$@"
|
29
scripts/test_cli.sh
Executable file
29
scripts/test_cli.sh
Executable file
@ -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";
|
106
src/bin/cli.ml
106
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 =
|
||||
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.Run.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 =
|
||||
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 source entry_point expression (Syntax_name syntax) in
|
||||
Format.printf "%s\n" value;
|
||||
ok ()
|
||||
Ligo.Run.Of_source.compile_file_contract_storage ~value: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) 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 =
|
||||
toplevel @@
|
||||
let f source entry_point storage input amount syntax display_format bigmap =
|
||||
toplevel ~display_format @@
|
||||
let%bind output =
|
||||
Ligo.Run.run_contract ~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 ~storage_value: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 $ 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_entry ~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_entry ~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)
|
||||
|
||||
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 ;
|
||||
|
@ -1,9 +1,16 @@
|
||||
open Trace
|
||||
open Main.Display
|
||||
|
||||
let toplevel x =
|
||||
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
|
||||
match x with
|
||||
| Trace.Ok ((), annotations) -> ignore annotations; ()
|
||||
| Error ss -> (
|
||||
Format.printf "%a%!" Ligo.Display.error_pp (ss ())
|
||||
)
|
||||
|
||||
| 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
|
||||
|
@ -1,5 +0,0 @@
|
||||
const lst : list(int) = list [] ;
|
||||
|
||||
const address : address = "tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx" ;
|
||||
|
||||
const address_2 : address = ("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx" : address) ;
|
@ -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)
|
@ -1 +0,0 @@
|
||||
const foo : nat = 42 + "bar"
|
@ -1 +0,0 @@
|
||||
const foo : int = 144
|
@ -1,3 +0,0 @@
|
||||
#include "included.ligo"
|
||||
|
||||
const bar : int = foo
|
@ -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)
|
@ -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
|
17
src/dune
17
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/*))
|
||||
)
|
||||
|
22
src/main/compile/dune
Normal file
22
src/main/compile/dune
Normal file
@ -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 ))
|
||||
)
|
76
src/main/compile/helpers.ml
Normal file
76
src/main/compile/helpers.ml
Normal file
@ -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
|
56
src/main/compile/of_mini_c.ml
Normal file
56
src/main/compile/of_mini_c.ml
Normal file
@ -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
|
40
src/main/compile/of_simplified.ml
Normal file
40
src/main/compile/of_simplified.ml
Normal file
@ -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
|
39
src/main/compile/of_source.ml
Normal file
39
src/main/compile/of_source.ml
Normal file
@ -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
|
57
src/main/compile/of_typed.ml
Normal file
57
src/main/compile/of_typed.ml
Normal file
@ -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
|
@ -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,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) 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 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
|
||||
|
@ -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)
|
||||
|
138
src/main/main.ml
138
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 *)
|
||||
|
22
src/main/run/dune
Normal file
22
src/main/run/dune
Normal file
@ -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 ))
|
||||
)
|
47
src/main/run/of_michelson.ml
Normal file
47
src/main/run/of_michelson.ml
Normal file
@ -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
|
53
src/main/run/of_mini_c.ml
Normal file
53
src/main/run/of_mini_c.ml
Normal file
@ -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
|
32
src/main/run/of_simplified.ml
Normal file
32
src/main/run/of_simplified.ml
Normal file
@ -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
|
137
src/main/run/of_source.ml
Normal file
137
src/main/run/of_source.ml
Normal file
@ -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
|
||||
|
||||
|
42
src/main/run/of_typed.ml
Normal file
42
src/main/run/of_typed.ml
Normal file
@ -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
|
5
src/main/run/run.ml
Normal file
5
src/main/run/run.ml
Normal file
@ -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
|
@ -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
|
@ -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
|
@ -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
|
@ -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
|
@ -4,7 +4,7 @@ module Parser = Parser_pascaligo.Parser
|
||||
module AST = Parser_pascaligo.AST
|
||||
module ParserLog = Parser_pascaligo.ParserLog
|
||||
|
||||
let parse_file (source: string) : AST.t result =
|
||||
let parse_file (source: string) : AST.t result =
|
||||
let pp_input =
|
||||
let prefix = Filename.(source |> basename |> remove_extension)
|
||||
and suffix = ".pp.ligo"
|
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue
Block a user