Merge branch 'LIGO-92-buttons' into LIGO-94-feature-cards

This commit is contained in:
Sarah Fowler 2019-09-26 10:26:12 -04:00
commit 37c233e0cc
278 changed files with 3092 additions and 1378 deletions

2
.gitignore vendored
View File

@ -1,7 +1,9 @@
/_build/
dune-project
*~
*.merlin
cache/*
Version.ml
/_opam/
/*.pp.ligo
**/.DS_Store

View File

@ -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:

View File

@ -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
View File

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

29
scripts/test_cli.sh Executable file
View 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";

View File

@ -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 ;

View File

@ -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

View File

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

View File

@ -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)

View File

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

View File

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

View File

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

View File

@ -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)

View File

@ -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

View File

@ -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
View 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 ))
)

View 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

View 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

View 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

View 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

View 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

View File

@ -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

View File

@ -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)

View File

@ -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
View 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 ))
)

View 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
View 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

View 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
View 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
View 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
View 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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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