diff --git a/.gitignore b/.gitignore index cf5ed1f94..fb756e969 100644 --- a/.gitignore +++ b/.gitignore @@ -1,5 +1,4 @@ /_build/ -dune-project *~ *.merlin cache/* @@ -7,4 +6,5 @@ Version.ml /_opam/ /*.pp.ligo **/.DS_Store -.vscode/ \ No newline at end of file +.vscode/ +/ligo.install diff --git a/dune-project b/dune-project new file mode 100644 index 000000000..b3ec15752 --- /dev/null +++ b/dune-project @@ -0,0 +1,3 @@ +(lang dune 1.11) +(name ligo) +(using menhir 2.0) diff --git a/src/bin/cli.ml b/src/bin/cli.ml index b0a2c9251..edc0d9b44 100644 --- a/src/bin/cli.ml +++ b/src/bin/cli.ml @@ -66,7 +66,7 @@ let amount = let open Arg in let info = 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 value @@ opt string "0" info @@ -74,7 +74,7 @@ let sender = let open Arg in let info = 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 value @@ opt (some string) None info @@ -82,10 +82,18 @@ let source = let open Arg in let info = 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 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 open Arg in let info = @@ -176,7 +184,7 @@ let compile_parameter = (Term.ret term , Term.info ~doc cmdname) 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 @@ let%bind (decl_list,state,env) = match init_file with | 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 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 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 simplified_output = Uncompile.uncompile_expression typed_exp.type_annotation value in ok @@ Format.asprintf "%a\n" Ast_simplified.PP.expression simplified_output in 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 doc = "Subcommand: interpret the expression in the context initialized by the provided source file." in (Term.ret term , Term.info ~doc cmdname) @@ -233,7 +241,7 @@ let compile_storage = (Term.ret term , Term.info ~doc cmdname) 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 @@ let%bind simplified = Compile.Of_source.compile source_file (Syntax_name syntax) 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 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 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 in 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 doc = "Subcommand: run a smart-contract with the given storage and input." in (Term.ret term , Term.info ~doc cmdname) 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 @@ 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 @@ -278,32 +286,32 @@ let run_function = 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 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 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 in 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 doc = "Subcommand: run a function with the given parameter." in (Term.ret term , Term.info ~doc cmdname) 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 @@ 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 mini_c = Compile.Of_typed.compile typed_prg 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 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 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 in 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 doc = "Subcommand: evaluate a given definition." in (Term.ret term , Term.info ~doc cmdname) diff --git a/src/bin/expect_tests/help_tests.ml b/src/bin/expect_tests/help_tests.ml index 9c8efcb6a..e804c8283 100644 --- a/src/bin/expect_tests/help_tests.ml +++ b/src/bin/expect_tests/help_tests.ml @@ -278,7 +278,7 @@ let%expect_test _ = OPTIONS --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 (absent=human-readable) @@ -293,16 +293,22 @@ let%expect_test _ = `pager', `groff' or `plain'. With `auto', the format is `pager` or `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) SYNTAX is the syntax that will be used. Currently supported syntaxes are "pascaligo" and "cameligo". By default, the syntax is guessed from the extension (.ligo and .mligo, respectively). --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 is the source the dry-run transaction will use. + SOURCE is the source the michelson interpreter transaction will + use. --version Show version information. |} ] ; @@ -330,7 +336,7 @@ let%expect_test _ = OPTIONS --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 (absent=human-readable) @@ -345,16 +351,22 @@ let%expect_test _ = `pager', `groff' or `plain'. With `auto', the format is `pager` or `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) SYNTAX is the syntax that will be used. Currently supported syntaxes are "pascaligo" and "cameligo". By default, the syntax is guessed from the extension (.ligo and .mligo, respectively). --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 is the source the dry-run transaction will use. + SOURCE is the source the michelson interpreter transaction will + use. --version Show version information. |} ] ; @@ -377,7 +389,7 @@ let%expect_test _ = OPTIONS --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 (absent=human-readable) @@ -392,16 +404,22 @@ let%expect_test _ = `pager', `groff' or `plain'. With `auto', the format is `pager` or `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) SYNTAX is the syntax that will be used. Currently supported syntaxes are "pascaligo" and "cameligo". By default, the syntax is guessed from the extension (.ligo and .mligo, respectively). --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 is the source the dry-run transaction will use. + SOURCE is the source the michelson interpreter transaction will + use. --version Show version information. |} ] ; diff --git a/src/bin/expect_tests/typer_error_tests.ml b/src/bin/expect_tests/typer_error_tests.ml index 5a407316f..6ecae91e7 100644 --- a/src/bin/expect_tests/typer_error_tests.ml +++ b/src/bin/expect_tests/typer_error_tests.ml @@ -1,11 +1,25 @@ open Cli_expect 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"} |} ] ; - 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))"} |} ] ; - (* run_ligo_bad [ "compile-contract" ; "../../test/contracts/error_typer_3.mligo" ; "foo" ] ; - * [%expect …some type error… ] ; *) + run_ligo_bad [ "compile-contract" ; "../../test/contracts/negative/error_typer_3.mligo" ; "main" ] ; + [%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]"} |} ] ; + + diff --git a/src/main/display.ml b/src/main/display.ml index da22fa883..991f7c2cc 100644 --- a/src/main/display.ml +++ b/src/main/display.ml @@ -1,4 +1,4 @@ -open! Trace +open Trace let rec error_pp ?(dev = false) out (e : error) = let open JSON_string_utils in diff --git a/src/main/run/of_michelson.ml b/src/main/run/of_michelson.ml index ae2a2ea9f..ef26bc11a 100644 --- a/src/main/run/of_michelson.ml +++ b/src/main/run/of_michelson.ml @@ -16,6 +16,7 @@ type run_failwith_res = type dry_run_options = { amount : string ; + predecessor_timestamp : string option ; sender : 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") (Contract.of_b58check 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_typed_value (value , ty)) = v in diff --git a/src/passes/1-parser/reasonligo.ml b/src/passes/1-parser/reasonligo.ml index a3b52b110..260ddae3d 100644 --- a/src/passes/1-parser/reasonligo.ml +++ b/src/passes/1-parser/reasonligo.ml @@ -5,6 +5,73 @@ module AST = Parser_cameligo.AST module ParserLog = Parser_cameligo.ParserLog module LexToken = Parser_reasonligo.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 pp_input = @@ -20,104 +87,12 @@ let parse_file (source: string) : AST.t result = generic_try (simple_error "error opening file") @@ (fun () -> open_in pp_input) in let lexbuf = Lexing.from_channel channel in - let Lexer.{read ; close ; _} = - 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 + parse (Parser.contract) lexbuf let parse_string (s:string) : AST.t result = let lexbuf = Lexing.from_string s in - let Lexer.{read ; close ; _} = - 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 + parse (Parser.contract) lexbuf let parse_expression (s:string) : AST.expr result = - let lexbuf = Lexing.from_string s in - let Lexer.{read ; close; _} = - 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 + let lexbuf = Lexing.from_string s in + parse (Parser.interactive_expr) lexbuf diff --git a/src/passes/1-parser/reasonligo/Parser.mly b/src/passes/1-parser/reasonligo/Parser.mly index 444d12212..23deaf776 100644 --- a/src/passes/1-parser/reasonligo/Parser.mly +++ b/src/passes/1-parser/reasonligo/Parser.mly @@ -424,7 +424,7 @@ fun_expr: {p.value with inside = arg_to_pattern p.value.inside} in PPar {p with value} | EUnit u -> PUnit u - | _ -> raise (SyntaxError.Error WrongFunctionArguments) + | e -> raise (SyntaxError.Error (WrongFunctionArguments e)) in let fun_args_to_pattern = function EAnnot { @@ -453,7 +453,7 @@ fun_expr: in arg_to_pattern (fst fun_args), bindings | EUnit e -> arg_to_pattern (EUnit e), [] - | _ -> raise (SyntaxError.Error WrongFunctionArguments) + | e -> raise (SyntaxError.Error (WrongFunctionArguments e)) in let binders = fun_args_to_pattern $1 in let f = {kwd_fun; diff --git a/src/passes/1-parser/shared/SyntaxError.ml b/src/passes/1-parser/reasonligo/SyntaxError.ml similarity index 50% rename from src/passes/1-parser/shared/SyntaxError.ml rename to src/passes/1-parser/reasonligo/SyntaxError.ml index a0faa0bbb..befbb27c2 100644 --- a/src/passes/1-parser/shared/SyntaxError.ml +++ b/src/passes/1-parser/reasonligo/SyntaxError.ml @@ -1,4 +1,4 @@ type error = - | WrongFunctionArguments + | WrongFunctionArguments of AST.expr exception Error of error \ No newline at end of file diff --git a/src/passes/1-parser/shared/SyntaxError.mli b/src/passes/1-parser/reasonligo/SyntaxError.mli similarity index 50% rename from src/passes/1-parser/shared/SyntaxError.mli rename to src/passes/1-parser/reasonligo/SyntaxError.mli index a0faa0bbb..befbb27c2 100644 --- a/src/passes/1-parser/shared/SyntaxError.mli +++ b/src/passes/1-parser/reasonligo/SyntaxError.mli @@ -1,4 +1,4 @@ type error = - | WrongFunctionArguments + | WrongFunctionArguments of AST.expr exception Error of error \ No newline at end of file diff --git a/src/passes/1-parser/reasonligo/dune b/src/passes/1-parser/reasonligo/dune index fefe8c10e..f26008059 100644 --- a/src/passes/1-parser/reasonligo/dune +++ b/src/passes/1-parser/reasonligo/dune @@ -8,7 +8,7 @@ (library (name parser_reasonligo) (public_name ligo.parser.reasonligo) - (modules reasonligo LexToken Parser) + (modules SyntaxError reasonligo LexToken Parser) (libraries menhirLib parser_shared diff --git a/src/passes/1-parser/reasonligo/reasonligo.ml b/src/passes/1-parser/reasonligo/reasonligo.ml index e2cd732ea..48dd4401b 100644 --- a/src/passes/1-parser/reasonligo/reasonligo.ml +++ b/src/passes/1-parser/reasonligo/reasonligo.ml @@ -3,3 +3,4 @@ module AST = Parser_cameligo.AST module Lexer = Lexer module LexToken = LexToken module ParserLog = Parser_cameligo.ParserLog +module SyntaxError = SyntaxError diff --git a/src/passes/1-parser/shared/dune b/src/passes/1-parser/shared/dune index 6756867ed..61c43fb28 100644 --- a/src/passes/1-parser/shared/dune +++ b/src/passes/1-parser/shared/dune @@ -15,8 +15,8 @@ Markup FQueue EvalOpt - Version - SyntaxError)) + Version + )) (rule diff --git a/src/passes/2-simplify/pascaligo.ml b/src/passes/2-simplify/pascaligo.ml index ae96ddc27..6aea532e0 100644 --- a/src/passes/2-simplify/pascaligo.ml +++ b/src/passes/2-simplify/pascaligo.ml @@ -1,4 +1,4 @@ -open! Trace +open Trace open Ast_simplified module Raw = Parser.Pascaligo.AST diff --git a/src/passes/4-typer-new/typer.ml b/src/passes/4-typer-new/typer.ml index 865461c58..f22dd61f9 100644 --- a/src/passes/4-typer-new/typer.ml +++ b/src/passes/4-typer-new/typer.ml @@ -54,7 +54,7 @@ module Errors = struct let match_redundant_case : type a . (a, unit) I.matching -> Location.t -> unit -> _ = fun matching loc () -> - let title = (thunk "missing case in match") in + let title = (thunk "redundant case in match") in let message () = "" in let data = [ ("variant" , fun () -> Format.asprintf "%a" I.PP.matching_type matching) ; diff --git a/src/passes/4-typer-old/typer.ml b/src/passes/4-typer-old/typer.ml index 7792edcdb..b54b7e579 100644 --- a/src/passes/4-typer-old/typer.ml +++ b/src/passes/4-typer-old/typer.ml @@ -12,13 +12,20 @@ type environment = Environment.t module Errors = struct 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 message () = "" in let data = [ ("variable" , fun () -> Format.asprintf "%a" Stage_common.PP.type_variable tv) ; (* TODO: types don't have srclocs for now. *) (* ("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 error ~data title message () @@ -54,7 +61,7 @@ module Errors = struct let match_redundant_case : type a . (a, unit) I.matching -> Location.t -> unit -> _ = fun matching loc () -> - let title = (thunk "missing case in match") in + let title = (thunk "redundant case in match") in let message () = "" in let data = [ ("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 () | Some tv' -> O.assert_type_value_eq (tv' , ae.type_annotation) in ok(ae) - - (* Sum *) | E_constructor (c, expr) -> 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 expr'.type_annotation) (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 = diff --git a/src/passes/6-transpiler/transpiler.ml b/src/passes/6-transpiler/transpiler.ml index dd967680e..916c7c88d 100644 --- a/src/passes/6-transpiler/transpiler.ml +++ b/src/passes/6-transpiler/transpiler.ml @@ -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 *) -open! Trace +open Trace open Helpers module AST = Ast_typed diff --git a/src/passes/6-transpiler/transpiler.mli b/src/passes/6-transpiler/transpiler.mli index bebd4aa94..5defe6eba 100644 --- a/src/passes/6-transpiler/transpiler.mli +++ b/src/passes/6-transpiler/transpiler.mli @@ -1,4 +1,4 @@ -open! Trace +open Trace module AST = Ast_typed module Append_tree = Tree.Append diff --git a/src/passes/7-self_mini_c/self_mini_c.ml b/src/passes/7-self_mini_c/self_mini_c.ml index cda2591a1..e025eed42 100644 --- a/src/passes/7-self_mini_c/self_mini_c.ml +++ b/src/passes/7-self_mini_c/self_mini_c.ml @@ -1,5 +1,5 @@ open Mini_c -open! Trace +open Trace (* TODO hack to specialize map_expression to identity monad *) let map_expression : diff --git a/src/passes/8-compiler/compiler_program.ml b/src/passes/8-compiler/compiler_program.ml index 1c370b50a..37c44b7f3 100644 --- a/src/passes/8-compiler/compiler_program.ml +++ b/src/passes/8-compiler/compiler_program.ml @@ -29,8 +29,8 @@ open Errors (* This does not makes sense to me *) let get_operator : constant -> type_value -> expression list -> predicate result = fun s ty lst -> match Operators.Compiler.get_operators s with - | Trace.Ok (x,_) -> ok x - | Trace.Error _ -> ( + | Ok (x,_) -> ok x + | Error _ -> ( match s with | C_NONE -> ( 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 = { expr_ty : ex_ty ; expr : michelson ; -} \ No newline at end of file +} diff --git a/src/stages/ast_typed/misc.ml b/src/stages/ast_typed/misc.ml index 4303a6f1b..ebfd7ee27 100644 --- a/src/stages/ast_typed/misc.ml +++ b/src/stages/ast_typed/misc.ml @@ -56,7 +56,7 @@ module Errors = struct let different_types name a b () = 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 = [ ("a" , fun () -> Format.asprintf "%a" PP.type_value a) ; ("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]) | _,_ -> fail @@ different_operators opa opb 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) ) | T_operator _, _ -> fail @@ different_kinds a b diff --git a/src/stages/common/PP.ml b/src/stages/common/PP.ml index 411681a2a..05d192911 100644 --- a/src/stages/common/PP.ml +++ b/src/stages/common/PP.ml @@ -188,10 +188,14 @@ let literal ppf (l:literal) = match l with | Literal_timestamp n -> fprintf ppf "+%d" n | Literal_mutez n -> fprintf ppf "%dmutez" n | 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_operation _ -> fprintf ppf "Operation(...bytes)" | Literal_key s -> fprintf ppf "key %s" s | Literal_key_hash s -> fprintf ppf "key_hash %s" s | Literal_signature s -> fprintf ppf "Signature %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 |}] diff --git a/src/stages/common/dune b/src/stages/common/dune index 35a886824..c607b6041 100644 --- a/src/stages/common/dune +++ b/src/stages/common/dune @@ -5,8 +5,9 @@ simple-utils tezos-utils ) + (inline_tests) (preprocess - (pps ppx_let) + (pps ppx_let ppx_expect) ) (flags (:standard -open Simple_utils)) ) diff --git a/src/stages/mini_c/PP.ml b/src/stages/mini_c/PP.ml index 9e6ee6049..054d88cb9 100644 --- a/src/stages/mini_c/PP.ml +++ b/src/stages/mini_c/PP.ml @@ -58,8 +58,7 @@ let rec value ppf : value -> unit = function | D_unit -> fprintf ppf "unit" | D_string s -> fprintf ppf "\"%s\"" s | D_bytes x -> - let (`Hex hex) = Hex.of_bytes x in - fprintf ppf "0x%s" hex + fprintf ppf "0x%a" Hex.pp @@ Hex.of_bytes x | D_pair (a, b) -> fprintf ppf "(%a), (%a)" value a value b | D_left a -> fprintf ppf "L(%a)" value a | 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) = 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 pp = expression' Format.std_formatter in let dummy_type = T_base Base_unit in diff --git a/src/test/contracts/error_typer_1.mligo b/src/test/contracts/error_typer_1.mligo deleted file mode 100644 index b39f46dd9..000000000 --- a/src/test/contracts/error_typer_1.mligo +++ /dev/null @@ -1,3 +0,0 @@ -type toto = int - -let foo : string = 42 + 127 diff --git a/src/test/contracts/error_typer_2.mligo b/src/test/contracts/error_typer_2.mligo deleted file mode 100644 index 77534fee2..000000000 --- a/src/test/contracts/error_typer_2.mligo +++ /dev/null @@ -1,3 +0,0 @@ -type toto = int option - -let foo : string list = Some (42 + 127) diff --git a/src/test/contracts/negative/README b/src/test/contracts/negative/README new file mode 100644 index 000000000..7e17f7aea --- /dev/null +++ b/src/test/contracts/negative/README @@ -0,0 +1 @@ +This folder contains contracts for negative tests: contracts that are expected to fail (parse error, type error and so on). diff --git a/src/test/contracts/negative/error_typer_1.mligo b/src/test/contracts/negative/error_typer_1.mligo new file mode 100644 index 000000000..5baabe8c9 --- /dev/null +++ b/src/test/contracts/negative/error_typer_1.mligo @@ -0,0 +1,6 @@ +type toto = int + +let foo : string = 42 + 127 + +let main (p:int) (storage : int) = + (([] : operation list) , p + foo) diff --git a/src/test/contracts/negative/error_typer_2.mligo b/src/test/contracts/negative/error_typer_2.mligo new file mode 100644 index 000000000..b8cf9d3cb --- /dev/null +++ b/src/test/contracts/negative/error_typer_2.mligo @@ -0,0 +1,6 @@ +type toto = int option + +let foo : string list = Some (42 + 127) + +let main (p:int) (storage : int) = + (([] : operation list) , p) diff --git a/src/test/contracts/error_typer_3.mligo b/src/test/contracts/negative/error_typer_3.mligo similarity index 100% rename from src/test/contracts/error_typer_3.mligo rename to src/test/contracts/negative/error_typer_3.mligo diff --git a/src/test/contracts/negative/error_typer_4.mligo b/src/test/contracts/negative/error_typer_4.mligo new file mode 100644 index 000000000..a09820a8b --- /dev/null +++ b/src/test/contracts/negative/error_typer_4.mligo @@ -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) diff --git a/src/test/contracts/negative/error_typer_5.mligo b/src/test/contracts/negative/error_typer_5.mligo new file mode 100644 index 000000000..942438933 --- /dev/null +++ b/src/test/contracts/negative/error_typer_5.mligo @@ -0,0 +1,4 @@ +let foo : boolean = 3 + +let main (p:int) (storage : int) = + (([] : operation list) , p + foo) diff --git a/src/test/contracts/negative/error_typer_6.mligo b/src/test/contracts/negative/error_typer_6.mligo new file mode 100644 index 000000000..d885cd036 --- /dev/null +++ b/src/test/contracts/negative/error_typer_6.mligo @@ -0,0 +1,3 @@ +let foo : (int, string) map = (Map.literal [] : (int, bool) map) +let main (p:int) (storage : int) = + (([] : operation list) , p) diff --git a/src/test/contracts/negative/error_typer_7.mligo b/src/test/contracts/negative/error_typer_7.mligo new file mode 100644 index 000000000..00243b095 --- /dev/null +++ b/src/test/contracts/negative/error_typer_7.mligo @@ -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) diff --git a/src/test/contracts/time-lock.ligo b/src/test/contracts/time-lock.ligo new file mode 100644 index 000000000..c45f40a23 --- /dev/null +++ b/src/test/contracts/time-lock.ligo @@ -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 \ No newline at end of file diff --git a/src/test/dune b/src/test/dune index 8d32a8624..24a44109f 100644 --- a/src/test/dune +++ b/src/test/dune @@ -15,7 +15,8 @@ (alias (name ligo-test) (action (run ./test.exe)) - (deps (glob_files contracts/*)) + (deps (glob_files contracts/*) + (glob_files contracts/negative/*)) ) (alias diff --git a/src/test/test.ml b/src/test/test.ml index b1cafc9cf..b63e1ad5f 100644 --- a/src/test/test.ml +++ b/src/test/test.ml @@ -13,5 +13,6 @@ let () = Multisig_tests.main ; Multisig_v2_tests.main ; Replaceable_id_tests.main ; + Time_lock_tests.main ; ] ; () diff --git a/src/test/test_helpers.ml b/src/test/test_helpers.ml index 5c3e6d771..928e828e8 100644 --- a/src/test/test_helpers.ml +++ b/src/test/test_helpers.ml @@ -1,4 +1,4 @@ -open! Trace +open Trace type test_case = unit Alcotest.test_case type test = @@ -17,7 +17,7 @@ let wrap_test name f = let wrap_test_raw f = match f () with - | Trace.Ok ((), annotations) -> ignore annotations; () + | Ok ((), annotations) -> ignore annotations; () | Error err -> Format.printf "%a\n%!" (Ligo.Display.error_pp ~dev:true) (err ()) diff --git a/src/test/time_lock_tests.ml b/src/test/time_lock_tests.ml new file mode 100644 index 000000000..83830b11f --- /dev/null +++ b/src/test/time_lock_tests.ml @@ -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 ; + ] \ No newline at end of file diff --git a/vendors/ligo-utils/memory-proto-alpha/dune-project b/vendors/ligo-utils/memory-proto-alpha/dune-project new file mode 100644 index 000000000..1cf86c9fe --- /dev/null +++ b/vendors/ligo-utils/memory-proto-alpha/dune-project @@ -0,0 +1,2 @@ +(lang dune 1.11) +(name tezos-memory-proto-alpha) diff --git a/vendors/ligo-utils/proto-alpha-utils/dune-project b/vendors/ligo-utils/proto-alpha-utils/dune-project new file mode 100644 index 000000000..45c9397fd --- /dev/null +++ b/vendors/ligo-utils/proto-alpha-utils/dune-project @@ -0,0 +1,2 @@ +(lang dune 1.11) +(name proto-alpha-utils) diff --git a/vendors/ligo-utils/proto-alpha-utils/trace.ml b/vendors/ligo-utils/proto-alpha-utils/trace.ml index 812ce0405..54bf77db3 100644 --- a/vendors/ligo-utils/proto-alpha-utils/trace.ml +++ b/vendors/ligo-utils/proto-alpha-utils/trace.ml @@ -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 = function - | Result.Ok x -> ok x + | Ok x -> ok x | 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 = @@ -19,17 +19,17 @@ let trace_alpha_tzresult_lwt error (x:_ AE.Error_monad.tzresult Lwt.t) : _ resul let trace_tzresult err = function - | Result.Ok x -> ok x + | Ok x -> ok x | Error errs -> fail @@ thunk @@ patch_children (List.map of_tz_error errs) (err ()) (* TODO: should be a combination of trace_tzresult and trace_r *) let trace_tzresult_r err_thunk_may_fail = function - | Result.Ok x -> ok x + | Ok x -> ok x | Error errs -> let tz_errs = List.map of_tz_error errs in match err_thunk_may_fail () with - | Simple_utils.Trace.Ok (err, annotations) -> + | Ok (err, annotations) -> ignore annotations ; Error (fun () -> patch_children tz_errs (err ())) | Error errors_while_generating_error -> diff --git a/vendors/ligo-utils/proto-alpha-utils/x_memory_proto_alpha.ml b/vendors/ligo-utils/proto-alpha-utils/x_memory_proto_alpha.ml index 460494379..d47b85086 100644 --- a/vendors/ligo-utils/proto-alpha-utils/x_memory_proto_alpha.ml +++ b/vendors/ligo-utils/proto-alpha-utils/x_memory_proto_alpha.ml @@ -1066,13 +1066,16 @@ type options = { let make_options ?(tezos_context = dummy_environment.tezos_context) + ?(predecessor_timestamp = dummy_environment.tezos_context.predecessor_timestamp) ?(source = (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) ?(amount = Alpha_context.Tez.one) ?(chain_id = Environment.Chain_id.zero) () - = { + = + let tezos_context = { tezos_context with predecessor_timestamp } in + { tezos_context ; source ; self ; diff --git a/vendors/ligo-utils/simple-utils/dune-project b/vendors/ligo-utils/simple-utils/dune-project new file mode 100644 index 000000000..f33d41d33 --- /dev/null +++ b/vendors/ligo-utils/simple-utils/dune-project @@ -0,0 +1,2 @@ +(lang dune 1.11) +(name simple-utils) diff --git a/vendors/ligo-utils/simple-utils/trace.ml b/vendors/ligo-utils/simple-utils/trace.ml index 7464d8fb1..dc80894d4 100644 --- a/vendors/ligo-utils/simple-utils/trace.ml +++ b/vendors/ligo-utils/simple-utils/trace.ml @@ -6,8 +6,8 @@ *) module Trace_tutorial = struct - (** The trace monad is fairly similar to the predefined option - type. *) + (** The trace monad is fairly similar to the predefined [option] + type. It is an instance of the predefined [result] type. *) type annotation = string type error = string @@ -23,18 +23,20 @@ module Trace_tutorial = struct list of annotations (information about past successful computations), or it is a list of errors accumulated so far. The former case is denoted by the data constructor [Ok], and the - second by [Errors]. + second by [Error]. *) - type 'a result = - Ok of 'a * annotation list - | Errors of error list + type nonrec 'a result = ('a * annotation list, error list) result + (* + = Ok of 'a * annotation list + | Error of error list + *) (** The function [divide_trace] shows the basic use of the trace monad. *) let divide_trace a b = 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, []) (** The function [divide_three] shows that when composing two @@ -81,7 +83,7 @@ module Trace_tutorial = struct match f x with Ok (x', annot') -> Ok (x', annot' @ annot) | errors -> ignore annot; errors) - | Errors _ as e -> e + | Error _ as e -> e (** The function [divide_three_bind] is equivalent to the verbose [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] of each element and returns that list wrapped with [Ok].} {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.}} *) 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]. *) let trace err = function - Errors e -> Errors (err::e) + Error e -> Error (err::e) | ok -> ok (** 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 some point. *) -type 'a result = - Ok of 'a * annotation_thunk list +type nonrec 'a result = ('a * annotation_thunk list, error_thunk) result +(* += Ok of 'a * annotation_thunk list | Error of error_thunk +*) (** {1 Constructors} *) diff --git a/vendors/ligo-utils/tezos-protocol-alpha-parameters/dune-project b/vendors/ligo-utils/tezos-protocol-alpha-parameters/dune-project new file mode 100644 index 000000000..6910ef322 --- /dev/null +++ b/vendors/ligo-utils/tezos-protocol-alpha-parameters/dune-project @@ -0,0 +1,2 @@ +(lang dune 1.11) +(name tezos-protocol-005-PsBabyM1-parameters) diff --git a/vendors/ligo-utils/tezos-protocol-alpha/alpha_context.mli b/vendors/ligo-utils/tezos-protocol-alpha/alpha_context.mli index b970ad110..73dcb59ea 100644 --- a/vendors/ligo-utils/tezos-protocol-alpha/alpha_context.mli +++ b/vendors/ligo-utils/tezos-protocol-alpha/alpha_context.mli @@ -30,7 +30,7 @@ module type BASIC_DATA = sig val pp: Format.formatter -> t -> unit end -type t +type t = Raw_context.t type context = t type public_key = Signature.Public_key.t diff --git a/vendors/ligo-utils/tezos-protocol-alpha/dune-project b/vendors/ligo-utils/tezos-protocol-alpha/dune-project new file mode 100644 index 000000000..d4d600dc7 --- /dev/null +++ b/vendors/ligo-utils/tezos-protocol-alpha/dune-project @@ -0,0 +1,2 @@ +(lang dune 1.11) +(name tezos-embedded-protocol-005-PsBabyM1) diff --git a/vendors/ligo-utils/tezos-protocol-alpha/raw_context.mli b/vendors/ligo-utils/tezos-protocol-alpha/raw_context.mli index 86cc62187..749878b6c 100644 --- a/vendors/ligo-utils/tezos-protocol-alpha/raw_context.mli +++ b/vendors/ligo-utils/tezos-protocol-alpha/raw_context.mli @@ -45,7 +45,34 @@ val storage_error: storage_error -> 'a tzresult Lwt.t (** Abstract view of the context. Includes a handle to the functional key-value database ({!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 root_context = t diff --git a/vendors/ligo-utils/tezos-utils/dune-project b/vendors/ligo-utils/tezos-utils/dune-project new file mode 100644 index 000000000..d08be9590 --- /dev/null +++ b/vendors/ligo-utils/tezos-utils/dune-project @@ -0,0 +1,2 @@ +(lang dune 1.11) +(name tezos-utils) diff --git a/vendors/ligo-utils/tezos-utils/michelson-parser/dune-project b/vendors/ligo-utils/tezos-utils/michelson-parser/dune-project new file mode 100644 index 000000000..9b32caac7 --- /dev/null +++ b/vendors/ligo-utils/tezos-utils/michelson-parser/dune-project @@ -0,0 +1,2 @@ +(lang dune 1.11) +(name michelson-parser)