Merge remote-tracking branch 'origin/dev' into rinderknecht-dev
This commit is contained in:
commit
705b425589
4
.gitignore
vendored
4
.gitignore
vendored
@ -1,5 +1,4 @@
|
|||||||
/_build/
|
/_build/
|
||||||
dune-project
|
|
||||||
*~
|
*~
|
||||||
*.merlin
|
*.merlin
|
||||||
cache/*
|
cache/*
|
||||||
@ -7,4 +6,5 @@ Version.ml
|
|||||||
/_opam/
|
/_opam/
|
||||||
/*.pp.ligo
|
/*.pp.ligo
|
||||||
**/.DS_Store
|
**/.DS_Store
|
||||||
.vscode/
|
.vscode/
|
||||||
|
/ligo.install
|
||||||
|
3
dune-project
Normal file
3
dune-project
Normal file
@ -0,0 +1,3 @@
|
|||||||
|
(lang dune 1.11)
|
||||||
|
(name ligo)
|
||||||
|
(using menhir 2.0)
|
@ -66,7 +66,7 @@ let amount =
|
|||||||
let open Arg in
|
let open Arg in
|
||||||
let info =
|
let info =
|
||||||
let docv = "AMOUNT" in
|
let docv = "AMOUNT" in
|
||||||
let doc = "$(docv) is the amount the dry-run transaction will use." in
|
let doc = "$(docv) is the amount the michelson interpreter will use." in
|
||||||
info ~docv ~doc ["amount"] in
|
info ~docv ~doc ["amount"] in
|
||||||
value @@ opt string "0" info
|
value @@ opt string "0" info
|
||||||
|
|
||||||
@ -74,7 +74,7 @@ let sender =
|
|||||||
let open Arg in
|
let open Arg in
|
||||||
let info =
|
let info =
|
||||||
let docv = "SENDER" in
|
let docv = "SENDER" in
|
||||||
let doc = "$(docv) is the sender the dry-run transaction will use." in
|
let doc = "$(docv) is the sender the michelson interpreter transaction will use." in
|
||||||
info ~docv ~doc ["sender"] in
|
info ~docv ~doc ["sender"] in
|
||||||
value @@ opt (some string) None info
|
value @@ opt (some string) None info
|
||||||
|
|
||||||
@ -82,10 +82,18 @@ let source =
|
|||||||
let open Arg in
|
let open Arg in
|
||||||
let info =
|
let info =
|
||||||
let docv = "SOURCE" in
|
let docv = "SOURCE" in
|
||||||
let doc = "$(docv) is the source the dry-run transaction will use." in
|
let doc = "$(docv) is the source the michelson interpreter transaction will use." in
|
||||||
info ~docv ~doc ["source"] in
|
info ~docv ~doc ["source"] in
|
||||||
value @@ opt (some string) None info
|
value @@ opt (some string) None info
|
||||||
|
|
||||||
|
let predecessor_timestamp =
|
||||||
|
let open Arg in
|
||||||
|
let info =
|
||||||
|
let docv = "PREDECESSOR_TIMESTAMP" in
|
||||||
|
let doc = "$(docv) is the pedecessor_timestamp the michelson interpreter transaction will use (e.g. '2000-01-01T10:10:10Z')" in
|
||||||
|
info ~docv ~doc ["predecessor-timestamp"] in
|
||||||
|
value @@ opt (some string) None info
|
||||||
|
|
||||||
let display_format =
|
let display_format =
|
||||||
let open Arg in
|
let open Arg in
|
||||||
let info =
|
let info =
|
||||||
@ -176,7 +184,7 @@ let compile_parameter =
|
|||||||
(Term.ret term , Term.info ~doc cmdname)
|
(Term.ret term , Term.info ~doc cmdname)
|
||||||
|
|
||||||
let interpret =
|
let interpret =
|
||||||
let f expression init_file syntax amount sender source display_format =
|
let f expression init_file syntax amount sender source predecessor_timestamp display_format =
|
||||||
toplevel ~display_format @@
|
toplevel ~display_format @@
|
||||||
let%bind (decl_list,state,env) = match init_file with
|
let%bind (decl_list,state,env) = match init_file with
|
||||||
| Some init_file ->
|
| Some init_file ->
|
||||||
@ -192,13 +200,13 @@ let interpret =
|
|||||||
let%bind (typed_exp,_) = Compile.Of_simplified.compile_expression ~env ~state simplified_exp in
|
let%bind (typed_exp,_) = Compile.Of_simplified.compile_expression ~env ~state simplified_exp in
|
||||||
let%bind mini_c_exp = Compile.Of_typed.compile_expression typed_exp in
|
let%bind mini_c_exp = Compile.Of_typed.compile_expression typed_exp in
|
||||||
let%bind compiled_exp = Compile.Of_mini_c.aggregate_and_compile_expression decl_list mini_c_exp in
|
let%bind compiled_exp = Compile.Of_mini_c.aggregate_and_compile_expression decl_list mini_c_exp in
|
||||||
let%bind options = Run.make_dry_run_options {amount ; sender ; source } in
|
let%bind options = Run.make_dry_run_options {predecessor_timestamp ; amount ; sender ; source } in
|
||||||
let%bind value = Run.run ~options compiled_exp.expr compiled_exp.expr_ty in
|
let%bind value = Run.run ~options compiled_exp.expr compiled_exp.expr_ty in
|
||||||
let%bind simplified_output = Uncompile.uncompile_expression typed_exp.type_annotation value in
|
let%bind simplified_output = Uncompile.uncompile_expression typed_exp.type_annotation value in
|
||||||
ok @@ Format.asprintf "%a\n" Ast_simplified.PP.expression simplified_output
|
ok @@ Format.asprintf "%a\n" Ast_simplified.PP.expression simplified_output
|
||||||
in
|
in
|
||||||
let term =
|
let term =
|
||||||
Term.(const f $ expression "EXPRESSION" 0 $ init_file $ syntax $ amount $ sender $ source $ display_format ) in
|
Term.(const f $ expression "EXPRESSION" 0 $ init_file $ syntax $ amount $ sender $ source $ predecessor_timestamp $ display_format ) in
|
||||||
let cmdname = "interpret" in
|
let cmdname = "interpret" in
|
||||||
let doc = "Subcommand: interpret the expression in the context initialized by the provided source file." in
|
let doc = "Subcommand: interpret the expression in the context initialized by the provided source file." in
|
||||||
(Term.ret term , Term.info ~doc cmdname)
|
(Term.ret term , Term.info ~doc cmdname)
|
||||||
@ -233,7 +241,7 @@ let compile_storage =
|
|||||||
(Term.ret term , Term.info ~doc cmdname)
|
(Term.ret term , Term.info ~doc cmdname)
|
||||||
|
|
||||||
let dry_run =
|
let dry_run =
|
||||||
let f source_file entry_point storage input amount sender source syntax display_format =
|
let f source_file entry_point storage input amount sender source predecessor_timestamp syntax display_format =
|
||||||
toplevel ~display_format @@
|
toplevel ~display_format @@
|
||||||
let%bind simplified = Compile.Of_source.compile source_file (Syntax_name syntax) in
|
let%bind simplified = Compile.Of_source.compile source_file (Syntax_name syntax) in
|
||||||
let%bind typed_prg,state = Compile.Of_simplified.compile simplified in
|
let%bind typed_prg,state = Compile.Of_simplified.compile simplified in
|
||||||
@ -251,20 +259,20 @@ let dry_run =
|
|||||||
let%bind compiled_params = Compile.Of_mini_c.compile_expression mini_c in
|
let%bind compiled_params = Compile.Of_mini_c.compile_expression mini_c in
|
||||||
let%bind args_michelson = Run.evaluate_expression compiled_params.expr compiled_params.expr_ty in
|
let%bind args_michelson = Run.evaluate_expression compiled_params.expr compiled_params.expr_ty in
|
||||||
|
|
||||||
let%bind options = Run.make_dry_run_options {amount ; sender ; source } in
|
let%bind options = Run.make_dry_run_options {predecessor_timestamp ; amount ; sender ; source } in
|
||||||
let%bind michelson_output = Run.run_contract ~options michelson_prg.expr michelson_prg.expr_ty args_michelson in
|
let%bind michelson_output = Run.run_contract ~options michelson_prg.expr michelson_prg.expr_ty args_michelson in
|
||||||
|
|
||||||
let%bind simplified_output = Uncompile.uncompile_typed_program_entry_function_result typed_prg entry_point michelson_output in
|
let%bind simplified_output = Uncompile.uncompile_typed_program_entry_function_result typed_prg entry_point michelson_output in
|
||||||
ok @@ Format.asprintf "%a\n" Ast_simplified.PP.expression simplified_output
|
ok @@ Format.asprintf "%a\n" Ast_simplified.PP.expression simplified_output
|
||||||
in
|
in
|
||||||
let term =
|
let term =
|
||||||
Term.(const f $ source_file 0 $ entry_point 1 $ expression "PARAMETER" 2 $ expression "STORAGE" 3 $ amount $ sender $ source $ syntax $ display_format) in
|
Term.(const f $ source_file 0 $ entry_point 1 $ expression "PARAMETER" 2 $ expression "STORAGE" 3 $ amount $ sender $ source $ predecessor_timestamp $ syntax $ display_format) in
|
||||||
let cmdname = "dry-run" in
|
let cmdname = "dry-run" in
|
||||||
let doc = "Subcommand: run a smart-contract with the given storage and input." in
|
let doc = "Subcommand: run a smart-contract with the given storage and input." in
|
||||||
(Term.ret term , Term.info ~doc cmdname)
|
(Term.ret term , Term.info ~doc cmdname)
|
||||||
|
|
||||||
let run_function =
|
let run_function =
|
||||||
let f source_file entry_point parameter amount sender source syntax display_format =
|
let f source_file entry_point parameter amount sender source predecessor_timestamp syntax display_format =
|
||||||
toplevel ~display_format @@
|
toplevel ~display_format @@
|
||||||
let%bind v_syntax = Helpers.syntax_to_variant (Syntax_name syntax) (Some source_file) in
|
let%bind v_syntax = Helpers.syntax_to_variant (Syntax_name syntax) (Some source_file) in
|
||||||
let%bind simplified_prg = Compile.Of_source.compile source_file (Syntax_name syntax) in
|
let%bind simplified_prg = Compile.Of_source.compile source_file (Syntax_name syntax) in
|
||||||
@ -278,32 +286,32 @@ let run_function =
|
|||||||
let%bind compiled_applied = Compile.Of_typed.compile_expression typed_app in
|
let%bind compiled_applied = Compile.Of_typed.compile_expression typed_app in
|
||||||
|
|
||||||
let%bind michelson = Compile.Of_mini_c.aggregate_and_compile_expression mini_c_prg compiled_applied in
|
let%bind michelson = Compile.Of_mini_c.aggregate_and_compile_expression mini_c_prg compiled_applied in
|
||||||
let%bind options = Run.make_dry_run_options {amount ; sender ; source } in
|
let%bind options = Run.make_dry_run_options {predecessor_timestamp ; amount ; sender ; source } in
|
||||||
let%bind michelson_output = Run.run ~options michelson.expr michelson.expr_ty in
|
let%bind michelson_output = Run.run ~options michelson.expr michelson.expr_ty in
|
||||||
let%bind simplified_output = Uncompile.uncompile_typed_program_entry_function_result typed_prg entry_point michelson_output in
|
let%bind simplified_output = Uncompile.uncompile_typed_program_entry_function_result typed_prg entry_point michelson_output in
|
||||||
ok @@ Format.asprintf "%a\n" Ast_simplified.PP.expression simplified_output
|
ok @@ Format.asprintf "%a\n" Ast_simplified.PP.expression simplified_output
|
||||||
in
|
in
|
||||||
let term =
|
let term =
|
||||||
Term.(const f $ source_file 0 $ entry_point 1 $ expression "PARAMETER" 2 $ amount $ sender $ source $ syntax $ display_format) in
|
Term.(const f $ source_file 0 $ entry_point 1 $ expression "PARAMETER" 2 $ amount $ sender $ source $ predecessor_timestamp $ syntax $ display_format) in
|
||||||
let cmdname = "run-function" in
|
let cmdname = "run-function" in
|
||||||
let doc = "Subcommand: run a function with the given parameter." in
|
let doc = "Subcommand: run a function with the given parameter." in
|
||||||
(Term.ret term , Term.info ~doc cmdname)
|
(Term.ret term , Term.info ~doc cmdname)
|
||||||
|
|
||||||
let evaluate_value =
|
let evaluate_value =
|
||||||
let f source_file entry_point amount sender source syntax display_format =
|
let f source_file entry_point amount sender source predecessor_timestamp syntax display_format =
|
||||||
toplevel ~display_format @@
|
toplevel ~display_format @@
|
||||||
let%bind simplified = Compile.Of_source.compile source_file (Syntax_name syntax) in
|
let%bind simplified = Compile.Of_source.compile source_file (Syntax_name syntax) in
|
||||||
let%bind typed_prg,_ = Compile.Of_simplified.compile simplified in
|
let%bind typed_prg,_ = Compile.Of_simplified.compile simplified in
|
||||||
let%bind mini_c = Compile.Of_typed.compile typed_prg in
|
let%bind mini_c = Compile.Of_typed.compile typed_prg in
|
||||||
let%bind (exp,_) = Mini_c.get_entry mini_c entry_point in
|
let%bind (exp,_) = Mini_c.get_entry mini_c entry_point in
|
||||||
let%bind compiled = Compile.Of_mini_c.aggregate_and_compile_expression mini_c exp in
|
let%bind compiled = Compile.Of_mini_c.aggregate_and_compile_expression mini_c exp in
|
||||||
let%bind options = Run.make_dry_run_options {amount ; sender ; source } in
|
let%bind options = Run.make_dry_run_options {predecessor_timestamp ; amount ; sender ; source } in
|
||||||
let%bind michelson_output = Run.run ~options compiled.expr compiled.expr_ty in
|
let%bind michelson_output = Run.run ~options compiled.expr compiled.expr_ty in
|
||||||
let%bind simplified_output = Uncompile.uncompile_typed_program_entry_expression_result typed_prg entry_point michelson_output in
|
let%bind simplified_output = Uncompile.uncompile_typed_program_entry_expression_result typed_prg entry_point michelson_output in
|
||||||
ok @@ Format.asprintf "%a\n" Ast_simplified.PP.expression simplified_output
|
ok @@ Format.asprintf "%a\n" Ast_simplified.PP.expression simplified_output
|
||||||
in
|
in
|
||||||
let term =
|
let term =
|
||||||
Term.(const f $ source_file 0 $ entry_point 1 $ amount $ sender $ source $ syntax $ display_format) in
|
Term.(const f $ source_file 0 $ entry_point 1 $ amount $ sender $ source $ predecessor_timestamp $ syntax $ display_format) in
|
||||||
let cmdname = "evaluate-value" in
|
let cmdname = "evaluate-value" in
|
||||||
let doc = "Subcommand: evaluate a given definition." in
|
let doc = "Subcommand: evaluate a given definition." in
|
||||||
(Term.ret term , Term.info ~doc cmdname)
|
(Term.ret term , Term.info ~doc cmdname)
|
||||||
|
@ -278,7 +278,7 @@ let%expect_test _ =
|
|||||||
|
|
||||||
OPTIONS
|
OPTIONS
|
||||||
--amount=AMOUNT (absent=0)
|
--amount=AMOUNT (absent=0)
|
||||||
AMOUNT is the amount the dry-run transaction will use.
|
AMOUNT is the amount the michelson interpreter will use.
|
||||||
|
|
||||||
--format=DISPLAY_FORMAT, --display-format=DISPLAY_FORMAT
|
--format=DISPLAY_FORMAT, --display-format=DISPLAY_FORMAT
|
||||||
(absent=human-readable)
|
(absent=human-readable)
|
||||||
@ -293,16 +293,22 @@ let%expect_test _ =
|
|||||||
`pager', `groff' or `plain'. With `auto', the format is `pager` or
|
`pager', `groff' or `plain'. With `auto', the format is `pager` or
|
||||||
`plain' whenever the TERM env var is `dumb' or undefined.
|
`plain' whenever the TERM env var is `dumb' or undefined.
|
||||||
|
|
||||||
|
--predecessor-timestamp=PREDECESSOR_TIMESTAMP
|
||||||
|
PREDECESSOR_TIMESTAMP is the pedecessor_timestamp the michelson
|
||||||
|
interpreter transaction will use (e.g. '2000-01-01T10:10:10Z')
|
||||||
|
|
||||||
-s SYNTAX, --syntax=SYNTAX (absent=auto)
|
-s SYNTAX, --syntax=SYNTAX (absent=auto)
|
||||||
SYNTAX is the syntax that will be used. Currently supported
|
SYNTAX is the syntax that will be used. Currently supported
|
||||||
syntaxes are "pascaligo" and "cameligo". By default, the syntax is
|
syntaxes are "pascaligo" and "cameligo". By default, the syntax is
|
||||||
guessed from the extension (.ligo and .mligo, respectively).
|
guessed from the extension (.ligo and .mligo, respectively).
|
||||||
|
|
||||||
--sender=SENDER
|
--sender=SENDER
|
||||||
SENDER is the sender the dry-run transaction will use.
|
SENDER is the sender the michelson interpreter transaction will
|
||||||
|
use.
|
||||||
|
|
||||||
--source=SOURCE
|
--source=SOURCE
|
||||||
SOURCE is the source the dry-run transaction will use.
|
SOURCE is the source the michelson interpreter transaction will
|
||||||
|
use.
|
||||||
|
|
||||||
--version
|
--version
|
||||||
Show version information. |} ] ;
|
Show version information. |} ] ;
|
||||||
@ -330,7 +336,7 @@ let%expect_test _ =
|
|||||||
|
|
||||||
OPTIONS
|
OPTIONS
|
||||||
--amount=AMOUNT (absent=0)
|
--amount=AMOUNT (absent=0)
|
||||||
AMOUNT is the amount the dry-run transaction will use.
|
AMOUNT is the amount the michelson interpreter will use.
|
||||||
|
|
||||||
--format=DISPLAY_FORMAT, --display-format=DISPLAY_FORMAT
|
--format=DISPLAY_FORMAT, --display-format=DISPLAY_FORMAT
|
||||||
(absent=human-readable)
|
(absent=human-readable)
|
||||||
@ -345,16 +351,22 @@ let%expect_test _ =
|
|||||||
`pager', `groff' or `plain'. With `auto', the format is `pager` or
|
`pager', `groff' or `plain'. With `auto', the format is `pager` or
|
||||||
`plain' whenever the TERM env var is `dumb' or undefined.
|
`plain' whenever the TERM env var is `dumb' or undefined.
|
||||||
|
|
||||||
|
--predecessor-timestamp=PREDECESSOR_TIMESTAMP
|
||||||
|
PREDECESSOR_TIMESTAMP is the pedecessor_timestamp the michelson
|
||||||
|
interpreter transaction will use (e.g. '2000-01-01T10:10:10Z')
|
||||||
|
|
||||||
-s SYNTAX, --syntax=SYNTAX (absent=auto)
|
-s SYNTAX, --syntax=SYNTAX (absent=auto)
|
||||||
SYNTAX is the syntax that will be used. Currently supported
|
SYNTAX is the syntax that will be used. Currently supported
|
||||||
syntaxes are "pascaligo" and "cameligo". By default, the syntax is
|
syntaxes are "pascaligo" and "cameligo". By default, the syntax is
|
||||||
guessed from the extension (.ligo and .mligo, respectively).
|
guessed from the extension (.ligo and .mligo, respectively).
|
||||||
|
|
||||||
--sender=SENDER
|
--sender=SENDER
|
||||||
SENDER is the sender the dry-run transaction will use.
|
SENDER is the sender the michelson interpreter transaction will
|
||||||
|
use.
|
||||||
|
|
||||||
--source=SOURCE
|
--source=SOURCE
|
||||||
SOURCE is the source the dry-run transaction will use.
|
SOURCE is the source the michelson interpreter transaction will
|
||||||
|
use.
|
||||||
|
|
||||||
--version
|
--version
|
||||||
Show version information. |} ] ;
|
Show version information. |} ] ;
|
||||||
@ -377,7 +389,7 @@ let%expect_test _ =
|
|||||||
|
|
||||||
OPTIONS
|
OPTIONS
|
||||||
--amount=AMOUNT (absent=0)
|
--amount=AMOUNT (absent=0)
|
||||||
AMOUNT is the amount the dry-run transaction will use.
|
AMOUNT is the amount the michelson interpreter will use.
|
||||||
|
|
||||||
--format=DISPLAY_FORMAT, --display-format=DISPLAY_FORMAT
|
--format=DISPLAY_FORMAT, --display-format=DISPLAY_FORMAT
|
||||||
(absent=human-readable)
|
(absent=human-readable)
|
||||||
@ -392,16 +404,22 @@ let%expect_test _ =
|
|||||||
`pager', `groff' or `plain'. With `auto', the format is `pager` or
|
`pager', `groff' or `plain'. With `auto', the format is `pager` or
|
||||||
`plain' whenever the TERM env var is `dumb' or undefined.
|
`plain' whenever the TERM env var is `dumb' or undefined.
|
||||||
|
|
||||||
|
--predecessor-timestamp=PREDECESSOR_TIMESTAMP
|
||||||
|
PREDECESSOR_TIMESTAMP is the pedecessor_timestamp the michelson
|
||||||
|
interpreter transaction will use (e.g. '2000-01-01T10:10:10Z')
|
||||||
|
|
||||||
-s SYNTAX, --syntax=SYNTAX (absent=auto)
|
-s SYNTAX, --syntax=SYNTAX (absent=auto)
|
||||||
SYNTAX is the syntax that will be used. Currently supported
|
SYNTAX is the syntax that will be used. Currently supported
|
||||||
syntaxes are "pascaligo" and "cameligo". By default, the syntax is
|
syntaxes are "pascaligo" and "cameligo". By default, the syntax is
|
||||||
guessed from the extension (.ligo and .mligo, respectively).
|
guessed from the extension (.ligo and .mligo, respectively).
|
||||||
|
|
||||||
--sender=SENDER
|
--sender=SENDER
|
||||||
SENDER is the sender the dry-run transaction will use.
|
SENDER is the sender the michelson interpreter transaction will
|
||||||
|
use.
|
||||||
|
|
||||||
--source=SOURCE
|
--source=SOURCE
|
||||||
SOURCE is the source the dry-run transaction will use.
|
SOURCE is the source the michelson interpreter transaction will
|
||||||
|
use.
|
||||||
|
|
||||||
--version
|
--version
|
||||||
Show version information. |} ] ;
|
Show version information. |} ] ;
|
||||||
|
@ -1,11 +1,25 @@
|
|||||||
open Cli_expect
|
open Cli_expect
|
||||||
|
|
||||||
let%expect_test _ =
|
let%expect_test _ =
|
||||||
run_ligo_bad [ "compile-contract" ; "../../test/contracts/error_typer_1.mligo" ; "foo" ] ;
|
run_ligo_bad [ "compile-contract" ; "../../test/contracts/negative/error_typer_1.mligo" ; "main" ] ;
|
||||||
[%expect {| ligo: in file "error_typer_1.mligo", line 3, characters 19-27. different type constructors: Expected these two constant type constructors to be the same, but they're different {"a":"string","b":"int"} |} ] ;
|
[%expect {| ligo: in file "error_typer_1.mligo", line 3, characters 19-27. different type constructors: Expected these two constant type constructors to be the same, but they're different {"a":"string","b":"int"} |} ] ;
|
||||||
|
|
||||||
run_ligo_bad [ "compile-contract" ; "../../test/contracts/error_typer_2.mligo" ; "foo" ] ;
|
run_ligo_bad [ "compile-contract" ; "../../test/contracts/negative/error_typer_2.mligo" ; "main" ] ;
|
||||||
[%expect {| ligo: in file "error_typer_2.mligo", line 3, characters 24-39. different type constructors: Expected these two n-ary type constructors to be the same, but they're different {"a":"(TO_list(string))","b":"(TO_option(int))"} |} ] ;
|
[%expect {| ligo: in file "error_typer_2.mligo", line 3, characters 24-39. different type constructors: Expected these two n-ary type constructors to be the same, but they're different {"a":"(TO_list(string))","b":"(TO_option(int))"} |} ] ;
|
||||||
|
|
||||||
(* run_ligo_bad [ "compile-contract" ; "../../test/contracts/error_typer_3.mligo" ; "foo" ] ;
|
run_ligo_bad [ "compile-contract" ; "../../test/contracts/negative/error_typer_3.mligo" ; "main" ] ;
|
||||||
* [%expect …some type error… ] ; *)
|
[%expect {| ligo: in file "error_typer_3.mligo", line 3, characters 34-53. tuples have different sizes: Expected these two types to be the same, but they're different (both are tuples, but with a different number of arguments) {"a":"tuple[int , string , bool]","b":"tuple[int , string]"} |} ] ;
|
||||||
|
|
||||||
|
run_ligo_bad [ "compile-contract" ; "../../test/contracts/negative/error_typer_4.mligo" ; "main" ] ;
|
||||||
|
[%expect {| ligo: in file "error_typer_4.mligo", line 4, characters 17-56. different keys in record: {"key_a":"d","key_b":"c"} |} ] ;
|
||||||
|
|
||||||
|
run_ligo_bad [ "compile-contract" ; "../../test/contracts/negative/error_typer_5.mligo" ; "main" ] ;
|
||||||
|
[%expect {| ligo: unbound type variable: {"variable":"boolean","in":"- E[]\tT[] ]","did_you_mean":"bool"} |} ] ;
|
||||||
|
|
||||||
|
run_ligo_bad [ "compile-contract" ; "../../test/contracts/negative/error_typer_6.mligo" ; "main" ] ;
|
||||||
|
[%expect {| ligo: in file "error_typer_6.mligo", line 1, characters 30-64. different type constructors: Expected these two constant type constructors to be the same, but they're different {"a":"string","b":"bool"} |} ] ;
|
||||||
|
|
||||||
|
run_ligo_bad [ "compile-contract" ; "../../test/contracts/negative/error_typer_7.mligo" ; "main" ] ;
|
||||||
|
[%expect {| ligo: in file "error_typer_7.mligo", line 4, characters 17-56. records have different sizes: Expected these two types to be the same, but they're different (both are records, but with a different number of arguments) {"a":"record[b -> string , a -> int]","b":"record[c -> bool , b -> string , a -> int]"} |} ] ;
|
||||||
|
|
||||||
|
|
||||||
|
@ -1,4 +1,4 @@
|
|||||||
open! Trace
|
open Trace
|
||||||
|
|
||||||
let rec error_pp ?(dev = false) out (e : error) =
|
let rec error_pp ?(dev = false) out (e : error) =
|
||||||
let open JSON_string_utils in
|
let open JSON_string_utils in
|
||||||
|
@ -16,6 +16,7 @@ type run_failwith_res =
|
|||||||
|
|
||||||
type dry_run_options =
|
type dry_run_options =
|
||||||
{ amount : string ;
|
{ amount : string ;
|
||||||
|
predecessor_timestamp : string option ;
|
||||||
sender : string option ;
|
sender : string option ;
|
||||||
source : string option }
|
source : string option }
|
||||||
|
|
||||||
@ -44,7 +45,14 @@ let make_dry_run_options (opts : dry_run_options) : options result =
|
|||||||
(simple_error "invalid source address")
|
(simple_error "invalid source address")
|
||||||
(Contract.of_b58check source) in
|
(Contract.of_b58check source) in
|
||||||
ok (Some source) in
|
ok (Some source) in
|
||||||
ok @@ make_options ~amount ?source:sender ?payer:source ()
|
let%bind predecessor_timestamp =
|
||||||
|
match opts.predecessor_timestamp with
|
||||||
|
| None -> ok None
|
||||||
|
| Some st ->
|
||||||
|
match Memory_proto_alpha.Protocol.Alpha_context.Timestamp.of_notation st with
|
||||||
|
| Some t -> ok (Some t)
|
||||||
|
| None -> simple_fail ("\""^st^"\" is a bad timestamp notation") in
|
||||||
|
ok @@ make_options ?predecessor_timestamp:predecessor_timestamp ~amount ?source:sender ?payer:source ()
|
||||||
|
|
||||||
let ex_value_ty_to_michelson (v : ex_typed_value) : Michelson.t result =
|
let ex_value_ty_to_michelson (v : ex_typed_value) : Michelson.t result =
|
||||||
let (Ex_typed_value (value , ty)) = v in
|
let (Ex_typed_value (value , ty)) = v in
|
||||||
|
@ -5,6 +5,73 @@ module AST = Parser_cameligo.AST
|
|||||||
module ParserLog = Parser_cameligo.ParserLog
|
module ParserLog = Parser_cameligo.ParserLog
|
||||||
module LexToken = Parser_reasonligo.LexToken
|
module LexToken = Parser_reasonligo.LexToken
|
||||||
module Lexer = Lexer.Make(LexToken)
|
module Lexer = Lexer.Make(LexToken)
|
||||||
|
module SyntaxError = Parser_reasonligo.SyntaxError
|
||||||
|
|
||||||
|
module Errors = struct
|
||||||
|
|
||||||
|
let wrong_function_arguments expr =
|
||||||
|
let title () = "wrong function arguments" in
|
||||||
|
let message () = "" in
|
||||||
|
let expression_loc = AST.expr_to_region expr in
|
||||||
|
let data = [
|
||||||
|
("expression_loc",
|
||||||
|
fun () -> Format.asprintf "%a" Location.pp_lift @@ expression_loc)
|
||||||
|
] in
|
||||||
|
error ~data title message
|
||||||
|
|
||||||
|
let parser_error start end_ =
|
||||||
|
let title () = "parser error" in
|
||||||
|
let message () = "" in
|
||||||
|
let loc = Region.make
|
||||||
|
~start:(Pos.from_byte start)
|
||||||
|
~stop:(Pos.from_byte end_)
|
||||||
|
in
|
||||||
|
let data = [
|
||||||
|
("parser_loc",
|
||||||
|
fun () -> Format.asprintf "%a" Location.pp_lift @@ loc
|
||||||
|
)
|
||||||
|
] in
|
||||||
|
error ~data title message
|
||||||
|
|
||||||
|
let unrecognized_error start end_ =
|
||||||
|
let title () = "unrecognized error" in
|
||||||
|
let message () = "" in
|
||||||
|
let loc = Region.make
|
||||||
|
~start:(Pos.from_byte start)
|
||||||
|
~stop:(Pos.from_byte end_)
|
||||||
|
in
|
||||||
|
let data = [
|
||||||
|
("unrecognized_loc",
|
||||||
|
fun () -> Format.asprintf "%a" Location.pp_lift @@ loc
|
||||||
|
)
|
||||||
|
] in
|
||||||
|
error ~data title message
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
open Errors
|
||||||
|
|
||||||
|
type 'a parser = (Lexing.lexbuf -> LexToken.token) -> Lexing.lexbuf -> 'a
|
||||||
|
|
||||||
|
let parse (parser: 'a parser) lexbuf =
|
||||||
|
let Lexer.{read ; close ; _} = Lexer.open_token_stream None in
|
||||||
|
let result =
|
||||||
|
try
|
||||||
|
ok (parser read lexbuf)
|
||||||
|
with
|
||||||
|
| SyntaxError.Error (WrongFunctionArguments e) ->
|
||||||
|
fail @@ (wrong_function_arguments e)
|
||||||
|
| Parser.Error ->
|
||||||
|
let start = Lexing.lexeme_start_p lexbuf in
|
||||||
|
let end_ = Lexing.lexeme_end_p lexbuf in
|
||||||
|
fail @@ (parser_error start end_)
|
||||||
|
| _ ->
|
||||||
|
let start = Lexing.lexeme_start_p lexbuf in
|
||||||
|
let end_ = Lexing.lexeme_end_p lexbuf in
|
||||||
|
fail @@ (unrecognized_error start end_)
|
||||||
|
in
|
||||||
|
close ();
|
||||||
|
result
|
||||||
|
|
||||||
let parse_file (source: string) : AST.t result =
|
let parse_file (source: string) : AST.t result =
|
||||||
let pp_input =
|
let pp_input =
|
||||||
@ -20,104 +87,12 @@ let parse_file (source: string) : AST.t result =
|
|||||||
generic_try (simple_error "error opening file") @@
|
generic_try (simple_error "error opening file") @@
|
||||||
(fun () -> open_in pp_input) in
|
(fun () -> open_in pp_input) in
|
||||||
let lexbuf = Lexing.from_channel channel in
|
let lexbuf = Lexing.from_channel channel in
|
||||||
let Lexer.{read ; close ; _} =
|
parse (Parser.contract) lexbuf
|
||||||
Lexer.open_token_stream None in
|
|
||||||
specific_try (function
|
|
||||||
| SyntaxError.Error WrongFunctionArguments ->
|
|
||||||
let start = Lexing.lexeme_start_p lexbuf in
|
|
||||||
let end_ = Lexing.lexeme_end_p lexbuf in
|
|
||||||
let str = Format.sprintf
|
|
||||||
"Incorrect function arguments at \"%s\" from (%d, %d) to (%d, %d). In file \"%s|%s\"\n"
|
|
||||||
(Lexing.lexeme lexbuf)
|
|
||||||
start.pos_lnum (start.pos_cnum - start.pos_bol)
|
|
||||||
end_.pos_lnum (end_.pos_cnum - end_.pos_bol)
|
|
||||||
start.pos_fname source
|
|
||||||
in
|
|
||||||
simple_error str
|
|
||||||
| Parser.Error -> (
|
|
||||||
let start = Lexing.lexeme_start_p lexbuf in
|
|
||||||
let end_ = Lexing.lexeme_end_p lexbuf in
|
|
||||||
let str = Format.sprintf
|
|
||||||
"Parse error at \"%s\" from (%d, %d) to (%d, %d). In file \"%s|%s\"\n"
|
|
||||||
(Lexing.lexeme lexbuf)
|
|
||||||
start.pos_lnum (start.pos_cnum - start.pos_bol)
|
|
||||||
end_.pos_lnum (end_.pos_cnum - end_.pos_bol)
|
|
||||||
start.pos_fname source
|
|
||||||
in
|
|
||||||
simple_error str
|
|
||||||
)
|
|
||||||
| exn ->
|
|
||||||
let start = Lexing.lexeme_start_p lexbuf in
|
|
||||||
let end_ = Lexing.lexeme_end_p lexbuf in
|
|
||||||
let str = Format.sprintf
|
|
||||||
"Unrecognized error (%s) at \"%s\" from (%d, %d) to (%d, %d). In file \"%s|%s\"\n"
|
|
||||||
(Printexc.to_string exn)
|
|
||||||
(Lexing.lexeme lexbuf)
|
|
||||||
start.pos_lnum (start.pos_cnum - start.pos_bol)
|
|
||||||
end_.pos_lnum (end_.pos_cnum - end_.pos_bol)
|
|
||||||
start.pos_fname source
|
|
||||||
in
|
|
||||||
simple_error str
|
|
||||||
) @@ (fun () ->
|
|
||||||
let raw = Parser.contract read lexbuf in
|
|
||||||
close () ;
|
|
||||||
raw
|
|
||||||
) >>? fun raw ->
|
|
||||||
ok raw
|
|
||||||
|
|
||||||
let parse_string (s:string) : AST.t result =
|
let parse_string (s:string) : AST.t result =
|
||||||
let lexbuf = Lexing.from_string s in
|
let lexbuf = Lexing.from_string s in
|
||||||
let Lexer.{read ; close ; _} =
|
parse (Parser.contract) lexbuf
|
||||||
Lexer.open_token_stream None in
|
|
||||||
specific_try (function
|
|
||||||
| Parser.Error -> (
|
|
||||||
let start = Lexing.lexeme_start_p lexbuf in
|
|
||||||
let end_ = Lexing.lexeme_end_p lexbuf in
|
|
||||||
let str = Format.sprintf
|
|
||||||
"Parse error at \"%s\" from (%d, %d) to (%d, %d)\n"
|
|
||||||
(Lexing.lexeme lexbuf)
|
|
||||||
start.pos_lnum (start.pos_cnum - start.pos_bol)
|
|
||||||
end_.pos_lnum (end_.pos_cnum - end_.pos_bol) in
|
|
||||||
simple_error str
|
|
||||||
)
|
|
||||||
| _ -> simple_error "unrecognized parse_ error"
|
|
||||||
) @@ (fun () ->
|
|
||||||
let raw = Parser.contract read lexbuf in
|
|
||||||
close () ;
|
|
||||||
raw
|
|
||||||
) >>? fun raw ->
|
|
||||||
ok raw
|
|
||||||
|
|
||||||
let parse_expression (s:string) : AST.expr result =
|
let parse_expression (s:string) : AST.expr result =
|
||||||
let lexbuf = Lexing.from_string s in
|
let lexbuf = Lexing.from_string s in
|
||||||
let Lexer.{read ; close; _} =
|
parse (Parser.interactive_expr) lexbuf
|
||||||
Lexer.open_token_stream None in
|
|
||||||
specific_try (function
|
|
||||||
| Parser.Error -> (
|
|
||||||
let start = Lexing.lexeme_start_p lexbuf in
|
|
||||||
let end_ = Lexing.lexeme_end_p lexbuf in
|
|
||||||
let str = Format.sprintf
|
|
||||||
"Parse error at \"%s\" from (%d, %d) to (%d, %d)\n"
|
|
||||||
(Lexing.lexeme lexbuf)
|
|
||||||
start.pos_lnum (start.pos_cnum - start.pos_bol)
|
|
||||||
end_.pos_lnum (end_.pos_cnum - end_.pos_bol) in
|
|
||||||
simple_error str
|
|
||||||
)
|
|
||||||
| exn ->
|
|
||||||
let start = Lexing.lexeme_start_p lexbuf in
|
|
||||||
let end_ = Lexing.lexeme_end_p lexbuf in
|
|
||||||
let str = Format.sprintf
|
|
||||||
"Unrecognized error (%s) at \"%s\" from (%d, %d) to (%d, %d). In expression \"%s|%s\"\n"
|
|
||||||
(Printexc.to_string exn)
|
|
||||||
(Lexing.lexeme lexbuf)
|
|
||||||
start.pos_lnum (start.pos_cnum - start.pos_bol)
|
|
||||||
end_.pos_lnum (end_.pos_cnum - end_.pos_bol)
|
|
||||||
start.pos_fname s
|
|
||||||
in
|
|
||||||
simple_error str
|
|
||||||
) @@ (fun () ->
|
|
||||||
let raw = Parser.interactive_expr read lexbuf in
|
|
||||||
close () ;
|
|
||||||
raw
|
|
||||||
) >>? fun raw ->
|
|
||||||
ok raw
|
|
||||||
|
@ -424,7 +424,7 @@ fun_expr:
|
|||||||
{p.value with inside = arg_to_pattern p.value.inside}
|
{p.value with inside = arg_to_pattern p.value.inside}
|
||||||
in PPar {p with value}
|
in PPar {p with value}
|
||||||
| EUnit u -> PUnit u
|
| EUnit u -> PUnit u
|
||||||
| _ -> raise (SyntaxError.Error WrongFunctionArguments)
|
| e -> raise (SyntaxError.Error (WrongFunctionArguments e))
|
||||||
in
|
in
|
||||||
let fun_args_to_pattern = function
|
let fun_args_to_pattern = function
|
||||||
EAnnot {
|
EAnnot {
|
||||||
@ -453,7 +453,7 @@ fun_expr:
|
|||||||
in arg_to_pattern (fst fun_args), bindings
|
in arg_to_pattern (fst fun_args), bindings
|
||||||
| EUnit e ->
|
| EUnit e ->
|
||||||
arg_to_pattern (EUnit e), []
|
arg_to_pattern (EUnit e), []
|
||||||
| _ -> raise (SyntaxError.Error WrongFunctionArguments)
|
| e -> raise (SyntaxError.Error (WrongFunctionArguments e))
|
||||||
in
|
in
|
||||||
let binders = fun_args_to_pattern $1 in
|
let binders = fun_args_to_pattern $1 in
|
||||||
let f = {kwd_fun;
|
let f = {kwd_fun;
|
||||||
|
@ -1,4 +1,4 @@
|
|||||||
type error =
|
type error =
|
||||||
| WrongFunctionArguments
|
| WrongFunctionArguments of AST.expr
|
||||||
|
|
||||||
exception Error of error
|
exception Error of error
|
@ -1,4 +1,4 @@
|
|||||||
type error =
|
type error =
|
||||||
| WrongFunctionArguments
|
| WrongFunctionArguments of AST.expr
|
||||||
|
|
||||||
exception Error of error
|
exception Error of error
|
@ -8,7 +8,7 @@
|
|||||||
(library
|
(library
|
||||||
(name parser_reasonligo)
|
(name parser_reasonligo)
|
||||||
(public_name ligo.parser.reasonligo)
|
(public_name ligo.parser.reasonligo)
|
||||||
(modules reasonligo LexToken Parser)
|
(modules SyntaxError reasonligo LexToken Parser)
|
||||||
(libraries
|
(libraries
|
||||||
menhirLib
|
menhirLib
|
||||||
parser_shared
|
parser_shared
|
||||||
|
@ -3,3 +3,4 @@ module AST = Parser_cameligo.AST
|
|||||||
module Lexer = Lexer
|
module Lexer = Lexer
|
||||||
module LexToken = LexToken
|
module LexToken = LexToken
|
||||||
module ParserLog = Parser_cameligo.ParserLog
|
module ParserLog = Parser_cameligo.ParserLog
|
||||||
|
module SyntaxError = SyntaxError
|
||||||
|
@ -15,8 +15,8 @@
|
|||||||
Markup
|
Markup
|
||||||
FQueue
|
FQueue
|
||||||
EvalOpt
|
EvalOpt
|
||||||
Version
|
Version
|
||||||
SyntaxError))
|
))
|
||||||
|
|
||||||
|
|
||||||
(rule
|
(rule
|
||||||
|
@ -1,4 +1,4 @@
|
|||||||
open! Trace
|
open Trace
|
||||||
open Ast_simplified
|
open Ast_simplified
|
||||||
|
|
||||||
module Raw = Parser.Pascaligo.AST
|
module Raw = Parser.Pascaligo.AST
|
||||||
|
@ -54,7 +54,7 @@ module Errors = struct
|
|||||||
|
|
||||||
let match_redundant_case : type a . (a, unit) I.matching -> Location.t -> unit -> _ =
|
let match_redundant_case : type a . (a, unit) I.matching -> Location.t -> unit -> _ =
|
||||||
fun matching loc () ->
|
fun matching loc () ->
|
||||||
let title = (thunk "missing case in match") in
|
let title = (thunk "redundant case in match") in
|
||||||
let message () = "" in
|
let message () = "" in
|
||||||
let data = [
|
let data = [
|
||||||
("variant" , fun () -> Format.asprintf "%a" I.PP.matching_type matching) ;
|
("variant" , fun () -> Format.asprintf "%a" I.PP.matching_type matching) ;
|
||||||
|
@ -12,13 +12,20 @@ type environment = Environment.t
|
|||||||
|
|
||||||
module Errors = struct
|
module Errors = struct
|
||||||
let unbound_type_variable (e:environment) (tv:I.type_variable) () =
|
let unbound_type_variable (e:environment) (tv:I.type_variable) () =
|
||||||
|
let name = Var.to_name tv in
|
||||||
|
let suggestion = match name with
|
||||||
|
| "integer" -> "int"
|
||||||
|
| "str" -> "string"
|
||||||
|
| "boolean" -> "bool"
|
||||||
|
| _ -> "no suggestion" in
|
||||||
let title = (thunk "unbound type variable") in
|
let title = (thunk "unbound type variable") in
|
||||||
let message () = "" in
|
let message () = "" in
|
||||||
let data = [
|
let data = [
|
||||||
("variable" , fun () -> Format.asprintf "%a" Stage_common.PP.type_variable tv) ;
|
("variable" , fun () -> Format.asprintf "%a" Stage_common.PP.type_variable tv) ;
|
||||||
(* TODO: types don't have srclocs for now. *)
|
(* TODO: types don't have srclocs for now. *)
|
||||||
(* ("location" , fun () -> Format.asprintf "%a" Location.pp (n.location)) ; *)
|
(* ("location" , fun () -> Format.asprintf "%a" Location.pp (n.location)) ; *)
|
||||||
("in" , fun () -> Format.asprintf "%a" Environment.PP.full_environment e)
|
("in" , fun () -> Format.asprintf "%a" Environment.PP.full_environment e) ;
|
||||||
|
("did_you_mean" , fun () -> suggestion)
|
||||||
] in
|
] in
|
||||||
error ~data title message ()
|
error ~data title message ()
|
||||||
|
|
||||||
@ -54,7 +61,7 @@ module Errors = struct
|
|||||||
|
|
||||||
let match_redundant_case : type a . (a, unit) I.matching -> Location.t -> unit -> _ =
|
let match_redundant_case : type a . (a, unit) I.matching -> Location.t -> unit -> _ =
|
||||||
fun matching loc () ->
|
fun matching loc () ->
|
||||||
let title = (thunk "missing case in match") in
|
let title = (thunk "redundant case in match") in
|
||||||
let message () = "" in
|
let message () = "" in
|
||||||
let data = [
|
let data = [
|
||||||
("variant" , fun () -> Format.asprintf "%a" I.PP.matching_type matching) ;
|
("variant" , fun () -> Format.asprintf "%a" I.PP.matching_type matching) ;
|
||||||
@ -464,8 +471,6 @@ and type_expression' : environment -> ?tv_opt:O.type_value -> I.expression -> O.
|
|||||||
| None -> ok ()
|
| None -> ok ()
|
||||||
| Some tv' -> O.assert_type_value_eq (tv' , ae.type_annotation) in
|
| Some tv' -> O.assert_type_value_eq (tv' , ae.type_annotation) in
|
||||||
ok(ae)
|
ok(ae)
|
||||||
|
|
||||||
|
|
||||||
(* Sum *)
|
(* Sum *)
|
||||||
| E_constructor (c, expr) ->
|
| E_constructor (c, expr) ->
|
||||||
let%bind (c_tv, sum_tv) =
|
let%bind (c_tv, sum_tv) =
|
||||||
@ -793,7 +798,12 @@ and type_expression' : environment -> ?tv_opt:O.type_value -> I.expression -> O.
|
|||||||
(Some tv)
|
(Some tv)
|
||||||
(Some expr'.type_annotation)
|
(Some expr'.type_annotation)
|
||||||
(internal_assertion_failure "merge_annotations (Some ...) (Some ...) failed") in
|
(internal_assertion_failure "merge_annotations (Some ...) (Some ...) failed") in
|
||||||
ok {expr' with type_annotation}
|
(* check type annotation of the expression as a whole (e.g. let x : t = (v : t') ) *)
|
||||||
|
let%bind () =
|
||||||
|
match tv_opt with
|
||||||
|
| None -> ok ()
|
||||||
|
| Some tv' -> O.assert_type_value_eq (tv' , type_annotation) in
|
||||||
|
ok @@ {expr' with type_annotation}
|
||||||
|
|
||||||
|
|
||||||
and type_constant (name:I.constant) (lst:O.type_value list) (tv_opt:O.type_value option) : (O.constant * O.type_value) result =
|
and type_constant (name:I.constant) (lst:O.type_value list) (tv_opt:O.type_value option) : (O.constant * O.type_value) result =
|
||||||
|
@ -2,7 +2,7 @@
|
|||||||
|
|
||||||
For more info, see back-end.md: https://gitlab.com/ligolang/ligo/blob/dev/gitlab-pages/docs/contributors/big-picture/back-end.md *)
|
For more info, see back-end.md: https://gitlab.com/ligolang/ligo/blob/dev/gitlab-pages/docs/contributors/big-picture/back-end.md *)
|
||||||
|
|
||||||
open! Trace
|
open Trace
|
||||||
open Helpers
|
open Helpers
|
||||||
|
|
||||||
module AST = Ast_typed
|
module AST = Ast_typed
|
||||||
|
@ -1,4 +1,4 @@
|
|||||||
open! Trace
|
open Trace
|
||||||
|
|
||||||
module AST = Ast_typed
|
module AST = Ast_typed
|
||||||
module Append_tree = Tree.Append
|
module Append_tree = Tree.Append
|
||||||
|
@ -1,5 +1,5 @@
|
|||||||
open Mini_c
|
open Mini_c
|
||||||
open! Trace
|
open Trace
|
||||||
|
|
||||||
(* TODO hack to specialize map_expression to identity monad *)
|
(* TODO hack to specialize map_expression to identity monad *)
|
||||||
let map_expression :
|
let map_expression :
|
||||||
|
@ -29,8 +29,8 @@ open Errors
|
|||||||
(* This does not makes sense to me *)
|
(* This does not makes sense to me *)
|
||||||
let get_operator : constant -> type_value -> expression list -> predicate result = fun s ty lst ->
|
let get_operator : constant -> type_value -> expression list -> predicate result = fun s ty lst ->
|
||||||
match Operators.Compiler.get_operators s with
|
match Operators.Compiler.get_operators s with
|
||||||
| Trace.Ok (x,_) -> ok x
|
| Ok (x,_) -> ok x
|
||||||
| Trace.Error _ -> (
|
| Error _ -> (
|
||||||
match s with
|
match s with
|
||||||
| C_NONE -> (
|
| C_NONE -> (
|
||||||
let%bind ty' = Mini_c.get_t_option ty in
|
let%bind ty' = Mini_c.get_t_option ty in
|
||||||
@ -452,4 +452,4 @@ and translate_function anon env input_ty output_ty : michelson result =
|
|||||||
type compiled_expression = {
|
type compiled_expression = {
|
||||||
expr_ty : ex_ty ;
|
expr_ty : ex_ty ;
|
||||||
expr : michelson ;
|
expr : michelson ;
|
||||||
}
|
}
|
||||||
|
@ -56,7 +56,7 @@ module Errors = struct
|
|||||||
|
|
||||||
let different_types name a b () =
|
let different_types name a b () =
|
||||||
let title () = name ^ " are different" in
|
let title () = name ^ " are different" in
|
||||||
let message () = "" in
|
let message () = "Expected these two types to be the same, but they're different" in
|
||||||
let data = [
|
let data = [
|
||||||
("a" , fun () -> Format.asprintf "%a" PP.type_value a) ;
|
("a" , fun () -> Format.asprintf "%a" PP.type_value a) ;
|
||||||
("b" , fun () -> Format.asprintf "%a" PP.type_value b )
|
("b" , fun () -> Format.asprintf "%a" PP.type_value b )
|
||||||
@ -321,7 +321,7 @@ let rec assert_type_value_eq (a, b: (type_value * type_value)) : unit result = m
|
|||||||
| TC_big_map (ka,va), TC_big_map (kb,vb) -> ok @@ ([ka;va] ,[kb;vb])
|
| TC_big_map (ka,va), TC_big_map (kb,vb) -> ok @@ ([ka;va] ,[kb;vb])
|
||||||
| _,_ -> fail @@ different_operators opa opb
|
| _,_ -> fail @@ different_operators opa opb
|
||||||
in
|
in
|
||||||
trace (different_types "constant sub-expression" a b)
|
trace (different_types "arguments to type operators" a b)
|
||||||
@@ bind_list_iter (fun (a,b) -> assert_type_value_eq (a,b) )(List.combine lsta lstb)
|
@@ bind_list_iter (fun (a,b) -> assert_type_value_eq (a,b) )(List.combine lsta lstb)
|
||||||
)
|
)
|
||||||
| T_operator _, _ -> fail @@ different_kinds a b
|
| T_operator _, _ -> fail @@ different_kinds a b
|
||||||
|
@ -188,10 +188,14 @@ let literal ppf (l:literal) = match l with
|
|||||||
| Literal_timestamp n -> fprintf ppf "+%d" n
|
| Literal_timestamp n -> fprintf ppf "+%d" n
|
||||||
| Literal_mutez n -> fprintf ppf "%dmutez" n
|
| Literal_mutez n -> fprintf ppf "%dmutez" n
|
||||||
| Literal_string s -> fprintf ppf "%S" s
|
| Literal_string s -> fprintf ppf "%S" s
|
||||||
| Literal_bytes b -> fprintf ppf "0x%s" @@ Bytes.to_string @@ Bytes.escaped b
|
| Literal_bytes b -> fprintf ppf "0x%a" Hex.pp (Hex.of_bytes b)
|
||||||
| Literal_address s -> fprintf ppf "@%S" s
|
| Literal_address s -> fprintf ppf "@%S" s
|
||||||
| Literal_operation _ -> fprintf ppf "Operation(...bytes)"
|
| Literal_operation _ -> fprintf ppf "Operation(...bytes)"
|
||||||
| Literal_key s -> fprintf ppf "key %s" s
|
| Literal_key s -> fprintf ppf "key %s" s
|
||||||
| Literal_key_hash s -> fprintf ppf "key_hash %s" s
|
| Literal_key_hash s -> fprintf ppf "key_hash %s" s
|
||||||
| Literal_signature s -> fprintf ppf "Signature %s" s
|
| Literal_signature s -> fprintf ppf "Signature %s" s
|
||||||
| Literal_chain_id s -> fprintf ppf "Chain_id %s" s
|
| Literal_chain_id s -> fprintf ppf "Chain_id %s" s
|
||||||
|
|
||||||
|
let%expect_test _ =
|
||||||
|
Format.printf "%a" literal (Literal_bytes (Bytes.of_string "foo")) ;
|
||||||
|
[%expect{| 0x666f6f |}]
|
||||||
|
@ -5,8 +5,9 @@
|
|||||||
simple-utils
|
simple-utils
|
||||||
tezos-utils
|
tezos-utils
|
||||||
)
|
)
|
||||||
|
(inline_tests)
|
||||||
(preprocess
|
(preprocess
|
||||||
(pps ppx_let)
|
(pps ppx_let ppx_expect)
|
||||||
)
|
)
|
||||||
(flags (:standard -open Simple_utils))
|
(flags (:standard -open Simple_utils))
|
||||||
)
|
)
|
||||||
|
@ -58,8 +58,7 @@ let rec value ppf : value -> unit = function
|
|||||||
| D_unit -> fprintf ppf "unit"
|
| D_unit -> fprintf ppf "unit"
|
||||||
| D_string s -> fprintf ppf "\"%s\"" s
|
| D_string s -> fprintf ppf "\"%s\"" s
|
||||||
| D_bytes x ->
|
| D_bytes x ->
|
||||||
let (`Hex hex) = Hex.of_bytes x in
|
fprintf ppf "0x%a" Hex.pp @@ Hex.of_bytes x
|
||||||
fprintf ppf "0x%s" hex
|
|
||||||
| D_pair (a, b) -> fprintf ppf "(%a), (%a)" value a value b
|
| D_pair (a, b) -> fprintf ppf "(%a), (%a)" value a value b
|
||||||
| D_left a -> fprintf ppf "L(%a)" value a
|
| D_left a -> fprintf ppf "L(%a)" value a
|
||||||
| D_right b -> fprintf ppf "R(%a)" value b
|
| D_right b -> fprintf ppf "R(%a)" value b
|
||||||
@ -124,6 +123,10 @@ let tl_statement ppf (ass, _) = assignment ppf ass
|
|||||||
let program ppf (p:program) =
|
let program ppf (p:program) =
|
||||||
fprintf ppf "Program:\n---\n%a" (pp_print_list ~pp_sep:pp_print_newline tl_statement) p
|
fprintf ppf "Program:\n---\n%a" (pp_print_list ~pp_sep:pp_print_newline tl_statement) p
|
||||||
|
|
||||||
|
let%expect_test _ =
|
||||||
|
Format.printf "%a" value (D_bytes (Bytes.of_string "foo")) ;
|
||||||
|
[%expect{| 0x666f6f |}]
|
||||||
|
|
||||||
let%expect_test _ =
|
let%expect_test _ =
|
||||||
let pp = expression' Format.std_formatter in
|
let pp = expression' Format.std_formatter in
|
||||||
let dummy_type = T_base Base_unit in
|
let dummy_type = T_base Base_unit in
|
||||||
|
@ -1,3 +0,0 @@
|
|||||||
type toto = int
|
|
||||||
|
|
||||||
let foo : string = 42 + 127
|
|
@ -1,3 +0,0 @@
|
|||||||
type toto = int option
|
|
||||||
|
|
||||||
let foo : string list = Some (42 + 127)
|
|
1
src/test/contracts/negative/README
Normal file
1
src/test/contracts/negative/README
Normal file
@ -0,0 +1 @@
|
|||||||
|
This folder contains contracts for negative tests: contracts that are expected to fail (parse error, type error and so on).
|
6
src/test/contracts/negative/error_typer_1.mligo
Normal file
6
src/test/contracts/negative/error_typer_1.mligo
Normal file
@ -0,0 +1,6 @@
|
|||||||
|
type toto = int
|
||||||
|
|
||||||
|
let foo : string = 42 + 127
|
||||||
|
|
||||||
|
let main (p:int) (storage : int) =
|
||||||
|
(([] : operation list) , p + foo)
|
6
src/test/contracts/negative/error_typer_2.mligo
Normal file
6
src/test/contracts/negative/error_typer_2.mligo
Normal file
@ -0,0 +1,6 @@
|
|||||||
|
type toto = int option
|
||||||
|
|
||||||
|
let foo : string list = Some (42 + 127)
|
||||||
|
|
||||||
|
let main (p:int) (storage : int) =
|
||||||
|
(([] : operation list) , p)
|
7
src/test/contracts/negative/error_typer_4.mligo
Normal file
7
src/test/contracts/negative/error_typer_4.mligo
Normal file
@ -0,0 +1,7 @@
|
|||||||
|
type toto = { a : int ; b : string ; c : bool }
|
||||||
|
type tata = { a : int ; d : string ; c : bool }
|
||||||
|
|
||||||
|
let foo : tata = ({a = 1 ; b = "foo" ; c = true} : toto)
|
||||||
|
|
||||||
|
let main (p:int) (storage : int) =
|
||||||
|
(([] : operation list) , p + foo.a)
|
4
src/test/contracts/negative/error_typer_5.mligo
Normal file
4
src/test/contracts/negative/error_typer_5.mligo
Normal file
@ -0,0 +1,4 @@
|
|||||||
|
let foo : boolean = 3
|
||||||
|
|
||||||
|
let main (p:int) (storage : int) =
|
||||||
|
(([] : operation list) , p + foo)
|
3
src/test/contracts/negative/error_typer_6.mligo
Normal file
3
src/test/contracts/negative/error_typer_6.mligo
Normal file
@ -0,0 +1,3 @@
|
|||||||
|
let foo : (int, string) map = (Map.literal [] : (int, bool) map)
|
||||||
|
let main (p:int) (storage : int) =
|
||||||
|
(([] : operation list) , p)
|
7
src/test/contracts/negative/error_typer_7.mligo
Normal file
7
src/test/contracts/negative/error_typer_7.mligo
Normal file
@ -0,0 +1,7 @@
|
|||||||
|
type toto = { a : int ; b : string }
|
||||||
|
type tata = { a : int ; }
|
||||||
|
|
||||||
|
let foo : tata = ({a = 1 ; b = "foo" ; c = true} : toto)
|
||||||
|
|
||||||
|
let main (p:int) (storage : int) =
|
||||||
|
(([] : operation list) , p + foo.a)
|
25
src/test/contracts/time-lock.ligo
Normal file
25
src/test/contracts/time-lock.ligo
Normal file
@ -0,0 +1,25 @@
|
|||||||
|
type storage_t is timestamp
|
||||||
|
|
||||||
|
type message_t is (unit -> list(operation))
|
||||||
|
type default_pt is unit
|
||||||
|
type call_pt is message_t
|
||||||
|
type contract_return_t is (list(operation) * storage_t)
|
||||||
|
|
||||||
|
type entry_point_t is
|
||||||
|
| Call of call_pt
|
||||||
|
| Default of default_pt
|
||||||
|
|
||||||
|
function call (const p : call_pt; const s : storage_t) : contract_return_t is block {
|
||||||
|
if s >= now then failwith("Contract is still time locked") else skip ;
|
||||||
|
const message : message_t = p ;
|
||||||
|
const ret_ops : list(operation) = message(unit) ;
|
||||||
|
} with (ret_ops,s)
|
||||||
|
|
||||||
|
function default (const p : default_pt; const s : storage_t) : contract_return_t is
|
||||||
|
((nil: list(operation)) , s)
|
||||||
|
|
||||||
|
function main(const param : entry_point_t; const s : storage_t) : contract_return_t is
|
||||||
|
case param of
|
||||||
|
| Call (p) -> call(p,s)
|
||||||
|
| Default (p) -> default(p,s)
|
||||||
|
end
|
@ -15,7 +15,8 @@
|
|||||||
(alias
|
(alias
|
||||||
(name ligo-test)
|
(name ligo-test)
|
||||||
(action (run ./test.exe))
|
(action (run ./test.exe))
|
||||||
(deps (glob_files contracts/*))
|
(deps (glob_files contracts/*)
|
||||||
|
(glob_files contracts/negative/*))
|
||||||
)
|
)
|
||||||
|
|
||||||
(alias
|
(alias
|
||||||
|
@ -13,5 +13,6 @@ let () =
|
|||||||
Multisig_tests.main ;
|
Multisig_tests.main ;
|
||||||
Multisig_v2_tests.main ;
|
Multisig_v2_tests.main ;
|
||||||
Replaceable_id_tests.main ;
|
Replaceable_id_tests.main ;
|
||||||
|
Time_lock_tests.main ;
|
||||||
] ;
|
] ;
|
||||||
()
|
()
|
||||||
|
@ -1,4 +1,4 @@
|
|||||||
open! Trace
|
open Trace
|
||||||
|
|
||||||
type test_case = unit Alcotest.test_case
|
type test_case = unit Alcotest.test_case
|
||||||
type test =
|
type test =
|
||||||
@ -17,7 +17,7 @@ let wrap_test name f =
|
|||||||
|
|
||||||
let wrap_test_raw f =
|
let wrap_test_raw f =
|
||||||
match f () with
|
match f () with
|
||||||
| Trace.Ok ((), annotations) -> ignore annotations; ()
|
| Ok ((), annotations) -> ignore annotations; ()
|
||||||
| Error err ->
|
| Error err ->
|
||||||
Format.printf "%a\n%!" (Ligo.Display.error_pp ~dev:true) (err ())
|
Format.printf "%a\n%!" (Ligo.Display.error_pp ~dev:true) (err ())
|
||||||
|
|
||||||
|
69
src/test/time_lock_tests.ml
Normal file
69
src/test/time_lock_tests.ml
Normal file
@ -0,0 +1,69 @@
|
|||||||
|
open Trace
|
||||||
|
open Test_helpers
|
||||||
|
|
||||||
|
let type_file f =
|
||||||
|
let%bind simplified = Ligo.Compile.Of_source.compile f (Syntax_name "pascaligo") in
|
||||||
|
let%bind typed,state = Ligo.Compile.Of_simplified.compile simplified in
|
||||||
|
ok @@ (typed,state)
|
||||||
|
|
||||||
|
let get_program =
|
||||||
|
let s = ref None in
|
||||||
|
fun () -> match !s with
|
||||||
|
| Some s -> ok s
|
||||||
|
| None -> (
|
||||||
|
let%bind program = type_file "./contracts/time-lock.ligo" in
|
||||||
|
s := Some program ;
|
||||||
|
ok program
|
||||||
|
)
|
||||||
|
|
||||||
|
let compile_main () =
|
||||||
|
let%bind simplified = Ligo.Compile.Of_source.compile "./contracts/time-lock.ligo" (Syntax_name "pascaligo") in
|
||||||
|
let%bind typed_prg,_ = Ligo.Compile.Of_simplified.compile simplified in
|
||||||
|
let%bind mini_c_prg = Ligo.Compile.Of_typed.compile typed_prg in
|
||||||
|
let%bind michelson_prg = Ligo.Compile.Of_mini_c.aggregate_and_compile_contract mini_c_prg "main" in
|
||||||
|
let%bind (_contract: Tezos_utils.Michelson.michelson) =
|
||||||
|
(* fails if the given entry point is not a valid contract *)
|
||||||
|
Ligo.Compile.Of_michelson.build_contract michelson_prg in
|
||||||
|
ok ()
|
||||||
|
|
||||||
|
open Ast_simplified
|
||||||
|
let empty_op_list =
|
||||||
|
(e_typed_list [] t_operation)
|
||||||
|
let empty_message = e_lambda (Var.of_name "arguments")
|
||||||
|
(Some t_unit) (Some (t_list t_operation))
|
||||||
|
empty_op_list
|
||||||
|
|
||||||
|
let call msg = e_constructor "Call" msg
|
||||||
|
let mk_time st =
|
||||||
|
match Memory_proto_alpha.Protocol.Alpha_context.Timestamp.of_notation st with
|
||||||
|
| Some s -> ok s
|
||||||
|
| None -> simple_fail "bad timestamp notation"
|
||||||
|
let to_sec t = Tezos_utils.Time.Protocol.to_seconds t
|
||||||
|
let storage st = e_timestamp (Int64.to_int @@ to_sec st)
|
||||||
|
|
||||||
|
let early_call () =
|
||||||
|
let%bind program,_ = get_program () in
|
||||||
|
let%bind predecessor_timestamp = mk_time "2000-01-01T00:10:10Z" in
|
||||||
|
let%bind lock_time = mk_time "2000-01-01T10:10:10Z" in
|
||||||
|
let init_storage = storage lock_time in
|
||||||
|
let options =
|
||||||
|
Proto_alpha_utils.Memory_proto_alpha.make_options ~predecessor_timestamp () in
|
||||||
|
let exp_failwith = "Contract is still time locked" in
|
||||||
|
expect_string_failwith ~options program "main"
|
||||||
|
(e_pair (call empty_message) init_storage) exp_failwith
|
||||||
|
|
||||||
|
let call_on_time () =
|
||||||
|
let%bind program,_ = get_program () in
|
||||||
|
let%bind predecessor_timestamp = mk_time "2000-01-01T10:10:10Z" in
|
||||||
|
let%bind lock_time = mk_time "2000-01-01T00:10:10Z" in
|
||||||
|
let init_storage = storage lock_time in
|
||||||
|
let options =
|
||||||
|
Proto_alpha_utils.Memory_proto_alpha.make_options ~predecessor_timestamp () in
|
||||||
|
expect_eq ~options program "main"
|
||||||
|
(e_pair (call empty_message) init_storage) (e_pair empty_op_list init_storage)
|
||||||
|
|
||||||
|
let main = test_suite "Time lock" [
|
||||||
|
test "compile" compile_main ;
|
||||||
|
test "early call" early_call ;
|
||||||
|
test "call on time" call_on_time ;
|
||||||
|
]
|
2
vendors/ligo-utils/memory-proto-alpha/dune-project
vendored
Normal file
2
vendors/ligo-utils/memory-proto-alpha/dune-project
vendored
Normal file
@ -0,0 +1,2 @@
|
|||||||
|
(lang dune 1.11)
|
||||||
|
(name tezos-memory-proto-alpha)
|
2
vendors/ligo-utils/proto-alpha-utils/dune-project
vendored
Normal file
2
vendors/ligo-utils/proto-alpha-utils/dune-project
vendored
Normal file
@ -0,0 +1,2 @@
|
|||||||
|
(lang dune 1.11)
|
||||||
|
(name proto-alpha-utils)
|
@ -11,7 +11,7 @@ let of_alpha_tz_error err = of_tz_error (AE.Ecoproto_error err)
|
|||||||
|
|
||||||
let trace_alpha_tzresult err : 'a AE.Error_monad.tzresult -> 'a result =
|
let trace_alpha_tzresult err : 'a AE.Error_monad.tzresult -> 'a result =
|
||||||
function
|
function
|
||||||
| Result.Ok x -> ok x
|
| Ok x -> ok x
|
||||||
| Error errs -> fail @@ thunk @@ patch_children (List.map of_alpha_tz_error errs) (err ())
|
| Error errs -> fail @@ thunk @@ patch_children (List.map of_alpha_tz_error errs) (err ())
|
||||||
|
|
||||||
let trace_alpha_tzresult_lwt error (x:_ AE.Error_monad.tzresult Lwt.t) : _ result =
|
let trace_alpha_tzresult_lwt error (x:_ AE.Error_monad.tzresult Lwt.t) : _ result =
|
||||||
@ -19,17 +19,17 @@ let trace_alpha_tzresult_lwt error (x:_ AE.Error_monad.tzresult Lwt.t) : _ resul
|
|||||||
|
|
||||||
let trace_tzresult err =
|
let trace_tzresult err =
|
||||||
function
|
function
|
||||||
| Result.Ok x -> ok x
|
| Ok x -> ok x
|
||||||
| Error errs -> fail @@ thunk @@ patch_children (List.map of_tz_error errs) (err ())
|
| Error errs -> fail @@ thunk @@ patch_children (List.map of_tz_error errs) (err ())
|
||||||
|
|
||||||
(* TODO: should be a combination of trace_tzresult and trace_r *)
|
(* TODO: should be a combination of trace_tzresult and trace_r *)
|
||||||
let trace_tzresult_r err_thunk_may_fail =
|
let trace_tzresult_r err_thunk_may_fail =
|
||||||
function
|
function
|
||||||
| Result.Ok x -> ok x
|
| Ok x -> ok x
|
||||||
| Error errs ->
|
| Error errs ->
|
||||||
let tz_errs = List.map of_tz_error errs in
|
let tz_errs = List.map of_tz_error errs in
|
||||||
match err_thunk_may_fail () with
|
match err_thunk_may_fail () with
|
||||||
| Simple_utils.Trace.Ok (err, annotations) ->
|
| Ok (err, annotations) ->
|
||||||
ignore annotations ;
|
ignore annotations ;
|
||||||
Error (fun () -> patch_children tz_errs (err ()))
|
Error (fun () -> patch_children tz_errs (err ()))
|
||||||
| Error errors_while_generating_error ->
|
| Error errors_while_generating_error ->
|
||||||
|
@ -1066,13 +1066,16 @@ type options = {
|
|||||||
|
|
||||||
let make_options
|
let make_options
|
||||||
?(tezos_context = dummy_environment.tezos_context)
|
?(tezos_context = dummy_environment.tezos_context)
|
||||||
|
?(predecessor_timestamp = dummy_environment.tezos_context.predecessor_timestamp)
|
||||||
?(source = (List.nth dummy_environment.identities 0).implicit_contract)
|
?(source = (List.nth dummy_environment.identities 0).implicit_contract)
|
||||||
?(self = (List.nth dummy_environment.identities 0).implicit_contract)
|
?(self = (List.nth dummy_environment.identities 0).implicit_contract)
|
||||||
?(payer = (List.nth dummy_environment.identities 1).implicit_contract)
|
?(payer = (List.nth dummy_environment.identities 1).implicit_contract)
|
||||||
?(amount = Alpha_context.Tez.one)
|
?(amount = Alpha_context.Tez.one)
|
||||||
?(chain_id = Environment.Chain_id.zero)
|
?(chain_id = Environment.Chain_id.zero)
|
||||||
()
|
()
|
||||||
= {
|
=
|
||||||
|
let tezos_context = { tezos_context with predecessor_timestamp } in
|
||||||
|
{
|
||||||
tezos_context ;
|
tezos_context ;
|
||||||
source ;
|
source ;
|
||||||
self ;
|
self ;
|
||||||
|
2
vendors/ligo-utils/simple-utils/dune-project
vendored
Normal file
2
vendors/ligo-utils/simple-utils/dune-project
vendored
Normal file
@ -0,0 +1,2 @@
|
|||||||
|
(lang dune 1.11)
|
||||||
|
(name simple-utils)
|
28
vendors/ligo-utils/simple-utils/trace.ml
vendored
28
vendors/ligo-utils/simple-utils/trace.ml
vendored
@ -6,8 +6,8 @@
|
|||||||
*)
|
*)
|
||||||
|
|
||||||
module Trace_tutorial = struct
|
module Trace_tutorial = struct
|
||||||
(** The trace monad is fairly similar to the predefined option
|
(** The trace monad is fairly similar to the predefined [option]
|
||||||
type. *)
|
type. It is an instance of the predefined [result] type. *)
|
||||||
|
|
||||||
type annotation = string
|
type annotation = string
|
||||||
type error = string
|
type error = string
|
||||||
@ -23,18 +23,20 @@ module Trace_tutorial = struct
|
|||||||
list of annotations (information about past successful
|
list of annotations (information about past successful
|
||||||
computations), or it is a list of errors accumulated so far.
|
computations), or it is a list of errors accumulated so far.
|
||||||
The former case is denoted by the data constructor [Ok], and the
|
The former case is denoted by the data constructor [Ok], and the
|
||||||
second by [Errors].
|
second by [Error].
|
||||||
*)
|
*)
|
||||||
type 'a result =
|
type nonrec 'a result = ('a * annotation list, error list) result
|
||||||
Ok of 'a * annotation list
|
(*
|
||||||
| Errors of error list
|
= Ok of 'a * annotation list
|
||||||
|
| Error of error list
|
||||||
|
*)
|
||||||
|
|
||||||
(** The function [divide_trace] shows the basic use of the trace
|
(** The function [divide_trace] shows the basic use of the trace
|
||||||
monad.
|
monad.
|
||||||
*)
|
*)
|
||||||
let divide_trace a b =
|
let divide_trace a b =
|
||||||
if b = 0
|
if b = 0
|
||||||
then Errors [Printf.sprintf "division by zero: %d/%d" a b]
|
then Error [Printf.sprintf "division by zero: %d/%d" a b]
|
||||||
else Ok (a/b, [])
|
else Ok (a/b, [])
|
||||||
|
|
||||||
(** The function [divide_three] shows that when composing two
|
(** The function [divide_three] shows that when composing two
|
||||||
@ -81,7 +83,7 @@ module Trace_tutorial = struct
|
|||||||
match f x with
|
match f x with
|
||||||
Ok (x', annot') -> Ok (x', annot' @ annot)
|
Ok (x', annot') -> Ok (x', annot' @ annot)
|
||||||
| errors -> ignore annot; errors)
|
| errors -> ignore annot; errors)
|
||||||
| Errors _ as e -> e
|
| Error _ as e -> e
|
||||||
|
|
||||||
(** The function [divide_three_bind] is equivalent to the verbose
|
(** The function [divide_three_bind] is equivalent to the verbose
|
||||||
[divide_three] above, but makes use of [bind].
|
[divide_three] above, but makes use of [bind].
|
||||||
@ -169,7 +171,7 @@ module Trace_tutorial = struct
|
|||||||
{li If the list only contains [Ok] values, it strips the [Ok]
|
{li If the list only contains [Ok] values, it strips the [Ok]
|
||||||
of each element and returns that list wrapped with [Ok].}
|
of each element and returns that list wrapped with [Ok].}
|
||||||
{li Otherwise, one or more of the elements of the input list
|
{li Otherwise, one or more of the elements of the input list
|
||||||
is [Errors], then [bind_list] returns the first error in the
|
is [Error], then [bind_list] returns the first error in the
|
||||||
list.}}
|
list.}}
|
||||||
*)
|
*)
|
||||||
let rec bind_list = function
|
let rec bind_list = function
|
||||||
@ -199,7 +201,7 @@ module Trace_tutorial = struct
|
|||||||
And this will pass along the error triggered by [get key map].
|
And this will pass along the error triggered by [get key map].
|
||||||
*)
|
*)
|
||||||
let trace err = function
|
let trace err = function
|
||||||
Errors e -> Errors (err::e)
|
Error e -> Error (err::e)
|
||||||
| ok -> ok
|
| ok -> ok
|
||||||
|
|
||||||
(** The real trace monad is very similar to the one that we have
|
(** The real trace monad is very similar to the one that we have
|
||||||
@ -293,9 +295,11 @@ type annotation_thunk = annotation thunk
|
|||||||
(** Types of traced elements. It might be good to rename it [trace] at
|
(** Types of traced elements. It might be good to rename it [trace] at
|
||||||
some point.
|
some point.
|
||||||
*)
|
*)
|
||||||
type 'a result =
|
type nonrec 'a result = ('a * annotation_thunk list, error_thunk) result
|
||||||
Ok of 'a * annotation_thunk list
|
(*
|
||||||
|
= Ok of 'a * annotation_thunk list
|
||||||
| Error of error_thunk
|
| Error of error_thunk
|
||||||
|
*)
|
||||||
|
|
||||||
|
|
||||||
(** {1 Constructors} *)
|
(** {1 Constructors} *)
|
||||||
|
2
vendors/ligo-utils/tezos-protocol-alpha-parameters/dune-project
vendored
Normal file
2
vendors/ligo-utils/tezos-protocol-alpha-parameters/dune-project
vendored
Normal file
@ -0,0 +1,2 @@
|
|||||||
|
(lang dune 1.11)
|
||||||
|
(name tezos-protocol-005-PsBabyM1-parameters)
|
@ -30,7 +30,7 @@ module type BASIC_DATA = sig
|
|||||||
val pp: Format.formatter -> t -> unit
|
val pp: Format.formatter -> t -> unit
|
||||||
end
|
end
|
||||||
|
|
||||||
type t
|
type t = Raw_context.t
|
||||||
type context = t
|
type context = t
|
||||||
|
|
||||||
type public_key = Signature.Public_key.t
|
type public_key = Signature.Public_key.t
|
||||||
|
2
vendors/ligo-utils/tezos-protocol-alpha/dune-project
vendored
Normal file
2
vendors/ligo-utils/tezos-protocol-alpha/dune-project
vendored
Normal file
@ -0,0 +1,2 @@
|
|||||||
|
(lang dune 1.11)
|
||||||
|
(name tezos-embedded-protocol-005-PsBabyM1)
|
@ -45,7 +45,34 @@ val storage_error: storage_error -> 'a tzresult Lwt.t
|
|||||||
(** Abstract view of the context.
|
(** Abstract view of the context.
|
||||||
Includes a handle to the functional key-value database
|
Includes a handle to the functional key-value database
|
||||||
({!Context.t}) along with some in-memory values (gas, etc.). *)
|
({!Context.t}) along with some in-memory values (gas, etc.). *)
|
||||||
type t
|
module Int_set : sig
|
||||||
|
type t
|
||||||
|
end
|
||||||
|
type t = {
|
||||||
|
context: Context.t ;
|
||||||
|
constants: Constants_repr.parametric ;
|
||||||
|
first_level: Raw_level_repr.t ;
|
||||||
|
level: Level_repr.t ;
|
||||||
|
predecessor_timestamp: Time.t ;
|
||||||
|
timestamp: Time.t ;
|
||||||
|
fitness: Int64.t ;
|
||||||
|
deposits: Tez_repr.t Signature.Public_key_hash.Map.t ;
|
||||||
|
included_endorsements: int ;
|
||||||
|
allowed_endorsements:
|
||||||
|
(Signature.Public_key.t * int list * bool) Signature.Public_key_hash.Map.t ;
|
||||||
|
fees: Tez_repr.t ;
|
||||||
|
rewards: Tez_repr.t ;
|
||||||
|
block_gas: Z.t ;
|
||||||
|
operation_gas: Gas_limit_repr.t ;
|
||||||
|
internal_gas: Gas_limit_repr.internal_gas ;
|
||||||
|
storage_space_to_pay: Z.t option ;
|
||||||
|
allocated_contracts: int option ;
|
||||||
|
origination_nonce: Contract_repr.origination_nonce option ;
|
||||||
|
temporary_big_map: Z.t ;
|
||||||
|
internal_nonce: int ;
|
||||||
|
internal_nonces_used: Int_set.t ;
|
||||||
|
}
|
||||||
|
|
||||||
type context = t
|
type context = t
|
||||||
type root_context = t
|
type root_context = t
|
||||||
|
|
||||||
|
2
vendors/ligo-utils/tezos-utils/dune-project
vendored
Normal file
2
vendors/ligo-utils/tezos-utils/dune-project
vendored
Normal file
@ -0,0 +1,2 @@
|
|||||||
|
(lang dune 1.11)
|
||||||
|
(name tezos-utils)
|
2
vendors/ligo-utils/tezos-utils/michelson-parser/dune-project
vendored
Normal file
2
vendors/ligo-utils/tezos-utils/michelson-parser/dune-project
vendored
Normal file
@ -0,0 +1,2 @@
|
|||||||
|
(lang dune 1.11)
|
||||||
|
(name michelson-parser)
|
Loading…
Reference in New Issue
Block a user