diff --git a/gitlab-pages/docs/advanced/entrypoints-contracts.md b/gitlab-pages/docs/advanced/entrypoints-contracts.md index eeb4fc0ae..51942c01b 100644 --- a/gitlab-pages/docs/advanced/entrypoints-contracts.md +++ b/gitlab-pages/docs/advanced/entrypoints-contracts.md @@ -50,8 +50,7 @@ let main (parameter, store: parameter * store) : operation list * store = ```reasonligo group=a type parameter = unit; type store = unit; -let main = (parameter_store: (parameter, store)) : (list(operation), store) => { - let parameter, store = parameter_store; +let main = ((parameter, store): (parameter, store)) : (list(operation), store) => { (([]: list(operation)), store); }; ``` @@ -93,7 +92,7 @@ let main (p, s: unit * unit) : operation list * unit = ```reasonligo group=b -let main = (p_s: (unit, unit)) : (list(operation), unit) => { +let main = ((p,s): (unit, unit)) : (list(operation), unit) => { if (amount > 0mutez) { (failwith("This contract does not accept tez"): (list(operation), unit)); } @@ -131,7 +130,7 @@ let main (p,s: unit * unit) : operation list * unit = ```reasonligo group=c let owner: address = ("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx": address); -let main = (p_s: (unit, unit)) : (list(operation), unit) => { +let main = ((p,s): (unit, unit)) : (list(operation), unit) => { if (source != owner) { (failwith("This address can't call the contract"): (list(operation), unit)); } @@ -230,10 +229,10 @@ type action = let dest: address = ("KT19wgxcuXG9VH4Af5Tpm1vqEKdaMFpznXT3": address); -let proxy = (param_s: (action, unit)): (list(operation), unit) => +let proxy = ((param, s): (action, unit)): (list(operation), unit) => let counter: contract(action) = Operation.get_contract(dest); - let op: operation = Operation.transaction(param_s[0], 0mutez, counter); - ([op], param_s[1]); + let op: operation = Operation.transaction(param, 0mutez, counter); + ([op], s); ``` diff --git a/gitlab-pages/docs/intro/what-and-why.md b/gitlab-pages/docs/intro/what-and-why.md index 4cddae9a7..fdd1d2887 100644 --- a/gitlab-pages/docs/intro/what-and-why.md +++ b/gitlab-pages/docs/intro/what-and-why.md @@ -107,8 +107,7 @@ type action = | Decrement(int) | Reset(unit); -let main = (p_s: (action, int)) : (list(operation), int) => { - let p, s = p_s; +let main = ((p,s): (action, int)) : (list(operation), int) => { let result = switch (p) { | Increment(n) => s + n diff --git a/gitlab-pages/docs/language-basics/functions.md b/gitlab-pages/docs/language-basics/functions.md index 6b5739205..5cf99f761 100644 --- a/gitlab-pages/docs/language-basics/functions.md +++ b/gitlab-pages/docs/language-basics/functions.md @@ -74,7 +74,7 @@ Currying is however *not* the preferred way to pass function arguments in CameLI While this approach is faithful to the original OCaml, it's costlier in Michelson than naive function execution accepting multiple arguments. Instead for most functions with more than one parameter we should place the arguments in a -[tuple](language-basics/sets-lists-touples.md) and pass the tuple in as a single +[tuple](language-basics/sets-lists-tuples.md) and pass the tuple in as a single parameter. Here's how you define a basic function that accepts two `ints` and returns an `int` as well: @@ -99,7 +99,7 @@ along with a return type. Here's how you define a basic function that accepts two `ints` and returns an `int` as well: ```reasonligo group=b -let add = (a: int, b: int) : int => a + b; +let add = ((a,b): (int, int)) : int => a + b; ``` The function body is a series of expressions, which are evaluated to give the return diff --git a/gitlab-pages/docs/language-basics/maps-records.md b/gitlab-pages/docs/language-basics/maps-records.md index 10b452c13..5f51de96c 100644 --- a/gitlab-pages/docs/language-basics/maps-records.md +++ b/gitlab-pages/docs/language-basics/maps-records.md @@ -182,14 +182,14 @@ function iter_op (const m : moveset) : unit is ```cameligo let iter_op (m : moveset) : unit = - let assert_eq = fun (i: address * move) -> assert (i.1.0 > 1) + let assert_eq = fun (i,j: address * move) -> assert (j.0 > 1) in Map.iter assert_eq m ``` ```reasonligo let iter_op = (m: moveset): unit => { - let assert_eq = (i: (address, move)) => assert(i[1][0] > 1); + let assert_eq = ((i,j): (address, move)) => assert(j[0] > 1); Map.iter(assert_eq, m); }; ``` @@ -209,14 +209,14 @@ function map_op (const m : moveset) : moveset is ```cameligo let map_op (m : moveset) : moveset = - let increment = fun (i: address * move) -> (i.1.0, i.1.1 + 1) + let increment = fun (i,j: address * move) -> (j.0, j.1 + 1) in Map.map increment m ``` ```reasonligo let map_op = (m: moveset): moveset => { - let increment = (i: (address, move)) => (i[1][0], i[1][1] + 1); + let increment = ((i,j): (address, move)) => (j[0], j[1] + 1); Map.map(increment, m); }; ``` @@ -243,14 +243,14 @@ function fold_op (const m : moveset) : int is ```cameligo let fold_op (m : moveset) : moveset = - let aggregate = fun (i: int * (address * (int * int))) -> i.0 + i.1.1.1 in + let aggregate = fun (i,j: int * (address * (int * int))) -> i + j.1.1 in Map.fold aggregate m 5 ``` ```reasonligo let fold_op = (m: moveset): moveset => { - let aggregate = (i: (int, (address, (int,int)))) => i[0] + i[1][1][1]; + let aggregate = ((i,j): (int, (address, (int,int)))) => i + j[1][1]; Map.fold(aggregate, m, 5); }; diff --git a/gitlab-pages/docs/language-basics/sets-lists-touples.md b/gitlab-pages/docs/language-basics/sets-lists-tuples.md similarity index 98% rename from gitlab-pages/docs/language-basics/sets-lists-touples.md rename to gitlab-pages/docs/language-basics/sets-lists-tuples.md index 321470da7..f423caf7d 100644 --- a/gitlab-pages/docs/language-basics/sets-lists-touples.md +++ b/gitlab-pages/docs/language-basics/sets-lists-tuples.md @@ -1,5 +1,5 @@ --- -id: sets-lists-touples +id: sets-lists-tuples title: Sets, Lists, Tuples --- @@ -257,7 +257,7 @@ let sum_of_a_list: int = List.fold sum my_list 0 ```reasonligo group=b -let sum = (result_i: (int, int)): int => result_i[0] + result_i[1]; +let sum = ((result, i): (int, int)): int => result + i; (* Outputs 6 *) let sum_of_a_list: int = List.fold(sum, my_list, 0); ``` diff --git a/gitlab-pages/docs/language-basics/tezos-specific.md b/gitlab-pages/docs/language-basics/tezos-specific.md new file mode 100644 index 000000000..5c9e0b1a6 --- /dev/null +++ b/gitlab-pages/docs/language-basics/tezos-specific.md @@ -0,0 +1,144 @@ +--- +id: tezos-specific +title: Tezos Domain-Specific Operations +--- + +LIGO is a language for writing Tezos smart contracts. It would be a little odd if +it didn't have any Tezos specific functions. This page will tell you about them. + +## Pack and Unpack + +Michelson provides the `PACK` and `UNPACK` instructions for data serialization. +`PACK` converts Michelson data structures to a binary format, and `UNPACK` +reverses it. This functionality can be accessed from within LIGO. + +> ⚠️ `PACK` and `UNPACK` are features of Michelson that are intended to be used by people that really know what they're doing. There are several failure cases (such as `UNPACK`ing a lambda from an untrusted source), most of which are beyond the scope of this document. Don't use these functions without doing your homework first. + + + + +```pascaligo +function id_string (const p : string) : option(string) is block { + const packed : bytes = bytes_pack(p) ; +} with (bytes_unpack(packed): option(string)) +``` + + +```cameligo +let id_string (p: string) : string option = + let packed: bytes = Bytes.pack p in + ((Bytes.unpack packed): string option) +``` + + +```reasonligo +let id_string = (p: string) : option(string) => { + let packed : bytes = Bytes.pack(p); + ((Bytes.unpack(packed)): option(string)); +}; +``` + + + +## Hashing Keys + +It's often desirable to hash a public key. In Michelson, certain data structures +such as maps will not allow the use of the `key` type. Even if this weren't the case +hashes are much smaller than keys, and storage on blockchains comes at a cost premium. +You can hash keys with the `key_hash` type and associated built in function. + + + + +```pascaligo +function check_hash_key (const kh1 : key_hash; const k2 : key) : bool * key_hash is block { + var ret : bool := False ; + var kh2 : key_hash := crypto_hash_key(k2) ; + if kh1 = kh2 then ret := True else skip; +} with (ret, kh2) +``` + + +```cameligo +let check_hash_key (kh1, k2: key_hash * key) : bool * key_hash = + let kh2 : key_hash = Crypto.hash_key k2 in + if kh1 = kh2 + then (true, kh2) + else (false, kh2) +``` + + +```reasonligo +let check_hash_key = ((kh1, k2): (key_hash, key)) : (bool, key_hash) => { + let kh2 : key_hash = Crypto.hash_key(k2); + if (kh1 == kh2) { + (true, kh2); + } + else { + (false, kh2); + } +}; +``` + + + +## Checking Signatures + +Sometimes a contract will want to check that a message has been signed by a +particular key. For example, a point-of-sale system might want a customer to +sign a transaction so it can be processed asynchronously. You can do this in LIGO +using the `key` and `signature` types. + +> ⚠️ There is no way to *generate* a signed message in LIGO. This is because that would require storing a private key on chain, at which point it isn't very private anymore. + + + + +```pascaligo +function check_signature + (const pk: key; + const signed: signature; + const msg: bytes) : bool + is crypto_check(pk, signed, msg) +``` + + +```cameligo +let check_signature (pk, signed, msg: key * signature * bytes) : bool = + Crypto.check pk signed msg +``` + + +```reasonligo +let check_signature = ((pk, signed, msg): (key, signature, bytes)) : bool => { + Crypto.check(pk, signed, msg); +}; +``` + + + +## Getting The Contract's Own Address + +Often you want to get the address of the contract being executed. You can do it with +`self_address`. + +> ⚠️ Due to limitations in Michelson, self_address in a contract is only allowed at the entry-point level. Using it in a utility function will cause an error. + + + + +```pascaligo +const current_addr : address = self_address; +``` + + +```cameligo +let current_addr : address = Current.self_address +``` + + +```reasonligo +let current_addr : address = Current.self_address; +``` + + diff --git a/gitlab-pages/docs/language-basics/variables-and-constants.md b/gitlab-pages/docs/language-basics/variables-and-constants.md index dadf5d84d..372f30180 100644 --- a/gitlab-pages/docs/language-basics/variables-and-constants.md +++ b/gitlab-pages/docs/language-basics/variables-and-constants.md @@ -108,7 +108,7 @@ with a new value being bound in place of the old one. ```reasonligo -let add = (a: int, b: int): int => { +let add = ((a,b): (int, int)): int => { let c: int = a + b; c; }; diff --git a/gitlab-pages/website/core/CodeExamples.js b/gitlab-pages/website/core/CodeExamples.js index 0b636c356..4ace23b4e 100644 --- a/gitlab-pages/website/core/CodeExamples.js +++ b/gitlab-pages/website/core/CodeExamples.js @@ -24,51 +24,48 @@ ${pre}`; const CAMELIGO_EXAMPLE = `${pre}ocaml type storage = int -(* variant defining pseudo multi-entrypoint - actions *) +(* variant defining pseudo multi-entrypoint actions *) + type action = - | Increment of int - | Decrement of int +| Increment of int +| Decrement of int -let add (a: int) (b: int): int = a + b +let add (a,b: int * int) : int = a + b +let sub (a,b: int * int) : int = a - b -let subtract (a: int) (b: int): int = a - b +(* real entrypoint that re-routes the flow based on the action provided *) -(* real entrypoint that re-routes the flow - based on the action provided *) -let%entry main(p : action) storage = - let storage = - match p with - | Increment n -> add storage n - | Decrement n -> subtract storage n - in (([] : operation list), storage) +let main (p,s: action * storage) = + let storage = + match p with + | Increment n -> add (s, n) + | Decrement n -> sub (s, n) + in ([] : operation list), storage ${pre}`; const REASONLIGO_EXAMPLE = `${pre}reasonligo type storage = int; -/* variant defining pseudo multi-entrypoint - actions */ +/* variant defining pseudo multi-entrypoint actions */ + type action = | Increment(int) | Decrement(int); -let add = (a: int, b: int): int => a + b; +let add = ((a,b): (int, int)): int => a + b; +let sub = ((a,b): (int, int)): int => a - b; -let subtract = (a: int, b: int): int => a - b; +/* real entrypoint that re-routes the flow based on the action provided */ -/* real entrypoint that re-routes the flow - based on the action provided */ -let main = (p: action, storage) => { +let main = ((p,storage): (action, storage)) => { let storage = switch (p) { - | Increment(n) => add(storage, n) - | Decrement(n) => subtract(storage, n) + | Increment(n) => add((storage, n)) + | Decrement(n) => sub((storage, n)) }; ([]: list(operation), storage); }; - ${pre}`; diff --git a/gitlab-pages/website/sidebars.json b/gitlab-pages/website/sidebars.json index 00fe28d25..717fa03ec 100644 --- a/gitlab-pages/website/sidebars.json +++ b/gitlab-pages/website/sidebars.json @@ -11,7 +11,8 @@ "language-basics/loops", "language-basics/unit-option-pattern-matching", "language-basics/maps-records", - "language-basics/sets-lists-touples" + "language-basics/sets-lists-tuples", + "language-basics/tezos-specific" ], "Advanced": [ "advanced/timestamps-addresses", diff --git a/src/bin/cli.ml b/src/bin/cli.ml index d8be0d864..edb571cd0 100644 --- a/src/bin/cli.ml +++ b/src/bin/cli.ml @@ -138,6 +138,57 @@ let compile_file = let doc = "Subcommand: compile a contract." in (Term.ret term , Term.info ~doc cmdname) +let print_cst = + let f source_file syntax display_format = ( + toplevel ~display_format @@ + let%bind pp = Compile.Of_source.pretty_print source_file (Syntax_name syntax) in + ok @@ Format.asprintf "%s \n" (Buffer.contents pp) + ) + in + let term = Term.(const f $ source_file 0 $ syntax $ display_format) in + let cmdname = "print-cst" in + let doc = "Subcommand: print the cst. Warning: intended for development of LIGO and can break at any time." in + (Term.ret term, Term.info ~doc cmdname) + +let print_ast = + let f source_file syntax display_format = ( + toplevel ~display_format @@ + let%bind simplified = Compile.Of_source.compile source_file (Syntax_name syntax) in + ok @@ Format.asprintf "%a\n" Compile.Of_simplified.pretty_print simplified + ) + in + let term = Term.(const f $ source_file 0 $ syntax $ display_format) in + let cmdname = "print-ast" in + let doc = "Subcommand: print the ast. Warning: intended for development of LIGO and can break at any time." in + (Term.ret term, Term.info ~doc cmdname) + +let print_typed_ast = + let f source_file syntax display_format = ( + toplevel ~display_format @@ + let%bind simplified = Compile.Of_source.compile source_file (Syntax_name syntax) in + let%bind typed,_ = Compile.Of_simplified.compile simplified in + ok @@ Format.asprintf "%a\n" Compile.Of_typed.pretty_print typed + ) + in + let term = Term.(const f $ source_file 0 $ syntax $ display_format) in + let cmdname = "print-typed-ast" in + let doc = "Subcommand: print the typed ast. Warning: intended for development of LIGO and can break at any time." in + (Term.ret term, Term.info ~doc cmdname) + +let print_mini_c = + let f source_file syntax display_format = ( + toplevel ~display_format @@ + let%bind simplified = Compile.Of_source.compile source_file (Syntax_name syntax) in + let%bind typed,_ = Compile.Of_simplified.compile simplified in + let%bind mini_c = Compile.Of_typed.compile typed in + ok @@ Format.asprintf "%a\n" Compile.Of_mini_c.pretty_print mini_c + ) + in + let term = Term.(const f $ source_file 0 $ syntax $ display_format) in + let cmdname = "print-mini-c" in + let doc = "Subcommand: print mini c. Warning: intended for development of LIGO and can break at any time." in + (Term.ret term, Term.info ~doc cmdname) + let measure_contract = let f source_file entry_point syntax display_format = toplevel ~display_format @@ @@ -371,4 +422,8 @@ let run ?argv () = run_function ; evaluate_value ; dump_changelog ; + print_cst ; + print_ast ; + print_typed_ast ; + print_mini_c ] diff --git a/src/bin/expect_tests/contract_tests.ml b/src/bin/expect_tests/contract_tests.ml index cc22a7410..443102d80 100644 --- a/src/bin/expect_tests/contract_tests.ml +++ b/src/bin/expect_tests/contract_tests.ml @@ -2,6 +2,8 @@ open Cli_expect let contract basename = "../../test/contracts/" ^ basename +let bad_contract basename = + "../../test/contracts/negative/" ^ basename let%expect_test _ = run_ligo_good [ "measure-contract" ; contract "coase.ligo" ; "main" ] ; @@ -1024,3 +1026,15 @@ let%expect_test _ = [%expect {| failwith("This contract always fails") |}] +let%expect_test _ = + run_ligo_bad [ "compile-contract" ; bad_contract "self_in_lambda.mligo" ; "main" ] ; + [%expect {| + ligo: Wrong SELF_ADDRESS location: SELF_ADDRESS is only allowed at top-level + + If you're not sure how to fix this error, you can + do one of the following: + + * Visit our documentation: https://ligolang.org/docs/intro/what-and-why/ + * Ask a question on our Discord: https://discord.gg/9rhYaEt + * Open a gitlab issue: https://gitlab.com/ligolang/ligo/issues/new + * Check the changelog by running 'ligo changelog' |}] \ No newline at end of file diff --git a/src/bin/expect_tests/help_tests.ml b/src/bin/expect_tests/help_tests.ml index b42ac2c8b..b385abd14 100644 --- a/src/bin/expect_tests/help_tests.ml +++ b/src/bin/expect_tests/help_tests.ml @@ -47,6 +47,22 @@ let%expect_test _ = measure-contract Subcommand: measure a contract's compiled size in bytes. + print-ast + Subcommand: print the ast. Warning: intended for development of + LIGO and can break at any time. + + print-cst + Subcommand: print the cst. Warning: intended for development of + LIGO and can break at any time. + + print-mini-c + Subcommand: print mini c. Warning: intended for development of + LIGO and can break at any time. + + print-typed-ast + Subcommand: print the typed ast. Warning: intended for development + of LIGO and can break at any time. + run-function Subcommand: run a function with the given parameter. @@ -104,6 +120,22 @@ let%expect_test _ = measure-contract Subcommand: measure a contract's compiled size in bytes. + print-ast + Subcommand: print the ast. Warning: intended for development of + LIGO and can break at any time. + + print-cst + Subcommand: print the cst. Warning: intended for development of + LIGO and can break at any time. + + print-mini-c + Subcommand: print mini c. Warning: intended for development of + LIGO and can break at any time. + + print-typed-ast + Subcommand: print the typed ast. Warning: intended for development + of LIGO and can break at any time. + run-function Subcommand: run a function with the given parameter. diff --git a/src/bin/expect_tests/lexer_tests.ml b/src/bin/expect_tests/lexer_tests.ml index 1e016fe78..99c75f077 100644 --- a/src/bin/expect_tests/lexer_tests.ml +++ b/src/bin/expect_tests/lexer_tests.ml @@ -99,9 +99,9 @@ ligo: lexer error: Negative byte sequence. run_ligo_bad [ "compile-contract" ; "../../test/lexer/reserved_name.ligo" ; "main" ] ; [%expect {| -ligo: lexer error: Reserved name: args. +ligo: lexer error: Reserved name: arguments. Hint: Change the name. - {"parser_loc":"in file \"reserved_name.ligo\", line 1, characters 4-8"} + {"parser_loc":"in file \"reserved_name.ligo\", line 1, characters 4-13"} If you're not sure how to fix this error, you can diff --git a/src/main/compile/helpers.ml b/src/main/compile/helpers.ml index 479b4cd33..b7daab8fe 100644 --- a/src/main/compile/helpers.ml +++ b/src/main/compile/helpers.ml @@ -133,3 +133,41 @@ let parsify_string = fun (syntax : v_syntax) source_filename -> let%bind parsified = parsify source_filename in let%bind applied = Self_ast_simplified.all_program parsified in ok applied + +let pretty_print_pascaligo = fun source -> + let%bind ast = Parser.Pascaligo.parse_file source in + let buffer = Buffer.create 59 in + let state = Parser_pascaligo.ParserLog.mk_state + ~offsets:true + ~mode:`Byte + ~buffer in + Parser_pascaligo.ParserLog.pp_ast state ast; + ok buffer + +let pretty_print_cameligo = fun source -> + let%bind ast = Parser.Cameligo.parse_file source in + let buffer = Buffer.create 59 in + let state = Parser_cameligo.ParserLog.mk_state + ~offsets:true + ~mode:`Byte + ~buffer in + Parser.Cameligo.ParserLog.pp_ast state ast; + ok buffer + +let pretty_print_reasonligo = fun source -> + let%bind ast = Parser.Reasonligo.parse_file source in + let buffer = Buffer.create 59 in + let state = Parser.Reasonligo.ParserLog.mk_state + ~offsets:true + ~mode:`Byte + ~buffer in + Parser.Reasonligo.ParserLog.pp_ast state ast; + ok buffer + +let pretty_print = fun syntax source_filename -> + let%bind v_syntax = syntax_to_variant syntax (Some source_filename) in + (match v_syntax with + | Pascaligo -> pretty_print_pascaligo + | Cameligo -> pretty_print_cameligo + | ReasonLIGO -> pretty_print_reasonligo) + source_filename diff --git a/src/main/compile/of_michelson.ml b/src/main/compile/of_michelson.ml index 0b070fb79..87cfbb5a7 100644 --- a/src/main/compile/of_michelson.ml +++ b/src/main/compile/of_michelson.ml @@ -5,10 +5,9 @@ open Trace module Errors = struct (* TODO: those errors should have been caught in the earlier stages on the ligo pipeline - Here, in case of contract not typechecking, we should write a warning with a "please report" - on stderr and print the ill-typed michelson code; + build_contract is a kind of security net *) - let title_type_check_msg () = "Invalid contract (This might be a compiler bug, please report) " + let title_type_check_msg () = "generated Michelson contract failed to typecheck" let bad_parameter c () = let message () = let code = Format.asprintf "%a" Michelson.pp c in @@ -22,7 +21,7 @@ module Errors = struct let bad_contract c () = let message () = let code = Format.asprintf "%a" Michelson.pp c in - "bad contract type (contract entry point is expected to be of the form \"parameter * storage -> list(operation) * storage\"):\n"^code in + "bad contract type\n"^code in error title_type_check_msg message let unknown () = let message () = diff --git a/src/main/compile/of_mini_c.ml b/src/main/compile/of_mini_c.ml index 46dce71a4..8b95d9a2d 100644 --- a/src/main/compile/of_mini_c.ml +++ b/src/main/compile/of_mini_c.ml @@ -3,6 +3,7 @@ open Proto_alpha_utils open Trace let compile_contract : expression -> Compiler.compiled_expression result = fun e -> + let%bind e = Self_mini_c.contract_check e in let%bind (input_ty , _) = get_t_function e.type_value in let%bind body = get_function e in let%bind body = Compiler.Program.translate_function_body body [] input_ty in @@ -30,3 +31,6 @@ let aggregate_and_compile_contract = fun (program : Types.program) name -> let aggregate_and_compile_expression = fun program exp -> aggregate_and_compile program (ExpressionForm exp) + +let pretty_print program = + Mini_c.PP.program program \ No newline at end of file diff --git a/src/main/compile/of_simplified.ml b/src/main/compile/of_simplified.ml index 3e98e7658..3fdb1e629 100644 --- a/src/main/compile/of_simplified.ml +++ b/src/main/compile/of_simplified.ml @@ -19,3 +19,6 @@ let apply (entry_point : string) (param : Ast_simplified.expression) : Ast_simpl { expression = Ast_simplified.E_application (entry_point_var, param) ; location = Virtual "generated application" } in ok applied + +let pretty_print formatter (program : Ast_simplified.program) = + Ast_simplified.PP.program formatter program \ No newline at end of file diff --git a/src/main/compile/of_source.ml b/src/main/compile/of_source.ml index 0c43d7d45..3a075ac9e 100644 --- a/src/main/compile/of_source.ml +++ b/src/main/compile/of_source.ml @@ -18,3 +18,6 @@ let compile_contract_input : string -> string -> v_syntax -> Ast_simplified.expr fun storage parameter syntax -> let%bind (storage,parameter) = bind_map_pair (compile_expression syntax) (storage,parameter) in ok @@ Ast_simplified.e_pair storage parameter + +let pretty_print source_filename syntax = + Helpers.pretty_print syntax source_filename \ No newline at end of file diff --git a/src/main/compile/of_typed.ml b/src/main/compile/of_typed.ml index 832db4989..c1b2930ef 100644 --- a/src/main/compile/of_typed.ml +++ b/src/main/compile/of_typed.ml @@ -22,3 +22,6 @@ let assert_equal_contract_type : check_type -> string -> Ast_typed.program -> As | _ -> dummy_fail ) | _ -> dummy_fail ) + +let pretty_print ppf program = + Ast_typed.PP.program ppf program diff --git a/src/passes/1-parser/cameligo.ml b/src/passes/1-parser/cameligo.ml index 53ecdc29e..d69da91b4 100644 --- a/src/passes/1-parser/cameligo.ml +++ b/src/passes/1-parser/cameligo.ml @@ -6,7 +6,7 @@ module ParserLog = Parser_cameligo.ParserLog module LexToken = Parser_cameligo.LexToken module Lexer = Lexer.Make(LexToken) -module Errors = struct +module Errors = struct let lexer_error (e: Lexer.error AST.reg) = let title () = "lexer error" in @@ -18,62 +18,62 @@ module Errors = struct ] in error ~data title message - let parser_error source (start: Lexing.position) (end_: Lexing.position) lexbuf = + let parser_error source (start: Lexing.position) (stop: Lexing.position) lexbuf = let title () = "parser error" in - let file = if source = "" then - "" - else + let file = if source = "" then + "" + else Format.sprintf "In file \"%s|%s\"" start.pos_fname source in let str = Format.sprintf "Parse error at \"%s\" from (%d, %d) to (%d, %d). %s\n" (Lexing.lexeme lexbuf) start.pos_lnum (start.pos_cnum - start.pos_bol) - end_.pos_lnum (end_.pos_cnum - end_.pos_bol) + stop.pos_lnum (stop.pos_cnum - stop.pos_bol) file in let message () = str in let loc = if start.pos_cnum = -1 then Region.make - ~start: Pos.min - ~stop:(Pos.from_byte end_) + ~start:(Pos.min ~file:source) + ~stop:(Pos.from_byte stop) else Region.make ~start:(Pos.from_byte start) - ~stop:(Pos.from_byte end_) - in + ~stop:(Pos.from_byte stop) + in let data = [ ("parser_loc", fun () -> Format.asprintf "%a" Location.pp_lift @@ loc ) - ] + ] in error ~data title message - - let unrecognized_error source (start: Lexing.position) (end_: Lexing.position) lexbuf = + + let unrecognized_error source (start: Lexing.position) (stop: Lexing.position) lexbuf = let title () = "unrecognized error" in - let file = if source = "" then - "" - else + let file = if source = "" then + "" + else Format.sprintf "In file \"%s|%s\"" start.pos_fname source in let str = Format.sprintf "Parse error at \"%s\" from (%d, %d) to (%d, %d). %s\n" (Lexing.lexeme lexbuf) start.pos_lnum (start.pos_cnum - start.pos_bol) - end_.pos_lnum (end_.pos_cnum - end_.pos_bol) + stop.pos_lnum (stop.pos_cnum - stop.pos_bol) file in let message () = str in - let loc = Region.make - ~start:(Pos.from_byte start) - ~stop:(Pos.from_byte end_) + let loc = Region.make + ~start:(Pos.from_byte start) + ~stop:(Pos.from_byte stop) in let data = [ - ("unrecognized_loc", + ("unrecognized_loc", fun () -> Format.asprintf "%a" Location.pp_lift @@ loc - ) + ) ] in error ~data title message @@ -83,23 +83,23 @@ open Errors type 'a parser = (Lexing.lexbuf -> LexToken.token) -> Lexing.lexbuf -> 'a -let parse (parser: 'a parser) source lexbuf = +let parse (parser: 'a parser) source lexbuf = let Lexer.{read ; close ; _} = Lexer.open_token_stream None in - let result = + let result = try ok (parser read lexbuf) with | Parser.Error -> let start = Lexing.lexeme_start_p lexbuf in - let end_ = Lexing.lexeme_end_p lexbuf in - fail @@ (parser_error source start end_ lexbuf) + let stop = Lexing.lexeme_end_p lexbuf in + fail @@ (parser_error source start stop lexbuf) | Lexer.Error e -> fail @@ (lexer_error e) | _ -> let _ = Printexc.print_backtrace Pervasives.stdout in let start = Lexing.lexeme_start_p lexbuf in - let end_ = Lexing.lexeme_end_p lexbuf in - fail @@ (unrecognized_error source start end_ lexbuf) + let stop = Lexing.lexeme_end_p lexbuf in + fail @@ (unrecognized_error source start stop lexbuf) in close (); result @@ -122,8 +122,8 @@ let parse_file (source: string) : AST.t result = let parse_string (s:string) : AST.t result = let lexbuf = Lexing.from_string s in - parse (Parser.contract) "" lexbuf + parse Parser.contract "" lexbuf let parse_expression (s:string) : AST.expr result = - let lexbuf = Lexing.from_string s in - parse (Parser.interactive_expr) "" lexbuf \ No newline at end of file + let lexbuf = Lexing.from_string s in + parse Parser.interactive_expr "" lexbuf diff --git a/src/passes/1-parser/cameligo/.unlexer.tag b/src/passes/1-parser/cameligo/.Unlexer.tag similarity index 100% rename from src/passes/1-parser/cameligo/.unlexer.tag rename to src/passes/1-parser/cameligo/.Unlexer.tag diff --git a/src/passes/1-parser/cameligo/.links b/src/passes/1-parser/cameligo/.links index a29429a42..6f2bb3b81 100644 --- a/src/passes/1-parser/cameligo/.links +++ b/src/passes/1-parser/cameligo/.links @@ -1,5 +1,4 @@ $HOME/git/OCaml-build/Makefile -$HOME/git/OCaml-build/Makefile.cfg $HOME/git/ligo/vendors/ligo-utils/simple-utils/pos.mli $HOME/git/ligo/vendors/ligo-utils/simple-utils/pos.ml $HOME/git/ligo/vendors/ligo-utils/simple-utils/region.mli diff --git a/src/passes/1-parser/cameligo/AST.ml b/src/passes/1-parser/cameligo/AST.ml index 0f36deb0d..d00cf9cd7 100644 --- a/src/passes/1-parser/cameligo/AST.ml +++ b/src/passes/1-parser/cameligo/AST.ml @@ -21,15 +21,6 @@ open Utils type 'a reg = 'a Region.reg -let rec last to_region = function - [] -> Region.ghost -| [x] -> to_region x -| _::t -> last to_region t - -let nsepseq_to_region to_region (hd,tl) = - let reg (_, item) = to_region item in - Region.cover (to_region hd) (last reg tl) - (* Keywords of OCaml *) type keyword = Region.t @@ -140,7 +131,7 @@ type t = { and ast = t -and attributes = attribute list +and attributes = attribute list and declaration = Let of (kwd_let * let_binding * attributes) reg @@ -321,6 +312,7 @@ and comp_expr = | Neq of neq bin_op reg and record = field_assign reg ne_injection + and projection = { struct_name : variable; selector : dot; @@ -344,6 +336,7 @@ and update = { updates : record reg; rbrace : rbrace; } + and path = Name of variable | Path of projection reg @@ -387,7 +380,16 @@ and cond_expr = { ifnot : expr } -(* Projecting regions of the input source code *) +(* Projecting regions from some nodes of the AST *) + +let rec last to_region = function + [] -> Region.ghost +| [x] -> to_region x +| _::t -> last to_region t + +let nsepseq_to_region to_region (hd,tl) = + let reg (_, item) = to_region item in + Region.cover (to_region hd) (last reg tl) let type_expr_to_region = function TProd {region; _} diff --git a/src/passes/1-parser/cameligo/LexToken.mli b/src/passes/1-parser/cameligo/LexToken.mli index b71398b62..3e3460bc2 100644 --- a/src/passes/1-parser/cameligo/LexToken.mli +++ b/src/passes/1-parser/cameligo/LexToken.mli @@ -85,7 +85,7 @@ type t = | Mutez of (string * Z.t) Region.reg | String of string Region.reg | Bytes of (string * Hex.t) Region.reg -| Attr2 of string Region.reg +| Attr of string Region.reg (* Keywords *) @@ -150,8 +150,7 @@ val mk_kwd : lexeme -> Region.t -> (token, kwd_err) result val mk_string : lexeme -> Region.t -> token val mk_bytes : lexeme -> Region.t -> token val mk_constr : lexeme -> Region.t -> token -val mk_attr : lexeme -> Region.t -> (token, attr_err) result -val mk_attr2 : lexeme -> Region.t -> (token, attr_err) result +val mk_attr : string -> lexeme -> Region.t -> (token, attr_err) result val eof : Region.t -> token (* Predicates *) diff --git a/src/passes/1-parser/cameligo/LexToken.mll b/src/passes/1-parser/cameligo/LexToken.mll index f0bd0d319..d16388591 100644 --- a/src/passes/1-parser/cameligo/LexToken.mll +++ b/src/passes/1-parser/cameligo/LexToken.mll @@ -69,7 +69,7 @@ type t = | Mutez of (string * Z.t) Region.reg | String of string Region.reg | Bytes of (string * Hex.t) Region.reg -| Attr2 of string Region.reg +| Attr of string Region.reg (* Keywords *) @@ -147,6 +147,8 @@ let proj_token = function region, sprintf "Bytes (\"%s\", \"0x%s\")" s (Hex.show b) +| Attr Region.{region; value} -> + region, sprintf "Attr \"%s\"" value | Begin region -> region, "Begin" | Else region -> region, "Else" | End region -> region, "End" @@ -166,7 +168,6 @@ let proj_token = function | With region -> region, "With" | C_None region -> region, "C_None" | C_Some region -> region, "C_Some" -| Attr2 Region.{region; value} -> region, sprintf "Attr2 %s" value | EOF region -> region, "EOF" let to_lexeme = function @@ -205,6 +206,7 @@ let to_lexeme = function | Mutez i -> fst i.Region.value | String s -> String.escaped s.Region.value | Bytes b -> fst b.Region.value +| Attr a -> a.Region.value | Begin _ -> "begin" | Else _ -> "else" @@ -226,7 +228,7 @@ let to_lexeme = function | C_None _ -> "None" | C_Some _ -> "Some" -| Attr2 a -> a.Region.value + | EOF _ -> "" let to_string token ?(offsets=true) mode = @@ -469,11 +471,10 @@ let mk_constr lexeme region = (* Attributes *) -let mk_attr _lexeme _region = - Error Invalid_attribute - -let mk_attr2 lexeme region = - Ok (Attr2 { value = lexeme; region }) +let mk_attr header lexeme region = + if header = "[@" then + Error Invalid_attribute + else Ok (Attr Region.{value=lexeme; region}) (* Predicates *) diff --git a/src/passes/1-parser/cameligo/Makefile.cfg b/src/passes/1-parser/cameligo/Makefile.cfg new file mode 100644 index 000000000..2f2a6b197 --- /dev/null +++ b/src/passes/1-parser/cameligo/Makefile.cfg @@ -0,0 +1,5 @@ +SHELL := dash +BFLAGS := -strict-sequence -w +A-48-4 -g + +clean:: +> rm -f Parser.msg Parser.msg.map Parser.msg.states Version.ml diff --git a/src/passes/1-parser/cameligo/ParErr.ml b/src/passes/1-parser/cameligo/ParErr.ml index 7debe48ef..f1be602f1 100644 --- a/src/passes/1-parser/cameligo/ParErr.ml +++ b/src/passes/1-parser/cameligo/ParErr.ml @@ -46,7 +46,7 @@ let message = "\n" | 33 -> "\n" - | 460 -> + | 478 -> "\n" | 27 -> "\n" @@ -68,9 +68,13 @@ let message = "\n" | 133 -> "\n" - | 373 -> + | 379 -> "\n" - | 375 -> + | 381 -> + "\n" + | 472 -> + "\n" + | 169 -> "\n" | 134 -> "\n" @@ -80,7 +84,7 @@ let message = "\n" | 153 -> "\n" - | 374 -> + | 380 -> "\n" | 63 -> "\n" @@ -144,137 +148,141 @@ let message = "\n" | 156 -> "\n" - | 463 -> + | 481 -> "\n" - | 465 -> - "\n" - | 217 -> - "\n" - | 242 -> - "\n" - | 219 -> + | 483 -> "\n" | 221 -> "\n" - | 215 -> + | 246 -> "\n" - | 226 -> + | 223 -> "\n" - | 255 -> + | 225 -> "\n" - | 256 -> + | 219 -> "\n" - | 243 -> + | 230 -> "\n" - | 264 -> + | 259 -> "\n" - | 228 -> + | 260 -> "\n" - | 257 -> - "\n" - | 258 -> - "\n" - | 266 -> + | 247 -> "\n" | 268 -> "\n" + | 232 -> + "\n" + | 261 -> + "\n" + | 262 -> + "\n" | 270 -> "\n" | 272 -> "\n" | 274 -> "\n" - | 192 -> + | 276 -> "\n" - | 259 -> + | 278 -> "\n" - | 285 -> + | 195 -> "\n" - | 288 -> + | 263 -> "\n" - | 245 -> + | 289 -> "\n" - | 293 -> + | 292 -> "\n" - | 262 -> + | 249 -> + "\n" + | 297 -> + "\n" + | 266 -> "\n" | 160 -> "\n" | 164 -> "\n" - | 429 -> + | 445 -> "\n" - | 332 -> - "\n" - | 313 -> - "\n" - | 431 -> - "\n" - | 315 -> - "\n" - | 316 -> + | 337 -> "\n" | 317 -> "\n" - | 432 -> + | 447 -> "\n" - | 445 -> + | 319 -> "\n" - | 446 -> + | 320 -> "\n" - | 433 -> + | 321 -> "\n" - | 434 -> + | 448 -> "\n" - | 435 -> + | 462 -> "\n" - | 436 -> + | 463 -> "\n" - | 437 -> + | 449 -> "\n" - | 438 -> + | 450 -> "\n" - | 440 -> + | 452 -> "\n" - | 328 -> + | 451 -> "\n" - | 330 -> + | 453 -> + "\n" + | 454 -> + "\n" + | 455 -> + "\n" + | 457 -> + "\n" + | 333 -> + "\n" + | 335 -> + "\n" + | 339 -> + "\n" + | 336 -> "\n" | 334 -> "\n" - | 331 -> - "\n" - | 329 -> - "\n" - | 340 -> - "\n" - | 341 -> - "\n" - | 342 -> - "\n" - | 343 -> - "\n" - | 344 -> - "\n" | 345 -> "\n" - | 367 -> - "\n" | 346 -> "\n" | 348 -> "\n" - | 441 -> + | 347 -> "\n" - | 443 -> + | 349 -> "\n" - | 447 -> + | 350 -> "\n" - | 430 -> + | 351 -> "\n" - | 312 -> + | 373 -> "\n" - | 428 -> + | 352 -> + "\n" + | 354 -> + "\n" + | 458 -> + "\n" + | 460 -> + "\n" + | 464 -> + "\n" + | 446 -> + "\n" + | 316 -> + "\n" + | 444 -> "\n" | 165 -> "\n" @@ -282,65 +290,71 @@ let message = "\n" | 168 -> "\n" - | 169 -> + | 172 -> + "\n" + | 171 -> "\n" | 163 -> "\n" - | 448 -> + | 465 -> "\n" - | 450 -> + | 467 -> "\n" - | 451 -> + | 468 -> "\n" | 166 -> "\n" - | 235 -> - "\n" - | 236 -> - "\n" | 239 -> "\n" | 240 -> "\n" - | 425 -> + | 243 -> "\n" - | 170 -> + | 244 -> "\n" - | 171 -> + | 441 -> "\n" - | 172 -> + | 173 -> "\n" - | 418 -> + | 428 -> "\n" - | 419 -> + | 429 -> + "\n" + | 174 -> + "\n" + | 175 -> + "\n" + | 434 -> + "\n" + | 435 -> + "\n" + | 438 -> + "\n" + | 439 -> + "\n" + | 427 -> + "\n" + | 421 -> "\n" | 422 -> "\n" | 423 -> "\n" - | 174 -> - "\n" - | 304 -> - "\n" - | 305 -> - "\n" - | 405 -> - "\n" - | 412 -> - "\n" - | 404 -> - "\n" - | 306 -> + | 177 -> "\n" | 308 -> "\n" - | 320 -> + | 309 -> "\n" - | 321 -> + | 412 -> "\n" - | 322 -> + | 419 -> "\n" - | 323 -> + | 411 -> + "\n" + | 310 -> + "\n" + | 312 -> "\n" | 324 -> "\n" @@ -350,67 +364,79 @@ let message = "\n" | 327 -> "\n" - | 378 -> + | 329 -> "\n" - | 379 -> + | 328 -> "\n" - | 381 -> + | 330 -> "\n" - | 335 -> + | 331 -> "\n" - | 310 -> + | 332 -> "\n" - | 307 -> + | 384 -> "\n" - | 395 -> + | 385 -> "\n" - | 396 -> + | 387 -> "\n" - | 397 -> + | 340 -> "\n" - | 398 -> + | 314 -> "\n" - | 399 -> - "\n" - | 400 -> - "\n" - | 408 -> + | 311 -> "\n" | 401 -> "\n" + | 402 -> + "\n" + | 404 -> + "\n" | 403 -> "\n" - | 175 -> + | 405 -> "\n" - | 176 -> + | 406 -> + "\n" + | 407 -> + "\n" + | 415 -> + "\n" + | 408 -> + "\n" + | 410 -> + "\n" + | 178 -> "\n" | 179 -> "\n" - | 180 -> + | 182 -> "\n" | 183 -> "\n" - | 302 -> + | 186 -> "\n" - | 300 -> + | 306 -> "\n" - | 185 -> - "\n" - | 187 -> + | 304 -> "\n" | 188 -> "\n" - | 189 -> - "\n" | 190 -> "\n" - | 195 -> + | 191 -> + "\n" + | 192 -> + "\n" + | 193 -> + "\n" + | 198 -> + "\n" + | 218 -> + "\n" + | 197 -> "\n" | 214 -> "\n" - | 194 -> - "\n" - | 210 -> - "\n" | _ -> raise Not_found diff --git a/src/passes/1-parser/cameligo/ParToken.mly b/src/passes/1-parser/cameligo/ParToken.mly index 0368fad57..8319d166e 100644 --- a/src/passes/1-parser/cameligo/ParToken.mly +++ b/src/passes/1-parser/cameligo/ParToken.mly @@ -12,7 +12,7 @@ %token <(string * Z.t) Region.reg> Mutez "" %token Ident "" %token Constr "" -%token Attr2 "" +%token Attr "" (* Symbols *) diff --git a/src/passes/1-parser/cameligo/Parser.mly b/src/passes/1-parser/cameligo/Parser.mly index 107acb8e0..e6cc6f903 100644 --- a/src/passes/1-parser/cameligo/Parser.mly +++ b/src/passes/1-parser/cameligo/Parser.mly @@ -119,6 +119,7 @@ declaration: type_decl: "type" type_name "=" type_expr { + Scoping.check_reserved_name $2; let region = cover $1 (type_expr_to_region $4) in let value = { kwd_type = $1; @@ -128,23 +129,23 @@ type_decl: in {region; value} } type_expr: - cartesian | sum_type | record_type { $1 } - -cartesian: - fun_type { $1 } -| fun_type "*" nsepseq(fun_type,"*") { - let value = Utils.nsepseq_cons $1 $2 $3 in - let region = nsepseq_to_region type_expr_to_region value - in TProd {region; value} } + fun_type | sum_type | record_type { $1 } fun_type: - core_type { $1 } -| core_type "->" fun_type { + cartesian { $1 } +| cartesian "->" fun_type { let start = type_expr_to_region $1 and stop = type_expr_to_region $3 in let region = cover start stop in TFun {region; value=$1,$2,$3} } +cartesian: + core_type { $1 } +| core_type "*" nsepseq(core_type,"*") { + let value = Utils.nsepseq_cons $1 $2 $3 in + let region = nsepseq_to_region type_expr_to_region value + in TProd {region; value} } + core_type: type_name { TVar $1 } | par(type_expr) { TPar $1 } @@ -175,6 +176,7 @@ type_tuple: sum_type: ioption("|") nsepseq(variant,"|") { + Scoping.check_variants (Utils.nsepseq_to_list $2); let region = nsepseq_to_region (fun x -> x.region) $2 in TSum {region; value=$2} } @@ -188,6 +190,8 @@ variant: record_type: "{" sep_or_term_list(field_decl,";") "}" { let ne_elements, terminator = $2 in + let () = Utils.nsepseq_to_list ne_elements + |> Scoping.check_fields in let region = cover $1 $3 and value = {compound = Braces ($1,$3); ne_elements; terminator} in TRecord {region; value} } @@ -202,10 +206,10 @@ field_decl: (* Top-level non-recursive definitions *) let_declaration: - "let" let_binding seq(Attr2) { + "let" let_binding seq(Attr) { let kwd_let = $1 in let attributes = $3 in - let binding = $2 in + let binding = $2 in let value = kwd_let, binding, attributes in let stop = expr_to_region binding.let_rhs in let region = cover $1 stop @@ -214,9 +218,11 @@ let_declaration: let_binding: "" nseq(sub_irrefutable) type_annotation? "=" expr { let binders = Utils.nseq_cons (PVar $1) $2 in + Utils.nseq_iter Scoping.check_pattern binders; {binders; lhs_type=$3; eq=$4; let_rhs=$5} } | irrefutable type_annotation? "=" expr { + Scoping.check_pattern $1; {binders=$1,[]; lhs_type=$2; eq=$3; let_rhs=$4} } type_annotation: @@ -441,13 +447,15 @@ cases(right_expr): in fst_case, ($2,snd_case)::others } case_clause(right_expr): - pattern "->" right_expr { {pattern=$1; arrow=$2; rhs=$3} } + pattern "->" right_expr { + Scoping.check_pattern $1; + {pattern=$1; arrow=$2; rhs=$3} } let_expr(right_expr): - "let" let_binding seq(Attr2) "in" right_expr { - let kwd_let = $1 + "let" let_binding seq(Attr) "in" right_expr { + let kwd_let = $1 and binding = $2 - and attributes = $3 + and attributes = $3 and kwd_in = $4 and body = $5 in let stop = expr_to_region body in @@ -626,9 +634,9 @@ update_record: lbrace = $1; record = $2; kwd_with = $3; - updates = { value = {compound = Braces($1,$5); - ne_elements; - terminator}; + updates = {value = {compound = Braces($1,$5); + ne_elements; + terminator}; region = cover $3 $5}; rbrace = $5} in {region; value} } @@ -656,5 +664,5 @@ sequence: in {region; value} } path : - "" {Name $1} -| projection { Path $1} + "" { Name $1 } +| projection { Path $1 } diff --git a/src/passes/1-parser/cameligo/ParserLog.ml b/src/passes/1-parser/cameligo/ParserLog.ml index 0ee1bd3e6..e0b7fd09b 100644 --- a/src/passes/1-parser/cameligo/ParserLog.ml +++ b/src/passes/1-parser/cameligo/ParserLog.ml @@ -128,15 +128,15 @@ let rec print_tokens state {decl;eof} = Utils.nseq_iter (print_statement state) decl; print_token state eof "EOF" -and print_attributes state attributes = +and print_attributes state attributes = List.iter ( - fun ({value = attribute; region}) -> - let attribute_formatted = sprintf "[@%s]" attribute in + fun ({value = attribute; region}) -> + let attribute_formatted = sprintf "[@@%s]" attribute in print_token state region attribute_formatted ) attributes and print_statement state = function - Let {value=kwd_let, let_binding, attributes; _} -> + Let {value=kwd_let, let_binding, attributes; _} -> print_token state kwd_let "let"; print_let_binding state let_binding; print_attributes state attributes @@ -538,7 +538,7 @@ and print_case_clause state {value; _} = print_expr state rhs and print_let_in state {value; _} = - let {kwd_let; binding; kwd_in; body; attributes} = value in + let {kwd_let; binding; kwd_in; body; attributes} = value in print_token state kwd_let "let"; print_let_binding state binding; print_attributes state attributes; @@ -610,31 +610,41 @@ let rec pp_ast state {decl; _} = List.iteri (List.length decls |> apply) decls and pp_declaration state = function - Let {value = (_, let_binding, _); region} -> + Let {value = (_, let_binding, attr); region} -> pp_loc_node state "Let" region; - pp_let_binding state let_binding + pp_let_binding state let_binding attr; | TypeDecl {value; region} -> pp_loc_node state "TypeDecl" region; pp_type_decl state value -and pp_let_binding state node = +and pp_let_binding state node attr = let {binders; lhs_type; let_rhs; _} = node in let fields = if lhs_type = None then 2 else 3 in - let () = + let fields = if attr = [] then fields else fields+1 in + let arity = let state = state#pad fields 0 in pp_node state ""; - pp_binders state binders in - let () = + pp_binders state binders; 0 in + let arity = match lhs_type with - None -> () + None -> arity | Some (_, type_expr) -> - let state = state#pad fields 1 in + let state = state#pad fields (arity+1) in pp_node state ""; - pp_type_expr (state#pad 1 0) type_expr in - let () = - let state = state#pad fields (fields - 1) in + pp_type_expr (state#pad 1 0) type_expr; + arity+1 in + let arity = + let state = state#pad fields (arity+1) in pp_node state ""; - pp_expr (state#pad 1 0) let_rhs + pp_expr (state#pad 1 0) let_rhs; + arity+1 in + let () = + if attr <> [] then + let state = state#pad fields (arity+1) in + pp_node state ""; + let length = List.length attr in + let apply len rank = pp_ident (state#pad len rank) + in List.iteri (apply length) attr in () and pp_type_decl state decl = @@ -838,28 +848,39 @@ and pp_fun_expr state node = in () and pp_let_in state node = - let {binding; body; _} = node in + let {binding; body; attributes; _} = node in let {binders; lhs_type; let_rhs; _} = binding in let fields = if lhs_type = None then 3 else 4 in - let () = + let fields = if attributes = [] then fields else fields+1 in + let arity = let state = state#pad fields 0 in pp_node state ""; - pp_binders state binders in - let () = + pp_binders state binders; 0 in + let arity = match lhs_type with - None -> () + None -> arity | Some (_, type_expr) -> - let state = state#pad fields 1 in + let state = state#pad fields (arity+1) in pp_node state ""; - pp_type_expr (state#pad 1 0) type_expr in - let () = - let state = state#pad fields (fields - 2) in + pp_type_expr (state#pad 1 0) type_expr; + arity+1 in + let arity = + let state = state#pad fields (arity+1) in pp_node state ""; - pp_expr (state#pad 1 0) let_rhs in - let () = - let state = state#pad fields (fields - 1) in + pp_expr (state#pad 1 0) let_rhs; + arity+1 in + let arity = + let state = state#pad fields (arity+1) in pp_node state ""; - pp_expr (state#pad 1 0) body + pp_expr (state#pad 1 0) body; + arity+1 in + let () = + if attributes <> [] then + let state = state#pad fields (arity+1) in + pp_node state ""; + let length = List.length attributes in + let apply len rank = pp_ident (state#pad len rank) + in List.iteri (apply length) attributes in () and pp_tuple_expr state {value; _} = diff --git a/src/passes/1-parser/cameligo/ParserLog.mli b/src/passes/1-parser/cameligo/ParserLog.mli index bae31ee93..d16252478 100644 --- a/src/passes/1-parser/cameligo/ParserLog.mli +++ b/src/passes/1-parser/cameligo/ParserLog.mli @@ -25,6 +25,7 @@ val pattern_to_string : val expr_to_string : offsets:bool -> mode:[`Point|`Byte] -> AST.expr -> string -(** {1 Pretty-printing of the AST} *) +(** {1 Pretty-printing of AST nodes} *) -val pp_ast : state -> AST.t -> unit +val pp_ast : state -> AST.t -> unit +val pp_expr : state -> AST.expr -> unit diff --git a/src/passes/1-parser/cameligo/ParserMain.ml b/src/passes/1-parser/cameligo/ParserMain.ml index f1b03fd25..2880157db 100644 --- a/src/passes/1-parser/cameligo/ParserMain.ml +++ b/src/passes/1-parser/cameligo/ParserMain.ml @@ -6,22 +6,86 @@ module IO = let options = EvalOpt.read "CameLIGO" ext end -module ExtParser = +module Parser = struct - type ast = AST.t + type ast = AST.t type expr = AST.expr include Parser end -module ExtParserLog = +module ParserLog = struct - type ast = AST.t + type ast = AST.t + type expr = AST.expr include ParserLog end -module MyLexer = Lexer.Make (LexToken) +module Lexer = Lexer.Make (LexToken) module Unit = - ParserUnit.Make (IO)(MyLexer)(AST)(ExtParser)(ParErr)(ExtParserLog) + ParserUnit.Make (Lexer)(AST)(Parser)(ParErr)(ParserLog)(IO) -let () = Unit.run () +(* Main *) + +let issue_error point = + let error = Unit.format_error ~offsets:IO.options#offsets + IO.options#mode point + in Stdlib.Error error + +let parse parser : ('a,string) Stdlib.result = + try parser () with + (* Scoping errors *) + + | Scoping.Error (Scoping.Reserved_name name) -> + let token = + Lexer.Token.mk_ident name.Region.value name.Region.region in + (match token with + (* Cannot fail because [name] is a not a + reserved name for the lexer. *) + Stdlib.Error _ -> assert false + | Ok invalid -> + issue_error + ("Reserved name.\nHint: Change the name.\n", None, invalid)) + + | Scoping.Error (Scoping.Duplicate_variant name) -> + let token = + Lexer.Token.mk_constr name.Region.value name.Region.region in + let point = "Duplicate constructor in this sum type declaration.\n\ + Hint: Change the constructor.\n", + None, token + in issue_error point + + | Scoping.Error (Scoping.Non_linear_pattern var) -> + let token = + Lexer.Token.mk_ident var.Region.value var.Region.region in + (match token with + (* Cannot fail because [var] is a not a + reserved name for the lexer. *) + Stdlib.Error _ -> assert false + | Ok invalid -> + let point = "Repeated variable in this pattern.\n\ + Hint: Change the name.\n", + None, invalid + in issue_error point) + + | Scoping.Error (Scoping.Duplicate_field name) -> + let token = + Lexer.Token.mk_ident name.Region.value name.Region.region in + (match token with + (* Cannot fail because [name] is a not a + reserved name for the lexer. *) + Stdlib.Error _ -> assert false + | Ok invalid -> + let point = "Duplicate field name in this record declaration.\n\ + Hint: Change the name.\n", + None, invalid + in issue_error point) + +let () = + if IO.options#expr + then match parse (fun () -> Unit.parse Unit.parse_expr) with + Stdlib.Ok _ -> () + | Error msg -> Printf.eprintf "\027[31m%s\027[0m%!" msg + else match parse (fun () -> Unit.parse Unit.parse_contract) with + Stdlib.Ok _ -> () + | Error msg -> Printf.eprintf "\027[31m%s\027[0m%!" msg diff --git a/src/passes/1-parser/cameligo/Scoping.ml b/src/passes/1-parser/cameligo/Scoping.ml new file mode 100644 index 000000000..5f45c643b --- /dev/null +++ b/src/passes/1-parser/cameligo/Scoping.ml @@ -0,0 +1,132 @@ +[@@@warning "-42"] + + +type t = + Reserved_name of AST.variable +| Duplicate_variant of AST.variable +| Non_linear_pattern of AST.variable +| Duplicate_field of AST.variable + +type error = t + +exception Error of t + +open Region + +(* Useful modules *) + +module SSet = Utils.String.Set + +module Ord = + struct + type t = AST.variable + let compare v1 v2 = + compare v1.value v2.value + end + +module VarSet = Set.Make (Ord) + +(* Checking the definition of reserved names (shadowing) *) + +let reserved = + let open SSet in + empty + |> add "assert" + |> add "balance" + |> add "time" + |> add "amount" + |> add "gas" + |> add "sender" + |> add "source" + |> add "failwith" + |> add "continue" + |> add "stop" + |> add "int" + |> add "abs" + |> add "unit" + +let check_reserved_names vars = + let is_reserved elt = SSet.mem elt.value reserved in + let inter = VarSet.filter is_reserved vars in + if not (VarSet.is_empty inter) then + let clash = VarSet.choose inter in + raise (Error (Reserved_name clash)) + else vars + +let check_reserved_name var = + if SSet.mem var.value reserved then + raise (Error (Reserved_name var)) + +(* Checking the linearity of patterns *) + +open! AST + +let rec vars_of_pattern env = function + PConstr p -> vars_of_pconstr env p +| PUnit _ | PFalse _ | PTrue _ +| PInt _ | PNat _ | PBytes _ +| PString _ | PWild _ -> env +| PVar var -> + if VarSet.mem var env then + raise (Error (Non_linear_pattern var)) + else VarSet.add var env +| PList l -> vars_of_plist env l +| PTuple t -> Utils.nsepseq_foldl vars_of_pattern env t.value +| PPar p -> vars_of_pattern env p.value.inside +| PRecord p -> vars_of_fields env p.value.ne_elements +| PTyped p -> vars_of_pattern env p.value.pattern + +and vars_of_fields env fields = + Utils.nsepseq_foldl vars_of_field_pattern env fields + +and vars_of_field_pattern env field = + let var = field.value.field_name in + if VarSet.mem var env then + raise (Error (Non_linear_pattern var)) + else + let p = field.value.pattern + in vars_of_pattern (VarSet.add var env) p + +and vars_of_pconstr env = function + PNone _ -> env +| PSomeApp {value=_, pattern; _} -> + vars_of_pattern env pattern +| PConstrApp {value=_, Some pattern; _} -> + vars_of_pattern env pattern +| PConstrApp {value=_,None; _} -> env + +and vars_of_plist env = function + PListComp {value; _} -> + Utils.sepseq_foldl vars_of_pattern env value.elements +| PCons {value; _} -> + let head, _, tail = value in + List.fold_left vars_of_pattern env [head; tail] + +let check_linearity = vars_of_pattern VarSet.empty + +(* Checking patterns *) + +let check_pattern p = + check_linearity p |> check_reserved_names |> ignore + +(* Checking variants for duplicates *) + +let check_variants variants = + let add acc {value; _} = + if VarSet.mem value.constr acc then + raise (Error (Duplicate_variant value.constr)) + else VarSet.add value.constr acc in + let variants = + List.fold_left add VarSet.empty variants + in ignore variants + +(* Checking record fields *) + +let check_fields fields = + let add acc {value; _} = + if VarSet.mem (value: field_decl).field_name acc then + raise (Error (Duplicate_field value.field_name)) + else VarSet.add value.field_name acc in + let fields = + List.fold_left add VarSet.empty fields + in ignore fields diff --git a/src/passes/1-parser/cameligo/Scoping.mli b/src/passes/1-parser/cameligo/Scoping.mli new file mode 100644 index 000000000..61ca10f02 --- /dev/null +++ b/src/passes/1-parser/cameligo/Scoping.mli @@ -0,0 +1,16 @@ +(* This module exports checks on scoping, called from the parser. *) + +type t = + Reserved_name of AST.variable +| Duplicate_variant of AST.variable +| Non_linear_pattern of AST.variable +| Duplicate_field of AST.variable + +type error = t + +exception Error of t + +val check_reserved_name : AST.variable -> unit +val check_pattern : AST.pattern -> unit +val check_variants : AST.variant Region.reg list -> unit +val check_fields : AST.field_decl Region.reg list -> unit diff --git a/src/passes/1-parser/cameligo/unlexer.ml b/src/passes/1-parser/cameligo/Unlexer.ml similarity index 100% rename from src/passes/1-parser/cameligo/unlexer.ml rename to src/passes/1-parser/cameligo/Unlexer.ml diff --git a/src/passes/1-parser/cameligo/check_dot_git_is_dir.sh b/src/passes/1-parser/cameligo/check_dot_git_is_dir.sh deleted file mode 100755 index 7df363999..000000000 --- a/src/passes/1-parser/cameligo/check_dot_git_is_dir.sh +++ /dev/null @@ -1,10 +0,0 @@ -#!/bin/sh - -set -e - -if test -d ../../.git; then - echo true > dot_git_is_dir -else - echo false > dot_git_is_dir - cat .git >> dot_git_is_dir -fi diff --git a/src/passes/1-parser/cameligo/dune b/src/passes/1-parser/cameligo/dune index 63f695550..57806ff56 100644 --- a/src/passes/1-parser/cameligo/dune +++ b/src/passes/1-parser/cameligo/dune @@ -1,14 +1,21 @@ +;; Build of the lexer + (ocamllex LexToken) +;; Build of the parser + (menhir (merge_into Parser) (modules ParToken Parser) (flags -la 1 --table --strict --explain --external-tokens LexToken)) +;; Build of the parser as a library + (library (name parser_cameligo) (public_name ligo.parser.cameligo) - (modules AST cameligo Parser ParserLog LexToken) + (modules + Scoping AST cameligo Parser ParserLog LexToken) (libraries menhirLib parser_shared @@ -20,6 +27,18 @@ (pps bisect_ppx --conditional)) (flags (:standard -open Simple_utils -open Parser_shared))) +;; Build of the unlexer (for covering the +;; error states of the LR automaton) + +(executable + (name Unlexer) + (libraries str) + (preprocess + (pps bisect_ppx --conditional)) + (modules Unlexer)) + +;; Local build of a standalone lexer + (executable (name LexerMain) (libraries parser_cameligo) @@ -28,6 +47,8 @@ (pps bisect_ppx --conditional)) (flags (:standard -open Parser_shared -open Parser_cameligo))) +;; Local build of a standalone parser + (executable (name ParserMain) (libraries parser_cameligo) @@ -37,19 +58,16 @@ (pps bisect_ppx --conditional)) (flags (:standard -open Simple_utils -open Parser_shared -open Parser_cameligo))) -(executable - (name Unlexer) - (libraries str) - (preprocess - (pps bisect_ppx --conditional)) - (modules Unlexer)) +;; Build of the covering of error states in the LR automaton (rule (targets Parser.msg) (deps (:script_messages ../../../../vendors/ligo-utils/simple-utils/messages.sh) Parser.mly LexToken.mli ParToken.mly) - (action (run %{script_messages} --lex-tokens=LexToken.mli --par-tokens=ParToken.mly Parser.mly ))) + (action (run %{script_messages} --lex-tokens=LexToken.mli --par-tokens=ParToken.mly Parser.mly))) + +;; Build of all the LIGO source file that cover all error states (rule - (targets all.ligo) + (targets all.mligo) (deps (:script_cover ../../../../vendors/ligo-utils/simple-utils/cover.sh) Parser.mly LexToken.mli ParToken.mly Parser.msg Unlexer.exe) - (action (run %{script_cover} --lex-tokens=LexToken.mli --par-tokens=ParToken.mly --ext=ligo --unlexer=./Unlexer.exe --messages=Parser.msg --dir=. --concatenate Parser.mly ))) \ No newline at end of file + (action (run %{script_cover} --lex-tokens=LexToken.mli --par-tokens=ParToken.mly --ext=mligo --unlexer=./Unlexer.exe --messages=Parser.msg --dir=. --concatenate Parser.mly ))) \ No newline at end of file diff --git a/src/passes/1-parser/dune b/src/passes/1-parser/dune index bbf559aa0..25154ae45 100644 --- a/src/passes/1-parser/dune +++ b/src/passes/1-parser/dune @@ -2,15 +2,12 @@ (name parser) (public_name ligo.parser) (libraries - simple-utils - tezos-utils - parser_shared - parser_pascaligo - parser_cameligo - parser_reasonligo - ) + simple-utils + tezos-utils + parser_shared + parser_pascaligo + parser_cameligo + parser_reasonligo) (preprocess - (pps ppx_let bisect_ppx --conditional) - ) - (flags (:standard -w +1..62-4-9-44-40-42-48-30@39@33 -open Simple_utils -open Parser_shared)) -) + (pps ppx_let bisect_ppx --conditional)) + (flags (:standard -w +1..62-4-9-44-40-42-48-30@39@33 -open Simple_utils -open Parser_shared))) diff --git a/src/passes/1-parser/pascaligo.ml b/src/passes/1-parser/pascaligo.ml index d37600adc..59a7089d5 100644 --- a/src/passes/1-parser/pascaligo.ml +++ b/src/passes/1-parser/pascaligo.ml @@ -1,129 +1,103 @@ open Trace -module Parser = Parser_pascaligo.Parser module AST = Parser_pascaligo.AST -module ParserLog = Parser_pascaligo.ParserLog module LexToken = Parser_pascaligo.LexToken module Lexer = Lexer.Make(LexToken) -module SyntaxError = Parser_pascaligo.SyntaxError +module Scoping = Parser_pascaligo.Scoping +module Parser = Parser_pascaligo.Parser -module Errors = struct +module Errors = + struct + let reserved_name Region.{value; region} = + let title () = Printf.sprintf "reserved name \"%s\"" value in + let message () = "" in + let data = [ + ("location", + fun () -> Format.asprintf "%a" Location.pp_lift @@ region)] + in error ~data title message - let lexer_error (e: Lexer.error AST.reg) = - let title () = "lexer error" in - let message () = Lexer.error_to_string e.value in - let data = [ - ("parser_loc", - fun () -> Format.asprintf "%a" Location.pp_lift @@ e.region - ) - ] in - error ~data title message + let non_linear_pattern Region.{value; region} = + let title () = + Printf.sprintf "repeated variable \"%s\" in this pattern" value in + let message () = "" in + let data = [ + ("location", + fun () -> Format.asprintf "%a" Location.pp_lift @@ region)] + in error ~data title message - let reserved_name Region.{value; region} = - let title () = Printf.sprintf "reserved name \"%s\"" value in - let message () = "" in - let data = [ - ("location", - fun () -> Format.asprintf "%a" Location.pp_lift @@ region) - ] in - error ~data title message + let duplicate_parameter Region.{value; region} = + let title () = + Printf.sprintf "duplicate parameter \"%s\"" value in + let message () = "" in + let data = [ + ("location", + fun () -> Format.asprintf "%a" Location.pp_lift @@ region)] + in error ~data title message - let non_linear_pattern Region.{value; region} = - let title () = Printf.sprintf "repeated variable \"%s\" in this pattern" value in - let message () = "" in - let data = [ - ("location", - fun () -> Format.asprintf "%a" Location.pp_lift @@ region) - ] in - error ~data title message + let duplicate_variant Region.{value; region} = + let title () = + Printf.sprintf "duplicate variant \"%s\" in this\ + type declaration" value in + let message () = "" in + let data = [ + ("location", + fun () -> Format.asprintf "%a" Location.pp_lift @@ region)] + in error ~data title message - let duplicate_parameter Region.{value; region} = - let title () = Printf.sprintf "duplicate parameter \"%s\"" value in - let message () = "" in - let data = [ - ("location", - fun () -> Format.asprintf "%a" Location.pp_lift @@ region) - ] in - error ~data title message + let unrecognized_error source (start: Lexing.position) + (stop: Lexing.position) lexbuf = + let title () = "unrecognized error" in + let file = + if source = "" then "" + else + Format.sprintf "In file \"%s|%s\"" start.pos_fname source in + let message () = + Format.sprintf + "Parse error at \"%s\" from (%d, %d) to (%d, %d). %s\n" + (Lexing.lexeme lexbuf) + start.pos_lnum (start.pos_cnum - start.pos_bol) + stop.pos_lnum (stop.pos_cnum - stop.pos_bol) + file in + let loc = Region.make ~start:(Pos.from_byte start) + ~stop:(Pos.from_byte stop) in + let data = [ + ("unrecognized_loc", + fun () -> Format.asprintf "%a" Location.pp_lift @@ loc)] + in error ~data title message - let duplicate_variant Region.{value; region} = - let title () = Printf.sprintf "duplicate variant \"%s\" in this\ - type declaration" value in - let message () = "" in - let data = [ - ("location", - fun () -> Format.asprintf "%a" Location.pp_lift @@ region) - ] in - error ~data title message - - let detached_attributes (attrs: AST.attributes) = - let title () = "detached attributes" in - let message () = "" in - let data = [ - ("location", - fun () -> Format.asprintf "%a" Location.pp_lift @@ attrs.region) - ] in - error ~data title message - - let parser_error source (start: Lexing.position) (end_: Lexing.position) lexbuf = - let title () = "parser error" in - let file = if source = "" then - "" - else - Format.sprintf "In file \"%s|%s\"" start.pos_fname source - in - let str = Format.sprintf - "Parse error at \"%s\" from (%d, %d) to (%d, %d). %s\n" - (Lexing.lexeme lexbuf) - start.pos_lnum (start.pos_cnum - start.pos_bol) - end_.pos_lnum (end_.pos_cnum - end_.pos_bol) - file - in - let message () = str in - let loc = if start.pos_cnum = -1 then - Region.make - ~start: Pos.min - ~stop:(Pos.from_byte end_) - else - 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 source (start: Lexing.position) (end_: Lexing.position) lexbuf = - let title () = "unrecognized error" in - let file = if source = "" then - "" - else - Format.sprintf "In file \"%s|%s\"" start.pos_fname source - in - let str = Format.sprintf - "Parse error at \"%s\" from (%d, %d) to (%d, %d). %s\n" - (Lexing.lexeme lexbuf) - start.pos_lnum (start.pos_cnum - start.pos_bol) - end_.pos_lnum (end_.pos_cnum - end_.pos_bol) - file - in - let message () = str 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 + let parser_error source (start: Lexing.position) + (stop: Lexing.position) lexbuf = + let title () = "parser error" in + let file = + if source = "" then "" + else + Format.sprintf "In file \"%s|%s\"" start.pos_fname source in + let message () = + Format.sprintf + "Parse error at \"%s\" from (%d, %d) to (%d, %d). %s\n" + (Lexing.lexeme lexbuf) + start.pos_lnum (start.pos_cnum - start.pos_bol) + stop.pos_lnum (stop.pos_cnum - stop.pos_bol) + file in + let loc = + if start.pos_cnum = -1 then + Region.make + ~start:(Pos.min ~file:source) ~stop:(Pos.from_byte stop) + else + Region.make ~start:(Pos.from_byte start) + ~stop:(Pos.from_byte stop) in + let data = + [("parser_loc", + fun () -> Format.asprintf "%a" Location.pp_lift @@ loc)] in + error ~data title message + let lexer_error (e: Lexer.error AST.reg) = + let title () = "lexer error" in + let message () = Lexer.error_to_string e.value in + let data = [ + ("parser_loc", + fun () -> Format.asprintf "%a" Location.pp_lift @@ e.region)] + in error ~data title message end open Errors @@ -131,35 +105,29 @@ open Errors type 'a parser = (Lexing.lexbuf -> LexToken.token) -> Lexing.lexbuf -> 'a let parse (parser: 'a parser) source lexbuf = - let Lexer.{read ; close ; _} = Lexer.open_token_stream None in + let Lexer.{read; close; _} = Lexer.open_token_stream None in let result = - try - ok (parser read lexbuf) - with - SyntaxError.Error (Non_linear_pattern var) -> - fail @@ (non_linear_pattern var) - | SyntaxError.Error (Duplicate_parameter name) -> - fail @@ (duplicate_parameter name) - | SyntaxError.Error (Duplicate_variant name) -> - fail @@ (duplicate_variant name) - | SyntaxError.Error (Reserved_name name) -> - fail @@ (reserved_name name) - | SyntaxError.Error (Detached_attributes attrs) -> - fail @@ (detached_attributes attrs) + try ok (parser read lexbuf) with + Lexer.Error e -> + fail @@ lexer_error e | Parser.Error -> let start = Lexing.lexeme_start_p lexbuf in - let end_ = Lexing.lexeme_end_p lexbuf in - fail @@ (parser_error source start end_ lexbuf) - | Lexer.Error e -> - fail @@ (lexer_error e) + let stop = Lexing.lexeme_end_p lexbuf in + fail @@ parser_error source start stop lexbuf + | Scoping.Error (Scoping.Non_linear_pattern var) -> + fail @@ non_linear_pattern var + | Scoping.Error (Duplicate_parameter name) -> + fail @@ duplicate_parameter name + | Scoping.Error (Duplicate_variant name) -> + fail @@ duplicate_variant name + | Scoping.Error (Reserved_name name) -> + fail @@ reserved_name name | _ -> - let _ = Printexc.print_backtrace Pervasives.stdout in + let () = Printexc.print_backtrace Pervasives.stdout in let start = Lexing.lexeme_start_p lexbuf in - let end_ = Lexing.lexeme_end_p lexbuf in - fail @@ (unrecognized_error source start end_ lexbuf) - in - close (); - result + let stop = Lexing.lexeme_end_p lexbuf in + fail @@ unrecognized_error source start stop lexbuf + in close (); result let parse_file (source: string) : AST.t result = let pp_input = diff --git a/src/passes/1-parser/pascaligo.mli b/src/passes/1-parser/pascaligo.mli index e82d6ab35..13e75b7e9 100644 --- a/src/passes/1-parser/pascaligo.mli +++ b/src/passes/1-parser/pascaligo.mli @@ -1,21 +1,18 @@ -(* This file provides an interface to the PascaLIGO parser. *) +(** This file provides an interface to the PascaLIGO parser. *) -open Trace - -module Parser = Parser_pascaligo.Parser module AST = Parser_pascaligo.AST -module ParserLog = Parser_pascaligo.ParserLog -module LexToken = Parser_pascaligo.LexToken - -(** Open a PascaLIGO filename given by string and convert into an abstract syntax tree. *) -val parse_file : string -> (AST.t result) +(** Open a PascaLIGO filename given by string and convert into an + abstract syntax tree. *) +val parse_file : string -> AST.t Trace.result (** Convert a given string into a PascaLIGO abstract syntax tree *) -val parse_string : string -> AST.t result +val parse_string : string -> AST.t Trace.result -(** Parse a given string as a PascaLIGO expression and return an expression AST. +(** Parse a given string as a PascaLIGO expression and return an + expression AST. -This is intended to be used for interactive interpreters, or other scenarios -where you would want to parse a PascaLIGO expression outside of a contract. *) -val parse_expression : string -> AST.expr result + This is intended to be used for interactive interpreters, or other + scenarios where you would want to parse a PascaLIGO expression + outside of a contract. *) +val parse_expression : string -> AST.expr Trace.result diff --git a/src/passes/1-parser/pascaligo/.unlexer.tag b/src/passes/1-parser/pascaligo/.Unlexer.tag similarity index 100% rename from src/passes/1-parser/pascaligo/.unlexer.tag rename to src/passes/1-parser/pascaligo/.Unlexer.tag diff --git a/src/passes/1-parser/pascaligo/.links b/src/passes/1-parser/pascaligo/.links index a29429a42..6cc2d4c32 100644 --- a/src/passes/1-parser/pascaligo/.links +++ b/src/passes/1-parser/pascaligo/.links @@ -1,5 +1,4 @@ $HOME/git/OCaml-build/Makefile -$HOME/git/OCaml-build/Makefile.cfg $HOME/git/ligo/vendors/ligo-utils/simple-utils/pos.mli $HOME/git/ligo/vendors/ligo-utils/simple-utils/pos.ml $HOME/git/ligo/vendors/ligo-utils/simple-utils/region.mli @@ -19,5 +18,8 @@ $HOME/git/ligo/vendors/ligo-utils/simple-utils/region.ml ../shared/ParserAPI.mli ../shared/ParserAPI.ml ../shared/LexerUnit.ml +../shared/ParserUnit.mli ../shared/ParserUnit.ml +../shared/Memo.mli +../shared/Memo.ml Stubs/Simple_utils.ml diff --git a/src/passes/1-parser/pascaligo/AST.ml b/src/passes/1-parser/pascaligo/AST.ml index a855ea46e..5f95dc3e5 100644 --- a/src/passes/1-parser/pascaligo/AST.ml +++ b/src/passes/1-parser/pascaligo/AST.ml @@ -25,6 +25,7 @@ type 'a reg = 'a Region.reg type keyword = Region.t type kwd_and = Region.t +type kwd_attributes = Region.t type kwd_begin = Region.t type kwd_block = Region.t type kwd_case = Region.t @@ -109,7 +110,7 @@ type field_name = string reg type map_name = string reg type set_name = string reg type constr = string reg -type attribute = string reg +type attribute = string reg (* Parentheses *) @@ -144,12 +145,13 @@ type t = { and ast = t -and attributes = attribute list reg - and declaration = - TypeDecl of type_decl reg + TypeDecl of type_decl reg | ConstDecl of const_decl reg -| FunDecl of fun_decl reg +| FunDecl of fun_decl reg +| AttrDecl of attr_decl + +and attr_decl = string reg ne_injection reg and const_decl = { kwd_const : kwd_const; @@ -159,7 +161,7 @@ and const_decl = { equal : equal; init : expr; terminator : semi option; - attributes : attributes; + attributes : attr_decl option } (* Type declarations *) @@ -217,7 +219,7 @@ and fun_decl = { block_with : (block reg * kwd_with) option; return : expr; terminator : semi option; - attributes : attributes; + attributes : attr_decl option } and parameters = (param_decl, semi) nsepseq par reg @@ -260,11 +262,12 @@ and statements = (statement, semi) nsepseq and statement = Instr of instruction | Data of data_decl +| Attr of attr_decl and data_decl = LocalConst of const_decl reg -| LocalVar of var_decl reg -| LocalFun of fun_decl reg +| LocalVar of var_decl reg +| LocalFun of fun_decl reg and var_decl = { kwd_var : kwd_var; @@ -562,6 +565,7 @@ and field_assign = { equal : equal; field_expr : expr } + and record = field_assign reg ne_injection and projection = { diff --git a/src/passes/1-parser/pascaligo/LexToken.mli b/src/passes/1-parser/pascaligo/LexToken.mli index 598b6de4f..620be977c 100644 --- a/src/passes/1-parser/pascaligo/LexToken.mli +++ b/src/passes/1-parser/pascaligo/LexToken.mli @@ -28,6 +28,11 @@ type lexeme = string (* TOKENS *) +type attribute = { + header : string; + string : lexeme Region.reg +} + type t = (* Literals *) @@ -151,8 +156,7 @@ val mk_kwd : lexeme -> Region.t -> (token, kwd_err) result val mk_string : lexeme -> Region.t -> token val mk_bytes : lexeme -> Region.t -> token val mk_constr : lexeme -> Region.t -> token -val mk_attr : lexeme -> Region.t -> (token, attr_err) result -val mk_attr2 : lexeme -> Region.t -> (token, attr_err) result +val mk_attr : string -> lexeme -> Region.t -> (token, attr_err) result val eof : Region.t -> token (* Predicates *) diff --git a/src/passes/1-parser/pascaligo/LexToken.mll b/src/passes/1-parser/pascaligo/LexToken.mll index 5a1e47c76..542a36c1e 100644 --- a/src/passes/1-parser/pascaligo/LexToken.mll +++ b/src/passes/1-parser/pascaligo/LexToken.mll @@ -26,6 +26,11 @@ let rollback buffer = (* TOKENS *) +type attribute = { + header : string; + string : lexeme Region.reg +} + type t = (* Literals *) @@ -33,7 +38,7 @@ type t = | Bytes of (lexeme * Hex.t) Region.reg | Int of (lexeme * Z.t) Region.reg | Nat of (lexeme * Z.t) Region.reg -| Mutez of (lexeme * Z.t) Region.reg +| Mutez of (lexeme * Z.t) Region.reg | Ident of lexeme Region.reg | Constr of lexeme Region.reg @@ -144,6 +149,11 @@ let proj_token = function | Constr Region.{region; value} -> region, sprintf "Constr \"%s\"" value +(* +| Attr {header; string={region; value}} -> + region, sprintf "Attr (\"%s\",\"%s\")" header value + *) + (* Symbols *) | SEMI region -> region, "SEMI" @@ -217,7 +227,7 @@ let proj_token = function | C_None region -> region, "C_None" | C_Some region -> region, "C_Some" - + (* Virtual tokens *) | EOF region -> region, "EOF" @@ -312,6 +322,7 @@ let to_lexeme = function | EOF _ -> "" +(* CONVERSIONS *) let to_string token ?(offsets=true) mode = let region, val_str = proj_token token in @@ -365,7 +376,7 @@ let keywords = [ let reserved = let open SSet in - empty |> add "args" + empty |> add "arguments" let constructors = [ (fun reg -> False reg); @@ -489,8 +500,6 @@ let eof region = EOF region type sym_err = Invalid_symbol -type attr_err = Invalid_attribute - let mk_sym lexeme region = match lexeme with (* Lexemes in common with all concrete syntaxes *) @@ -539,10 +548,9 @@ let mk_constr lexeme region = (* Attributes *) -let mk_attr _lexeme _region = - Error Invalid_attribute +type attr_err = Invalid_attribute -let mk_attr2 _lexeme _region = +let mk_attr _header _string _region = Error Invalid_attribute (* Predicates *) diff --git a/src/passes/1-parser/pascaligo/LexerMain.ml b/src/passes/1-parser/pascaligo/LexerMain.ml index 4f1940204..042b0930a 100644 --- a/src/passes/1-parser/pascaligo/LexerMain.ml +++ b/src/passes/1-parser/pascaligo/LexerMain.ml @@ -7,3 +7,8 @@ module IO = end module M = LexerUnit.Make (IO) (Lexer.Make (LexToken)) + +let () = + match M.trace () with + Stdlib.Ok _ -> () + | Error msg -> Printf.eprintf "\027[31m%s\027[0m%!" msg diff --git a/src/passes/1-parser/pascaligo/Makefile.cfg b/src/passes/1-parser/pascaligo/Makefile.cfg new file mode 100644 index 000000000..2f2a6b197 --- /dev/null +++ b/src/passes/1-parser/pascaligo/Makefile.cfg @@ -0,0 +1,5 @@ +SHELL := dash +BFLAGS := -strict-sequence -w +A-48-4 -g + +clean:: +> rm -f Parser.msg Parser.msg.map Parser.msg.states Version.ml diff --git a/src/passes/1-parser/pascaligo/SParserMain.ml b/src/passes/1-parser/pascaligo/Misc/SParserMain.ml similarity index 100% rename from src/passes/1-parser/pascaligo/SParserMain.ml rename to src/passes/1-parser/pascaligo/Misc/SParserMain.ml diff --git a/src/passes/1-parser/pascaligo/Misc/pascaligo.ml b/src/passes/1-parser/pascaligo/Misc/pascaligo.ml new file mode 100644 index 000000000..c323496e5 --- /dev/null +++ b/src/passes/1-parser/pascaligo/Misc/pascaligo.ml @@ -0,0 +1,39 @@ + +module ParserLog = Parser_pascaligo.ParserLog +module ParErr = Parser_pascaligo.ParErr +module SSet = Utils.String.Set + +(* Mock options. TODO: Plug in cmdliner. *) + +let pre_options = + EvalOpt.make + ~libs:[] + ~verbose:SSet.empty + ~offsets:true + ~mode:`Point + ~cmd:EvalOpt.Quiet + ~mono:true (* Monolithic API of Menhir for now *) +(* ~input:None *) +(* ~expr:true *) + +module Parser = + struct + type ast = AST.t + type expr = AST.expr + include Parser_pascaligo.Parser + end + +module ParserLog = + struct + type ast = AST.t + type expr = AST.expr + include Parser_pascaligo.ParserLog + end + +module PreUnit = ParserUnit.Make (Lexer)(AST)(Parser)(ParErr)(ParserLog) +module Front = ParserAPI.Make (Lexer)(Parser)(ParErr) + +let issue_error point = + let error = Front.format_error ~offsets:true (* TODO: CLI *) + `Point (* TODO: CLI *) point + in Stdlib.Error error diff --git a/src/passes/1-parser/pascaligo/ParErr.ml b/src/passes/1-parser/pascaligo/ParErr.ml index 1e07f3913..a19b6aac2 100644 --- a/src/passes/1-parser/pascaligo/ParErr.ml +++ b/src/passes/1-parser/pascaligo/ParErr.ml @@ -58,13 +58,13 @@ let message = "\n" | 64 -> "\n" - | 517 -> + | 543 -> "\n" | 29 -> "\n" | 32 -> "\n" - | 515 -> + | 541 -> "\n" | 35 -> "\n" @@ -78,23 +78,9 @@ let message = "\n" | 67 -> "\n" - | 70 -> + | 68 -> "\n" - | 71 -> - "\n" - | 72 -> - "\n" - | 73 -> - "\n" - | 80 -> - "\n" - | 81 -> - "\n" - | 76 -> - "\n" - | 77 -> - "\n" - | 78 -> + | 84 -> "\n" | 85 -> "\n" @@ -102,241 +88,225 @@ let message = "\n" | 87 -> "\n" - | 88 -> - "\n" - | 512 -> - "\n" - | 358 -> - "\n" - | 359 -> - "\n" - | 499 -> - "\n" - | 362 -> - "\n" - | 360 -> - "\n" - | 361 -> - "\n" - | 363 -> - "\n" - | 364 -> - "\n" - | 365 -> - "\n" - | 366 -> - "\n" - | 367 -> - "\n" - | 475 -> - "\n" - | 476 -> - "\n" - | 477 -> - "\n" - | 478 -> - "\n" - | 496 -> - "\n" - | 503 -> - "\n" - | 502 -> - "\n" - | 371 -> - "\n" - | 372 -> + | 514 -> "\n" | 373 -> "\n" | 374 -> "\n" + | 507 -> + "\n" + | 377 -> + "\n" + | 375 -> + "\n" + | 376 -> + "\n" | 378 -> "\n" + | 379 -> + "\n" | 380 -> "\n" + | 381 -> + "\n" | 382 -> "\n" - | 383 -> + | 484 -> + "\n" + | 485 -> + "\n" + | 486 -> + "\n" + | 487 -> + "\n" + | 504 -> + "\n" + | 511 -> + "\n" + | 510 -> + "\n" + | 386 -> "\n" | 387 -> "\n" - | 384 -> - "\n" - | 385 -> + | 388 -> "\n" | 389 -> "\n" - | 390 -> - "\n" - | 391 -> - "\n" | 393 -> "\n" | 395 -> "\n" - | 399 -> - "\n" - | 396 -> - "\n" | 397 -> "\n" - | 375 -> + | 398 -> "\n" - | 381 -> + | 402 -> + "\n" + | 399 -> + "\n" + | 400 -> "\n" | 404 -> "\n" + | 408 -> + "\n" | 405 -> "\n" | 406 -> "\n" - | 492 -> + | 390 -> "\n" - | 493 -> - "\n" - | 494 -> - "\n" - | 407 -> - "\n" - | 488 -> - "\n" - | 408 -> - "\n" - | 452 -> - "\n" - | 447 -> - "\n" - | 453 -> - "\n" - | 409 -> - "\n" - | 410 -> - "\n" - | 416 -> - "\n" - | 420 -> - "\n" - | 421 -> - "\n" - | 411 -> - "\n" - | 424 -> - "\n" - | 425 -> - "\n" - | 426 -> + | 396 -> "\n" | 413 -> "\n" + | 414 -> + "\n" | 415 -> "\n" - | 435 -> + | 500 -> "\n" - | 436 -> + | 501 -> "\n" - | 437 -> + | 502 -> "\n" - | 440 -> + | 416 -> "\n" - | 441 -> + | 496 -> "\n" - | 469 -> + | 417 -> "\n" - | 470 -> + | 461 -> "\n" - | 473 -> + | 456 -> "\n" - | 472 -> + | 462 -> "\n" - | 438 -> + | 418 -> "\n" - | 467 -> + | 419 -> "\n" - | 439 -> - "\n" - | 69 -> - "\n" - | 428 -> + | 425 -> "\n" | 429 -> "\n" | 430 -> "\n" - | 431 -> + | 420 -> "\n" - | 432 -> + | 433 -> "\n" - | 508 -> + | 434 -> "\n" - | 521 -> + | 435 -> "\n" - | 159 -> + | 422 -> "\n" - | 523 -> + | 424 -> "\n" - | 137 -> + | 444 -> "\n" - | 150 -> + | 445 -> "\n" - | 166 -> + | 446 -> "\n" - | 167 -> + | 449 -> "\n" - | 158 -> + | 450 -> "\n" - | 173 -> + | 478 -> "\n" - | 152 -> + | 479 -> "\n" - | 168 -> + | 482 -> "\n" - | 169 -> + | 481 -> "\n" - | 175 -> + | 447 -> "\n" - | 177 -> + | 476 -> "\n" - | 179 -> + | 448 -> + "\n" + | 437 -> + "\n" + | 438 -> + "\n" + | 439 -> + "\n" + | 440 -> + "\n" + | 441 -> + "\n" + | 536 -> + "\n" + | 515 -> + "\n" + | 516 -> + "\n" + | 517 -> + "\n" + | 518 -> + "\n" + | 519 -> + "\n" + | 520 -> + "\n" + | 529 -> + "\n" + | 532 -> + "\n" + | 524 -> + "\n" + | 525 -> + "\n" + | 547 -> "\n" | 181 -> "\n" - | 183 -> + | 549 -> "\n" - | 160 -> + | 159 -> "\n" - | 170 -> + | 172 -> "\n" - | 157 -> + | 188 -> "\n" - | 163 -> + | 189 -> "\n" - | 187 -> + | 180 -> "\n" - | 92 -> + | 195 -> "\n" - | 318 -> + | 174 -> "\n" - | 319 -> + | 190 -> "\n" - | 322 -> + | 191 -> "\n" - | 323 -> + | 197 -> "\n" - | 356 -> + | 199 -> "\n" - | 351 -> + | 201 -> "\n" - | 353 -> + | 203 -> "\n" - | 93 -> + | 205 -> "\n" - | 94 -> + | 182 -> "\n" - | 338 -> + | 192 -> "\n" - | 95 -> + | 179 -> "\n" - | 96 -> + | 185 -> + "\n" + | 209 -> + "\n" + | 91 -> "\n" | 342 -> "\n" @@ -346,169 +316,231 @@ let message = "\n" | 347 -> "\n" - | 349 -> + | 371 -> "\n" - | 97 -> + | 366 -> "\n" - | 136 -> + | 368 -> + "\n" + | 92 -> + "\n" + | 93 -> + "\n" + | 362 -> + "\n" + | 94 -> + "\n" + | 95 -> + "\n" + | 144 -> + "\n" + | 145 -> + "\n" + | 148 -> + "\n" + | 149 -> + "\n" + | 364 -> + "\n" + | 96 -> + "\n" + | 158 -> + "\n" + | 100 -> + "\n" + | 217 -> + "\n" + | 218 -> + "\n" + | 220 -> + "\n" + | 221 -> + "\n" + | 224 -> + "\n" + | 225 -> + "\n" + | 358 -> + "\n" + | 353 -> + "\n" + | 355 -> "\n" | 101 -> "\n" - | 195 -> - "\n" - | 196 -> - "\n" - | 198 -> - "\n" - | 199 -> - "\n" - | 202 -> - "\n" - | 203 -> - "\n" - | 334 -> - "\n" - | 329 -> - "\n" - | 331 -> - "\n" | 102 -> "\n" + | 350 -> + "\n" + | 336 -> + "\n" + | 338 -> + "\n" | 103 -> "\n" - | 326 -> + | 332 -> "\n" - | 312 -> + | 330 -> "\n" - | 314 -> + | 333 -> "\n" - | 104 -> + | 334 -> "\n" - | 308 -> + | 328 -> "\n" - | 306 -> + | 156 -> + "\n" + | 105 -> + "\n" + | 320 -> + "\n" + | 321 -> + "\n" + | 322 -> + "\n" + | 323 -> + "\n" + | 324 -> + "\n" + | 137 -> + "\n" + | 138 -> + "\n" + | 139 -> + "\n" + | 140 -> + "\n" + | 151 -> + "\n" + | 106 -> + "\n" + | 107 -> "\n" | 309 -> "\n" | 310 -> "\n" - | 304 -> + | 154 -> "\n" - | 134 -> + | 177 -> "\n" - | 106 -> + | 312 -> "\n" - | 296 -> + | 315 -> "\n" - | 297 -> + | 316 -> "\n" - | 298 -> - "\n" - | 299 -> - "\n" - | 300 -> - "\n" - | 107 -> + | 133 -> "\n" | 108 -> "\n" - | 285 -> + | 69 -> "\n" - | 286 -> + | 70 -> "\n" - | 132 -> + | 71 -> "\n" - | 155 -> + | 72 -> + "\n" + | 79 -> + "\n" + | 80 -> + "\n" + | 75 -> + "\n" + | 76 -> + "\n" + | 77 -> + "\n" + | 109 -> + "\n" + | 110 -> + "\n" + | 111 -> + "\n" + | 112 -> + "\n" + | 114 -> + "\n" + | 117 -> + "\n" + | 230 -> + "\n" + | 231 -> + "\n" + | 269 -> + "\n" + | 293 -> + "\n" + | 270 -> + "\n" + | 272 -> + "\n" + | 273 -> + "\n" + | 294 -> + "\n" + | 300 -> + "\n" + | 299 -> + "\n" + | 303 -> + "\n" + | 302 -> + "\n" + | 240 -> + "\n" + | 283 -> + "\n" + | 284 -> + "\n" + | 287 -> "\n" | 288 -> "\n" | 291 -> "\n" - | 292 -> - "\n" - | 128 -> - "\n" - | 110 -> - "\n" - | 113 -> - "\n" - | 208 -> - "\n" - | 209 -> - "\n" - | 247 -> - "\n" - | 271 -> - "\n" - | 248 -> - "\n" - | 250 -> - "\n" - | 251 -> - "\n" - | 272 -> - "\n" - | 278 -> - "\n" | 277 -> "\n" - | 281 -> - "\n" - | 280 -> - "\n" - | 218 -> - "\n" - | 261 -> - "\n" - | 262 -> - "\n" - | 265 -> - "\n" - | 266 -> - "\n" - | 269 -> - "\n" - | 255 -> - "\n" - | 257 -> - "\n" - | 219 -> - "\n" - | 244 -> - "\n" - | 245 -> - "\n" - | 253 -> + | 279 -> "\n" | 241 -> "\n" - | 210 -> + | 266 -> + "\n" + | 267 -> "\n" | 275 -> "\n" - | 211 -> + | 263 -> "\n" - | 223 -> + | 232 -> "\n" - | 224 -> + | 297 -> "\n" - | 240 -> + | 233 -> "\n" - | 225 -> + | 245 -> "\n" - | 226 -> + | 246 -> "\n" - | 234 -> + | 262 -> "\n" - | 114 -> + | 247 -> + "\n" + | 248 -> + "\n" + | 256 -> "\n" | 118 -> "\n" - | 206 -> + | 122 -> "\n" - | 119 -> + | 228 -> "\n" - | 125 -> + | 123 -> + "\n" + | 130 -> "\n" | _ -> raise Not_found diff --git a/src/passes/1-parser/pascaligo/Parser.mly b/src/passes/1-parser/pascaligo/Parser.mly index 905e25e17..9b41ba242 100644 --- a/src/passes/1-parser/pascaligo/Parser.mly +++ b/src/passes/1-parser/pascaligo/Parser.mly @@ -6,39 +6,6 @@ open Region open AST -type statement_attributes_mixed = - PInstr of instruction -| PData of data_decl -| PAttributes of attributes - -let attributes_to_statement (statement, statements) = - if (List.length statements = 0) then - match statement with - | PInstr i -> Instr i, [] - | PData d -> Data d, [] - | PAttributes a -> - let open! SyntaxError in - raise (Error (Detached_attributes a)) - else ( - let statements = (Region.ghost, statement) :: statements in - let rec inner result = function - | (t, PData (LocalConst const)) :: (_, PAttributes a) :: rest -> - inner (result @ [(t, Data (LocalConst {const with value = {const.value with attributes = a}}))]) rest - | (t, PData (LocalFun func)) :: (_, PAttributes a) :: rest -> - inner (result @ [(t, Data (LocalFun {func with value = {func.value with attributes = a}}))]) rest - | (t, PData d) :: rest -> - inner (result @ [(t, Data d)]) rest - | (t, PInstr i) :: rest -> - inner (result @ [(t, Instr i)]) rest - | (_, PAttributes _) :: rest -> - inner result rest - | [] -> - result - in - let result = inner [] statements in - (snd (List.hd result), List.tl result) - ) - (* END HEADER *) %} @@ -143,15 +110,24 @@ contract: nseq(declaration) EOF { {decl=$1; eof=$2} } declaration: - type_decl { TypeDecl $1 } -| const_decl { ConstDecl $1 } -| fun_decl { FunDecl $1 } + type_decl { TypeDecl $1 } +| const_decl { ConstDecl $1 } +| fun_decl { FunDecl $1 } +| attr_decl { AttrDecl $1 } + +(* Attribute declarations *) + +attr_decl: + open_attr_decl ";"? { $1 } + +open_attr_decl: + ne_injection("attributes","") { $1 } (* Type declarations *) type_decl: "type" type_name "is" type_expr ";"? { - ignore (SyntaxError.check_reserved_name $2); + Scoping.check_reserved_name $2; let stop = match $5 with Some region -> region @@ -219,7 +195,7 @@ type_tuple: sum_type: "|"? nsepseq(variant,"|") { - SyntaxError.check_variants (Utils.nsepseq_to_list $2); + Scoping.check_variants (Utils.nsepseq_to_list $2); let region = nsepseq_to_region (fun x -> x.region) $2 in TSum {region; value=$2} } @@ -234,7 +210,7 @@ record_type: "record" sep_or_term_list(field_decl,";") "end" { let ne_elements, terminator = $2 in let () = Utils.nsepseq_to_list ne_elements - |> SyntaxError.check_fields in + |> Scoping.check_fields in let region = cover $1 $3 and value = {opening = Kwd $1; ne_elements; @@ -258,7 +234,7 @@ field_decl: and value = {field_name=$1; colon=$2; field_type=$3} in {region; value} } - + fun_expr: "function" parameters ":" type_expr "is" expr { let stop = expr_to_region $6 in @@ -268,76 +244,72 @@ fun_expr: colon = $3; ret_type = $4; kwd_is = $5; - return = $6 - } + return = $6} in {region; value} } (* Function declarations *) open_fun_decl: "function" fun_name parameters ":" type_expr "is" - block - "with" expr { - let fun_name = SyntaxError.check_reserved_name $2 in - let stop = expr_to_region $9 in - let region = cover $1 stop - and value = {kwd_function = $1; - fun_name; - param = $3; - colon = $4; - ret_type = $5; - kwd_is = $6; - block_with = Some ($7, $8); - return = $9; - terminator = None; - attributes = {value = []; region = Region.ghost}} - in {region; value} } + block "with" expr { + Scoping.check_reserved_name $2; + let stop = expr_to_region $9 in + let region = cover $1 stop + and value = {kwd_function = $1; + fun_name = $2; + param = $3; + colon = $4; + ret_type = $5; + kwd_is = $6; + block_with = Some ($7, $8); + return = $9; + terminator = None; + attributes = None} + in {region; value} + } | "function" fun_name parameters ":" type_expr "is" expr { - let fun_name = SyntaxError.check_reserved_name $2 in - let stop = expr_to_region $7 in - let region = cover $1 stop - and value = {kwd_function = $1; - fun_name; - param = $3; - colon = $4; - ret_type = $5; - kwd_is = $6; - block_with = None; - return = $7; - terminator = None; - attributes = {value = []; region = Region.ghost}} + Scoping.check_reserved_name $2; + let stop = expr_to_region $7 in + let region = cover $1 stop + and value = {kwd_function = $1; + fun_name = $2; + param = $3; + colon = $4; + ret_type = $5; + kwd_is = $6; + block_with = None; + return = $7; + terminator = None; + attributes = None} in {region; value} } fun_decl: - open_fun_decl semi_attributes { - let attributes, terminator = $2 in - {$1 with value = {$1.value with terminator = terminator; attributes = attributes}} - } + open_fun_decl ";"? { + {$1 with value = {$1.value with terminator=$2}} } parameters: par(nsepseq(param_decl,";")) { let params = Utils.nsepseq_to_list ($1.value: _ par).inside - in SyntaxError.check_parameters params; - $1 } + in Scoping.check_parameters params; $1 } param_decl: "var" var ":" param_type { - let var = SyntaxError.check_reserved_name $2 in + Scoping.check_reserved_name $2; let stop = type_expr_to_region $4 in let region = cover $1 stop and value = {kwd_var = $1; - var; + var = $2; colon = $3; param_type = $4} in ParamVar {region; value} } | "const" var ":" param_type { - let var = SyntaxError.check_reserved_name $2 in + Scoping.check_reserved_name $2; let stop = type_expr_to_region $4 in let region = cover $1 stop and value = {kwd_const = $1; - var; + var = $2; colon = $3; param_type = $4} in ParamConst {region; value} } @@ -349,25 +321,25 @@ block: "begin" sep_or_term_list(statement,";") "end" { let statements, terminator = $2 in let region = cover $1 $3 - and value = {opening = Begin $1; - statements = attributes_to_statement statements; + and value = {opening = Begin $1; + statements; terminator; - closing = End $3} + closing = End $3} in {region; value} } | "block" "{" sep_or_term_list(statement,";") "}" { let statements, terminator = $3 in let region = cover $1 $4 - and value = {opening = Block ($1,$2); - statements = attributes_to_statement statements; + and value = {opening = Block ($1,$2); + statements; terminator; - closing = Block $4} + closing = Block $4} in {region; value} } statement: - instruction { PInstr $1 } -| open_data_decl { PData $1 } -| attributes { PAttributes $1 } + instruction { Instr $1 } +| open_data_decl { Data $1 } +| open_attr_decl { Attr $1 } open_data_decl: open_const_decl { LocalConst $1 } @@ -385,10 +357,9 @@ open_const_decl: equal; init; terminator = None; - attributes = {value = []; region = Region.ghost}} + attributes = None} in {region; value} } - open_var_decl: "var" unqualified_decl(":=") { let name, colon, var_type, assign, init, stop = $2 in @@ -399,33 +370,18 @@ open_var_decl: var_type; assign; init; - terminator = None; - } + terminator=None} in {region; value} } unqualified_decl(OP): var ":" type_expr OP expr { - let var = SyntaxError.check_reserved_name $1 in + Scoping.check_reserved_name $1; let region = expr_to_region $5 - in var, $2, $3, $4, $5, region } - -attributes: - "attributes" "[" nsepseq(String,";") "]" { - let region = cover $1 $4 in - let value = (Utils.nsepseq_to_list $3) in - {region; value} - } - -semi_attributes: - /* empty */ { {value = []; region = Region.ghost}, None } - | ";" { {value = []; region = Region.ghost}, Some $1 } - | ";" attributes ";" { $2, Some $1 } + in $1, $2, $3, $4, $5, region } const_decl: - open_const_decl semi_attributes { - let attributes, terminator = $2 in - {$1 with value = {$1.value with terminator = terminator; attributes = attributes }} - } + open_const_decl ";"? { + {$1 with value = {$1.value with terminator=$2}} } instruction: conditional { Cond $1 } @@ -589,7 +545,7 @@ clause_block: let statements, terminator = $2 in let region = cover $1 $3 in let value = {lbrace = $1; - inside = attributes_to_statement statements, terminator; + inside = statements, terminator; rbrace = $3} in ShortBlock {value; region} } @@ -629,7 +585,7 @@ cases(rhs): case_clause(rhs): pattern "->" rhs { - SyntaxError.check_pattern $1; + Scoping.check_pattern $1; fun rhs_to_region -> let start = pattern_to_region $1 in let region = cover start (rhs_to_region $3) @@ -671,10 +627,10 @@ for_loop: in For (ForInt {region; value}) } | "for" var arrow_clause? "in" collection expr block { - let var = SyntaxError.check_reserved_name $2 in + Scoping.check_reserved_name $2; let region = cover $1 $7.region in let value = {kwd_for = $1; - var; + var = $2; bind_to = $3; kwd_in = $4; collection = $5; @@ -689,13 +645,13 @@ collection: var_assign: var ":=" expr { - let name = SyntaxError.check_reserved_name $1 in - let region = cover name.region (expr_to_region $3) - and value = {name; assign=$2; expr=$3} + Scoping.check_reserved_name $1; + let region = cover $1.region (expr_to_region $3) + and value = {name=$1; assign=$2; expr=$3} in {region; value} } arrow_clause: - "->" var { $1, SyntaxError.check_reserved_name $2 } + "->" var { Scoping.check_reserved_name $2; ($1,$2) } (* Expressions *) diff --git a/src/passes/1-parser/pascaligo/ParserLog.ml b/src/passes/1-parser/pascaligo/ParserLog.ml index 4a186980e..06c42718a 100644 --- a/src/passes/1-parser/pascaligo/ParserLog.ml +++ b/src/passes/1-parser/pascaligo/ParserLog.ml @@ -114,29 +114,25 @@ let rec print_tokens state ast = Utils.nseq_iter (print_decl state) decl; print_token state eof "EOF" -and print_attributes state attributes = - let attributes = List.fold_left (fun all a -> all ^ a.value ^ ";") "" attributes.value in - let line = - sprintf "attributes[%s]" - attributes - in Buffer.add_string state#buffer line +and print_attr_decl state = + print_ne_injection state "attributes" print_string and print_decl state = function TypeDecl decl -> print_type_decl state decl | ConstDecl decl -> print_const_decl state decl | FunDecl decl -> print_fun_decl state decl +| AttrDecl decl -> print_attr_decl state decl and print_const_decl state {value; _} = let {kwd_const; name; colon; const_type; - equal; init; terminator; attributes} = value in + equal; init; terminator; _} = value in print_token state kwd_const "const"; print_var state name; print_token state colon ":"; print_type_expr state const_type; print_token state equal "="; print_expr state init; - print_terminator state terminator; - print_attributes state attributes + print_terminator state terminator and print_type_decl state {value; _} = let {kwd_type; name; kwd_is; @@ -206,7 +202,7 @@ and print_type_tuple state {value; _} = and print_fun_decl state {value; _} = let {kwd_function; fun_name; param; colon; ret_type; kwd_is; block_with; - return; terminator; attributes } = value in + return; terminator; _} = value in print_token state kwd_function "function"; print_var state fun_name; print_parameters state param; @@ -220,7 +216,6 @@ and print_fun_decl state {value; _} = print_token state kwd_with "with"); print_expr state return; print_terminator state terminator; - print_attributes state attributes and print_fun_expr state {value; _} = let {kwd_function; param; colon; @@ -296,6 +291,7 @@ and print_statements state sequence = and print_statement state = function Instr instr -> print_instruction state instr | Data data -> print_data_decl state data +| Attr attr -> print_attr_decl state attr and print_instruction state = function Cond {value; _} -> print_conditional state value @@ -607,7 +603,7 @@ and print_field_assign state {value; _} = print_token state equal "="; print_expr state field_expr -and print_update_expr state {value; _} = +and print_update_expr state {value; _} = let {record; kwd_with; updates} = value in print_path state record; print_token state kwd_with "with"; @@ -688,10 +684,10 @@ and print_opening state lexeme = function print_token state kwd lexeme | KwdBracket (kwd, lbracket) -> print_token state kwd lexeme; - print_token state lbracket "{" + print_token state lbracket "[" and print_closing state = function - RBracket rbracket -> print_token state rbracket "}" + RBracket rbracket -> print_token state rbracket "]" | End kwd_end -> print_token state kwd_end "end" and print_binding state {value; _} = @@ -848,21 +844,27 @@ and pp_declaration state = function | FunDecl {value; region} -> pp_loc_node state "FunDecl" region; pp_fun_decl state value +| AttrDecl {value; region} -> + pp_loc_node state "AttrDecl" region; + pp_attr_decl state value + +and pp_attr_decl state = pp_ne_injection pp_string state and pp_fun_decl state decl = + let arity = 5 in let () = - let state = state#pad 5 0 in + let state = state#pad arity 0 in pp_ident state decl.fun_name in let () = - let state = state#pad 5 1 in + let state = state#pad arity 1 in pp_node state ""; pp_parameters state decl.param in let () = - let state = state#pad 5 2 in + let state = state#pad arity 2 in pp_node state ""; pp_type_expr (state#pad 1 0) decl.ret_type in let () = - let state = state#pad 5 3 in + let state = state#pad arity 3 in pp_node state ""; let statements = match decl.block_with with @@ -870,15 +872,16 @@ and pp_fun_decl state decl = | None -> Instr (Skip Region.ghost), [] in pp_statements state statements in let () = - let state = state#pad 5 4 in + let state = state#pad arity 4 in pp_node state ""; pp_expr (state#pad 1 0) decl.return in () and pp_const_decl state decl = - pp_ident (state#pad 3 0) decl.name; - pp_type_expr (state#pad 3 1) decl.const_type; - pp_expr (state#pad 3 2) decl.init + let arity = 3 in + pp_ident (state#pad arity 0) decl.name; + pp_type_expr (state#pad arity 1) decl.const_type; + pp_expr (state#pad arity 2) decl.init and pp_type_expr state = function TProd cartesian -> @@ -979,6 +982,9 @@ and pp_statement state = function | Data data_decl -> pp_node state "Data"; pp_data_decl (state#pad 1 0) data_decl +| Attr attr_decl -> + pp_node state "Attr"; + pp_attr_decl state attr_decl.value and pp_instruction state = function Cond {value; region} -> @@ -1161,18 +1167,18 @@ and pp_bin_cons state (head, _, tail) = and pp_injection : 'a.(state -> 'a -> unit) -> state -> 'a injection -> unit = fun printer state inj -> - let elements = Utils.sepseq_to_list inj.elements in - let length = List.length elements in - let apply len rank = printer (state#pad len rank) - in List.iteri (apply length) elements + let elements = Utils.sepseq_to_list inj.elements in + let length = List.length elements in + let apply len rank = printer (state#pad len rank) + in List.iteri (apply length) elements and pp_ne_injection : 'a.(state -> 'a -> unit) -> state -> 'a ne_injection -> unit = fun printer state inj -> - let ne_elements = Utils.nsepseq_to_list inj.ne_elements in - let length = List.length ne_elements in - let apply len rank = printer (state#pad len rank) - in List.iteri (apply length) ne_elements + let ne_elements = Utils.nsepseq_to_list inj.ne_elements in + let length = List.length ne_elements in + let apply len rank = printer (state#pad len rank) + in List.iteri (apply length) ne_elements and pp_tuple_pattern state tuple = let patterns = Utils.nsepseq_to_list tuple.inside in diff --git a/src/passes/1-parser/pascaligo/ParserLog.mli b/src/passes/1-parser/pascaligo/ParserLog.mli index c1c9bf521..955c1590b 100644 --- a/src/passes/1-parser/pascaligo/ParserLog.mli +++ b/src/passes/1-parser/pascaligo/ParserLog.mli @@ -18,6 +18,7 @@ val print_tokens : state -> AST.t -> unit val print_path : state -> AST.path -> unit val print_pattern : state -> AST.pattern -> unit val print_instruction : state -> AST.instruction -> unit +val print_expr : state -> AST.expr -> unit (** {1 Printing tokens from the AST in a string} *) @@ -30,6 +31,7 @@ val pattern_to_string : val instruction_to_string : offsets:bool -> mode:[`Point|`Byte] -> AST.instruction -> string -(** {1 Pretty-printing of the AST} *) +(** {1 Pretty-printing of AST nodes} *) -val pp_ast : state -> AST.t -> unit +val pp_ast : state -> AST.t -> unit +val pp_expr : state -> AST.expr -> unit diff --git a/src/passes/1-parser/pascaligo/ParserMain.ml b/src/passes/1-parser/pascaligo/ParserMain.ml index b3b0936a0..9b2cc2f28 100644 --- a/src/passes/1-parser/pascaligo/ParserMain.ml +++ b/src/passes/1-parser/pascaligo/ParserMain.ml @@ -6,100 +6,97 @@ module IO = let options = EvalOpt.read "PascaLIGO" ext end -module ExtParser = +module Parser = struct - type ast = AST.t + type ast = AST.t type expr = AST.expr include Parser end -module ExtParserLog = +module ParserLog = struct - type ast = AST.t + type ast = AST.t + type expr = AST.expr include ParserLog end -module MyLexer = Lexer.Make (LexToken) +module Lexer = Lexer.Make (LexToken) module Unit = - ParserUnit.Make (IO)(MyLexer)(AST)(ExtParser)(ParErr)(ExtParserLog) + ParserUnit.Make (Lexer)(AST)(Parser)(ParErr)(ParserLog)(IO) -open! SyntaxError +(* Main *) -let () = - try Unit.run () with - (* Ad hoc errors from the parser *) +let issue_error point = + let error = Unit.format_error ~offsets:IO.options#offsets + IO.options#mode point + in Stdlib.Error error - Error (Reserved_name name) -> - let () = Unit.close_all () in +let parse parser : ('a,string) Stdlib.result = + try parser () with + (* Scoping errors *) + + | Scoping.Error (Scoping.Duplicate_parameter name) -> let token = - MyLexer.Token.mk_ident name.Region.value name.Region.region in + Lexer.Token.mk_ident name.Region.value name.Region.region in (match token with - Stdlib.Error _ -> - assert false (* Should not fail if [name] is valid. *) + (* Cannot fail because [name] is a not a + reserved name for the lexer. *) + Stdlib.Error _ -> assert false | Ok invalid -> - let point = "Reserved name.\nHint: Change the name.\n", - None, invalid in - let error = - Unit.format_error ~offsets:IO.options#offsets - IO.options#mode point - in Printf.eprintf "\027[31m%s\027[0m%!" error) + issue_error ("Duplicate parameter.\nHint: Change the name.\n", + None, invalid)) - | Error (Duplicate_parameter name) -> - let () = Unit.close_all () in + | Scoping.Error (Scoping.Reserved_name name) -> let token = - MyLexer.Token.mk_ident name.Region.value name.Region.region in + Lexer.Token.mk_ident name.Region.value name.Region.region in (match token with - Stdlib.Error _ -> - assert false (* Should not fail if [name] is valid. *) + (* Cannot fail because [name] is a not a + reserved name for the lexer. *) + Stdlib.Error _ -> assert false | Ok invalid -> - let point = "Duplicate parameter.\nHint: Change the name.\n", - None, invalid in - let error = - Unit.format_error ~offsets:IO.options#offsets - IO.options#mode point - in Printf.eprintf "\027[31m%s\027[0m%!" error) + issue_error + ("Reserved name.\nHint: Change the name.\n", None, invalid)) - | Error (Duplicate_variant name) -> - let () = Unit.close_all () in + | Scoping.Error (Scoping.Duplicate_variant name) -> let token = - MyLexer.Token.mk_constr name.Region.value name.Region.region in - let point = "Duplicate variant in this sum type declaration.\n\ - Hint: Change the name.\n", - None, token in - let error = - Unit.format_error ~offsets:IO.options#offsets - IO.options#mode point - in Printf.eprintf "\027[31m%s\027[0m%!" error + Lexer.Token.mk_constr name.Region.value name.Region.region in + let point = "Duplicate constructor in this sum type declaration.\n\ + Hint: Change the constructor.\n", + None, token + in issue_error point - | Error (Non_linear_pattern var) -> - let () = Unit.close_all () in + | Scoping.Error (Scoping.Non_linear_pattern var) -> let token = - MyLexer.Token.mk_ident var.Region.value var.Region.region in + Lexer.Token.mk_ident var.Region.value var.Region.region in (match token with - Stdlib.Error _ -> - assert false (* Should not fail if [name] is valid. *) + (* Cannot fail because [var] is a not a + reserved name for the lexer. *) + Stdlib.Error _ -> assert false | Ok invalid -> let point = "Repeated variable in this pattern.\n\ Hint: Change the name.\n", - None, invalid in - let error = - Unit.format_error ~offsets:IO.options#offsets - IO.options#mode point - in Printf.eprintf "\027[31m%s\027[0m%!" error) + None, invalid + in issue_error point) - | Error (Duplicate_field name) -> - let () = Unit.close_all () in + | Scoping.Error (Scoping.Duplicate_field name) -> let token = - MyLexer.Token.mk_ident name.Region.value name.Region.region in + Lexer.Token.mk_ident name.Region.value name.Region.region in (match token with - Stdlib.Error _ -> - assert false (* Should not fail if [name] is valid. *) + (* Cannot fail because [name] is a not a + reserved name for the lexer. *) + Stdlib.Error _ -> assert false | Ok invalid -> let point = "Duplicate field name in this record declaration.\n\ Hint: Change the name.\n", - None, invalid in - let error = - Unit.format_error ~offsets:IO.options#offsets - IO.options#mode point - in Printf.eprintf "\027[31m%s\027[0m%!" error) + None, invalid + in issue_error point) + +let () = + if IO.options#expr + then match parse (fun () -> Unit.parse Unit.parse_expr) with + Stdlib.Ok _ -> () + | Error msg -> Printf.eprintf "\027[31m%s\027[0m%!" msg + else match parse (fun () -> Unit.parse Unit.parse_contract) with + Stdlib.Ok _ -> () + | Error msg -> Printf.eprintf "\027[31m%s\027[0m%!" msg diff --git a/src/passes/1-parser/pascaligo/SyntaxError.ml b/src/passes/1-parser/pascaligo/Scoping.ml similarity index 96% rename from src/passes/1-parser/pascaligo/SyntaxError.ml rename to src/passes/1-parser/pascaligo/Scoping.ml index a2a7296e5..73a7012ac 100644 --- a/src/passes/1-parser/pascaligo/SyntaxError.ml +++ b/src/passes/1-parser/pascaligo/Scoping.ml @@ -1,12 +1,12 @@ [@@@warning "-42"] + type t = Reserved_name of AST.variable | Duplicate_parameter of AST.variable | Duplicate_variant of AST.variable | Non_linear_pattern of AST.variable | Duplicate_field of AST.variable -| Detached_attributes of AST.attributes type error = t @@ -95,11 +95,6 @@ let check_reserved_names vars = let check_reserved_name var = if SSet.mem var.value reserved then raise (Error (Reserved_name var)) - else var - -let check_reserved_name_opt = function - Some var -> ignore (check_reserved_name var) -| None -> () (* Checking the linearity of patterns *) diff --git a/src/passes/1-parser/pascaligo/Scoping.mli b/src/passes/1-parser/pascaligo/Scoping.mli new file mode 100644 index 000000000..71f8c1244 --- /dev/null +++ b/src/passes/1-parser/pascaligo/Scoping.mli @@ -0,0 +1,18 @@ +(* This module exports checks on scoping, called from the parser. *) + +type t = + Reserved_name of AST.variable +| Duplicate_parameter of AST.variable +| Duplicate_variant of AST.variable +| Non_linear_pattern of AST.variable +| Duplicate_field of AST.variable + +type error = t + +exception Error of t + +val check_reserved_name : AST.variable -> unit +val check_pattern : AST.pattern -> unit +val check_variants : AST.variant Region.reg list -> unit +val check_parameters : AST.param_decl list -> unit +val check_fields : AST.field_decl Region.reg list -> unit diff --git a/src/passes/1-parser/pascaligo/SyntaxError.mli b/src/passes/1-parser/pascaligo/SyntaxError.mli deleted file mode 100644 index 2ae8e0f60..000000000 --- a/src/passes/1-parser/pascaligo/SyntaxError.mli +++ /dev/null @@ -1,27 +0,0 @@ -type t = - Reserved_name of AST.variable -| Duplicate_parameter of AST.variable -| Duplicate_variant of AST.variable -| Non_linear_pattern of AST.variable -| Duplicate_field of AST.variable -| Detached_attributes of AST.attributes - -type error = t - -exception Error of t - -module Ord : - sig - type t = AST.variable - val compare : t -> t -> int - end - -module VarSet : Set.S with type elt = Ord.t - -val check_reserved_name : AST.variable -> AST.variable -val check_reserved_name_opt : AST.variable option -> unit -val check_reserved_names : VarSet.t -> VarSet.t -val check_pattern : AST.pattern -> unit -val check_variants : AST.variant Region.reg list -> unit -val check_parameters : AST.param_decl list -> unit -val check_fields : AST.field_decl Region.reg list -> unit diff --git a/src/passes/1-parser/pascaligo/Tests/pp.ligo b/src/passes/1-parser/pascaligo/Tests/pp.ligo index a2e873338..2cd411592 100644 --- a/src/passes/1-parser/pascaligo/Tests/pp.ligo +++ b/src/passes/1-parser/pascaligo/Tests/pp.ligo @@ -63,12 +63,12 @@ function claim (var store : store) : list (operation) * store is case store.backers[sender] of None -> failwith ("Not a backer.") - | Some (amount) -> + | Some (quantity) -> if balance >= store.goal or store.funded then failwith ("Goal reached: no refund.") else begin - operations.0.foo := list [transaction (unit, sender, amount)]; + operations.0.foo := list [transaction (unit, sender, quantity)]; remove sender from map store.backers end end diff --git a/src/passes/1-parser/pascaligo/unlexer.ml b/src/passes/1-parser/pascaligo/Unlexer.ml similarity index 100% rename from src/passes/1-parser/pascaligo/unlexer.ml rename to src/passes/1-parser/pascaligo/Unlexer.ml diff --git a/src/passes/1-parser/pascaligo/check_dot_git_is_dir.sh b/src/passes/1-parser/pascaligo/check_dot_git_is_dir.sh deleted file mode 100755 index 7df363999..000000000 --- a/src/passes/1-parser/pascaligo/check_dot_git_is_dir.sh +++ /dev/null @@ -1,10 +0,0 @@ -#!/bin/sh - -set -e - -if test -d ../../.git; then - echo true > dot_git_is_dir -else - echo false > dot_git_is_dir - cat .git >> dot_git_is_dir -fi diff --git a/src/passes/1-parser/pascaligo/dune b/src/passes/1-parser/pascaligo/dune index 4e365191b..8ab2030cc 100644 --- a/src/passes/1-parser/pascaligo/dune +++ b/src/passes/1-parser/pascaligo/dune @@ -15,7 +15,7 @@ (name parser_pascaligo) (public_name ligo.parser.pascaligo) (modules - SyntaxError AST pascaligo Parser ParserLog LexToken) + Scoping AST pascaligo Parser ParserLog LexToken ParErr) (libraries menhirLib parser_shared @@ -53,32 +53,21 @@ (name ParserMain) (libraries parser_pascaligo) (modules - ParErr ParserMain) + ParserMain) (preprocess (pps bisect_ppx --conditional)) (flags (:standard -open Simple_utils -open Parser_shared -open Parser_pascaligo))) -;; Les deux directives (rule) qui suivent sont pour le dev local. -;; Il suffit de faire "dune build Parser.exe" pour avoir un Parser.exe dans le dossier. -;; Pour le purger, il faut faire "dune clean". -;(rule -; (targets Parser.exe) -; (deps ParserMain.exe) -; (action (copy ParserMain.exe Parser.exe)) -; (mode promote-until-clean)) - -;(rule -; (targets Lexer.exe) -; (deps LexerMain.exe) -; (action (copy LexerMain.exe Lexer.exe)) -; (mode promote-until-clean)) +;; Build of the covering of error states in the LR automaton (rule (targets Parser.msg) (deps (:script_messages ../../../../vendors/ligo-utils/simple-utils/messages.sh) Parser.mly LexToken.mli ParToken.mly) - (action (run %{script_messages} --lex-tokens=LexToken.mli --par-tokens=ParToken.mly Parser.mly ))) + (action (run %{script_messages} --lex-tokens=LexToken.mli --par-tokens=ParToken.mly Parser.mly))) + +;; Build of all the LIGO source file that cover all error states (rule (targets all.ligo) (deps (:script_cover ../../../../vendors/ligo-utils/simple-utils/cover.sh) Parser.mly LexToken.mli ParToken.mly Parser.msg Unlexer.exe) - (action (run %{script_cover} --lex-tokens=LexToken.mli --par-tokens=ParToken.mly --ext=ligo --unlexer=./Unlexer.exe --messages=Parser.msg --dir=. --concatenate Parser.mly ))) + (action (run %{script_cover} --lex-tokens=LexToken.mli --par-tokens=ParToken.mly --ext=ligo --unlexer=./Unlexer.exe --messages=Parser.msg --dir=. --concatenate Parser.mly))) diff --git a/src/passes/1-parser/pascaligo/pascaligo.ml b/src/passes/1-parser/pascaligo/pascaligo.ml index 8a76623e3..21b604e3e 100644 --- a/src/passes/1-parser/pascaligo/pascaligo.ml +++ b/src/passes/1-parser/pascaligo/pascaligo.ml @@ -1,5 +1,5 @@ -module Parser = Parser -module AST = AST -module Lexer = Lexer -module LexToken = LexToken +module Lexer = Lexer +module LexToken = LexToken +module AST = AST +module Parser = Parser module ParserLog = ParserLog diff --git a/src/passes/1-parser/reasonligo.ml b/src/passes/1-parser/reasonligo.ml index c919ef399..c60a3367c 100644 --- a/src/passes/1-parser/reasonligo.ml +++ b/src/passes/1-parser/reasonligo.ml @@ -6,87 +6,76 @@ module ParserLog = Parser_cameligo.ParserLog module LexToken = Parser_reasonligo.LexToken module Lexer = Lexer.Make(LexToken) module SyntaxError = Parser_reasonligo.SyntaxError +module Scoping = Parser_cameligo.Scoping -module Errors = struct +module Errors = + struct + let lexer_error (e: Lexer.error AST.reg) = + let title () = "lexer error" in + let message () = Lexer.error_to_string e.value in + let data = [ + ("parser_loc", + fun () -> Format.asprintf "%a" Location.pp_lift @@ e.region)] + in error ~data title message - let lexer_error (e: Lexer.error AST.reg) = - let title () = "lexer error" in - let message () = Lexer.error_to_string e.value in - let data = [ - ("parser_loc", - fun () -> Format.asprintf "%a" Location.pp_lift @@ e.region - ) - ] in - error ~data title message + 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 = [ + ("location", + fun () -> Format.asprintf "%a" Location.pp_lift @@ expression_loc)] + in error ~data title message - 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 = [ - ("location", - fun () -> Format.asprintf "%a" Location.pp_lift @@ expression_loc) - ] in - error ~data title message + let parser_error source (start: Lexing.position) + (end_: Lexing.position) lexbuf = + let title () = "parser error" in + let file = + if source = "" then "" + else + Format.sprintf "In file \"%s|%s\"" start.pos_fname source in + let str = + Format.sprintf + "Parse error at \"%s\" from (%d, %d) to (%d, %d). %s\n" + (Lexing.lexeme lexbuf) + start.pos_lnum (start.pos_cnum - start.pos_bol) + end_.pos_lnum (end_.pos_cnum - end_.pos_bol) + file in + let message () = str in + let loc = + if start.pos_cnum = -1 + then Region.make + ~start:(Pos.min ~file:source) + ~stop:(Pos.from_byte end_) + else 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 parser_error source (start: Lexing.position) (end_: Lexing.position) lexbuf = - let title () = "parser error" in - let file = if source = "" then - "" - else - Format.sprintf "In file \"%s|%s\"" start.pos_fname source - in - let str = Format.sprintf - "Parse error at \"%s\" from (%d, %d) to (%d, %d). %s\n" - (Lexing.lexeme lexbuf) - start.pos_lnum (start.pos_cnum - start.pos_bol) - end_.pos_lnum (end_.pos_cnum - end_.pos_bol) - file - in - let message () = str in - let loc = if start.pos_cnum = -1 then - Region.make - ~start: Pos.min - ~stop:(Pos.from_byte end_) - else - 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 source (start: Lexing.position) (end_: Lexing.position) lexbuf = - let title () = "unrecognized error" in - let file = if source = "" then - "" - else - Format.sprintf "In file \"%s|%s\"" start.pos_fname source - in - let str = Format.sprintf - "Parse error at \"%s\" from (%d, %d) to (%d, %d). %s\n" - (Lexing.lexeme lexbuf) - start.pos_lnum (start.pos_cnum - start.pos_bol) - end_.pos_lnum (end_.pos_cnum - end_.pos_bol) - file - in - let message () = str in - let loc = Region.make - ~start:(Pos.from_byte start) - ~stop:(Pos.from_byte end_) - in - let data = [ - ("location", - fun () -> Format.asprintf "%a" Location.pp_lift @@ loc - ) - ] in - error ~data title message + let unrecognized_error source (start: Lexing.position) (end_: Lexing.position) lexbuf = + let title () = "unrecognized error" in + let file = + if source = "" then "" + else + Format.sprintf "In file \"%s|%s\"" start.pos_fname source in + let str = + Format.sprintf + "Parse error at \"%s\" from (%d, %d) to (%d, %d). %s\n" + (Lexing.lexeme lexbuf) + start.pos_lnum (start.pos_cnum - start.pos_bol) + end_.pos_lnum (end_.pos_cnum - end_.pos_bol) + file in + let message () = str in + let loc = Region.make + ~start:(Pos.from_byte start) + ~stop:(Pos.from_byte end_) in + let data = [ + ("location", + fun () -> Format.asprintf "%a" Location.pp_lift @@ loc)] + in error ~data title message end diff --git a/src/passes/1-parser/reasonligo/.unlexer.tag b/src/passes/1-parser/reasonligo/.Unlexer.tag similarity index 100% rename from src/passes/1-parser/reasonligo/.unlexer.tag rename to src/passes/1-parser/reasonligo/.Unlexer.tag diff --git a/src/passes/1-parser/reasonligo/.links b/src/passes/1-parser/reasonligo/.links index e972ad9c6..543bf9ea3 100644 --- a/src/passes/1-parser/reasonligo/.links +++ b/src/passes/1-parser/reasonligo/.links @@ -1,5 +1,4 @@ $HOME/git/OCaml-build/Makefile -$HOME/git/OCaml-build/Makefile.cfg $HOME/git/ligo/vendors/ligo-utils/simple-utils/pos.mli $HOME/git/ligo/vendors/ligo-utils/simple-utils/pos.ml $HOME/git/ligo/vendors/ligo-utils/simple-utils/region.mli @@ -22,7 +21,8 @@ $HOME/git/ligo/vendors/ligo-utils/simple-utils/region.ml ../shared/ParserUnit.ml Stubs/Simple_utils.ml Stubs/Parser_cameligo.ml -../cameligo/AST.mli ../cameligo/AST.ml ../cameligo/ParserLog.mli ../cameligo/ParserLog.ml +../cameligo/Scoping.mli +../cameligo/Scoping.ml \ No newline at end of file diff --git a/src/passes/1-parser/reasonligo/LexToken.mli b/src/passes/1-parser/reasonligo/LexToken.mli index 3c8aadb96..09142e23d 100644 --- a/src/passes/1-parser/reasonligo/LexToken.mli +++ b/src/passes/1-parser/reasonligo/LexToken.mli @@ -143,8 +143,7 @@ val mk_int : lexeme -> Region.t -> (token, int_err) result val mk_nat : lexeme -> Region.t -> (token, nat_err) result val mk_mutez : lexeme -> Region.t -> (token, int_err) result val mk_ident : lexeme -> Region.t -> (token, ident_err) result -val mk_attr : lexeme -> Region.t -> (token, attr_err) result -val mk_attr2 : lexeme -> Region.t -> (token, attr_err) result +val mk_attr : string -> lexeme -> Region.t -> (token, attr_err) result val mk_sym : lexeme -> Region.t -> (token, sym_err) result val mk_kwd : lexeme -> Region.t -> (token, kwd_err) result val mk_string : lexeme -> Region.t -> token diff --git a/src/passes/1-parser/reasonligo/LexToken.mll b/src/passes/1-parser/reasonligo/LexToken.mll index 8949dc64f..e4689082a 100644 --- a/src/passes/1-parser/reasonligo/LexToken.mll +++ b/src/passes/1-parser/reasonligo/LexToken.mll @@ -453,11 +453,10 @@ let mk_constr lexeme region = mk_constr' lexeme region lexicon (* Attributes *) -let mk_attr lexeme region = - Ok (Attr { value = lexeme; region }) - -let mk_attr2 _lexeme _region = - Error Invalid_attribute +let mk_attr header lexeme region = + if header = "[@" then + Ok (Attr Region.{value=lexeme; region}) + else Error Invalid_attribute (* Predicates *) diff --git a/src/passes/1-parser/reasonligo/Makefile.cfg b/src/passes/1-parser/reasonligo/Makefile.cfg new file mode 100644 index 000000000..2f2a6b197 --- /dev/null +++ b/src/passes/1-parser/reasonligo/Makefile.cfg @@ -0,0 +1,5 @@ +SHELL := dash +BFLAGS := -strict-sequence -w +A-48-4 -g + +clean:: +> rm -f Parser.msg Parser.msg.map Parser.msg.states Version.ml diff --git a/src/passes/1-parser/reasonligo/Misc/Misc.ml b/src/passes/1-parser/reasonligo/Misc/Misc.ml new file mode 100644 index 000000000..9e0ac54bf --- /dev/null +++ b/src/passes/1-parser/reasonligo/Misc/Misc.ml @@ -0,0 +1,65 @@ +type error = + IntErr of LexToken.int_err +| IdentErr of LexToken.ident_err +| NatErr of LexToken.nat_err +| SymErr of LexToken.sym_err +| KwdErr of LexToken.kwd_err + +let rec first_of_expr = function + ECase {value; _} -> + (match LexToken.mk_kwd "switch" value.kwd_match with + Error e -> Error (KwdErr e) + | Ok token -> Ok token) +| ECond {value; _} -> + (match LexToken.mk_kwd "if" value.kwd_if with + Error e -> Error (KwdErr e) + | Ok token -> Ok token) +| EPar {value; _} -> + (match LexToken.mk_sym "(" value.lpar with + Error e -> Error (SymErr e) + | Ok token -> Ok token) +| EAnnot {value; _} -> + (match LexToken.mk_sym "(" value.lpar with + Error e -> Error (SymErr e) + | Ok token -> Ok token) +| EUnit {value=opening, _; _} -> + (match LexToken.mk_sym "(" opening with + Error e -> Error (SymErr e) + | Ok token -> Ok token) +| EBytes b -> + Ok (LexToken.mk_bytes (fst b.value) b.region) +| EVar v -> + (match LexToken.mk_ident v.value v.region with + Error e -> Error (IdentErr e) + | Ok token -> Ok token) +| ESeq {value; _} -> + let opening = + match value.compound with + BeginEnd (opening, _) + | Braces (opening, _) + | Brackets (opening, _) -> opening + in (match LexToken.mk_sym "{" opening with + Error e -> Error (SymErr e) + | Ok token -> Ok token) +| EProj {value; _} -> + let structure = value.struct_name in + (match LexToken.mk_ident structure.value structure.region with + Error e -> Error (IdentErr e) + | Ok token -> Ok token) +| EFun {value; _} -> + (match LexToken.mk_kwd "fun" value.kwd_fun with + Error e -> Error (KwdErr e) + | Ok token -> Ok token) +| _ -> failwith "TODO" +(* + +| ELogic expr -> first_of_logic_expr expr +| EArith expr -> first_of_arith_expr expr +| EString expr -> first_of_string_expr expr +| EList expr -> first_of_list_expr expr +| EConstr expr -> first_of_constr_expr expr +| ECall {value=expr,_; _} -> first_of_expr expr +| ERecord {value; _} -> (*field_assign reg ne_injection *) +| ETuple {value; _} -> (* (expr, comma) nsepseq *) +| ELetIn {value; _} -> first_of_let_in value + *) diff --git a/src/passes/1-parser/reasonligo/ParErr.ml b/src/passes/1-parser/reasonligo/ParErr.ml index 594f9ecd4..18b32b373 100644 --- a/src/passes/1-parser/reasonligo/ParErr.ml +++ b/src/passes/1-parser/reasonligo/ParErr.ml @@ -46,9 +46,9 @@ let message = "\n" | 11 -> "\n" - | 509 -> + | 528 -> "\n" - | 503 -> + | 61 -> "\n" | 48 -> "\n" @@ -68,335 +68,387 @@ let message = "\n" | 14 -> "\n" - | 60 -> - "\n" | 65 -> "\n" - | 505 -> + | 70 -> "\n" - | 145 -> + | 524 -> "\n" - | 146 -> + | 185 -> "\n" - | 144 -> + | 186 -> "\n" - | 329 -> + | 184 -> "\n" - | 331 -> + | 302 -> "\n" - | 330 -> + | 304 -> "\n" - | 61 -> + | 303 -> + "\n" + | 66 -> + "\n" + | 69 -> "\n" | 64 -> "\n" - | 59 -> + | 183 -> "\n" - | 143 -> + | 311 -> "\n" - | 338 -> + | 313 -> "\n" - | 340 -> + | 312 -> "\n" - | 339 -> + | 191 -> "\n" - | 151 -> - "\n" - | 152 -> - "\n" - | 78 -> - "\n" - | 325 -> - "\n" - | 327 -> - "\n" - | 326 -> - "\n" - | 92 -> - "\n" - | 155 -> + | 192 -> "\n" | 118 -> "\n" - | 125 -> + | 298 -> "\n" - | 87 -> + | 300 -> "\n" - | 105 -> - "\n" - | 107 -> - "\n" - | 108 -> - "\n" - | 106 -> - "\n" - | 88 -> - "\n" - | 93 -> - "\n" - | 80 -> - "\n" - | 81 -> - "\n" - | 82 -> + | 299 -> "\n" | 132 -> "\n" - | 334 -> - "\n" - | 336 -> - "\n" - | 335 -> - "\n" - | 133 -> - "\n" - | 136 -> - "\n" - | 137 -> - "\n" - | 157 -> - "\n" - | 159 -> + | 195 -> "\n" | 158 -> "\n" - | 512 -> + | 165 -> "\n" - | 218 -> + | 127 -> "\n" - | 514 -> + | 145 -> "\n" - | 216 -> + | 147 -> "\n" - | 250 -> + | 148 -> "\n" - | 248 -> + | 146 -> "\n" - | 249 -> + | 128 -> "\n" - | 230 -> + | 133 -> "\n" - | 235 -> - "\n" - | 252 -> - "\n" - | 254 -> - "\n" - | 255 -> - "\n" - | 258 -> - "\n" - | 219 -> - "\n" - | 226 -> - "\n" - | 227 -> - "\n" - | 260 -> - "\n" - | 262 -> - "\n" - | 264 -> - "\n" - | 266 -> - "\n" - | 194 -> - "\n" - | 195 -> - "\n" - | 206 -> - "\n" - | 215 -> - "\n" - | 199 -> - "\n" - | 207 -> - "\n" - | 208 -> - "\n" - | 196 -> - "\n" - | 197 -> - "\n" - | 198 -> - "\n" - | 256 -> - "\n" - | 257 -> - "\n" - | 277 -> - "\n" - | 233 -> - "\n" - | 279 -> - "\n" - | 67 -> - "\n" - | 463 -> - "\n" - | 464 -> - "\n" - | 387 -> + | 120 -> "\n" | 121 -> "\n" | 122 -> "\n" - | 120 -> + | 172 -> "\n" - | 466 -> + | 307 -> "\n" - | 467 -> + | 309 -> + "\n" + | 308 -> + "\n" + | 173 -> + "\n" + | 176 -> + "\n" + | 177 -> + "\n" + | 197 -> + "\n" + | 199 -> + "\n" + | 198 -> + "\n" + | 59 -> + "\n" + | 531 -> + "\n" + | 225 -> + "\n" + | 533 -> + "\n" + | 223 -> + "\n" + | 257 -> + "\n" + | 255 -> + "\n" + | 256 -> + "\n" + | 237 -> + "\n" + | 242 -> + "\n" + | 259 -> + "\n" + | 261 -> + "\n" + | 262 -> + "\n" + | 265 -> + "\n" + | 226 -> + "\n" + | 233 -> + "\n" + | 234 -> + "\n" + | 267 -> + "\n" + | 269 -> + "\n" + | 271 -> + "\n" + | 273 -> + "\n" + | 201 -> + "\n" + | 202 -> + "\n" + | 213 -> + "\n" + | 222 -> + "\n" + | 206 -> + "\n" + | 214 -> + "\n" + | 215 -> + "\n" + | 203 -> + "\n" + | 204 -> + "\n" + | 205 -> + "\n" + | 263 -> + "\n" + | 284 -> + "\n" + | 240 -> + "\n" + | 286 -> + "\n" + | 72 -> "\n" | 483 -> "\n" - | 492 -> + | 484 -> "\n" - | 469 -> + | 423 -> "\n" - | 470 -> + | 161 -> "\n" - | 468 -> + | 162 -> "\n" - | 471 -> + | 160 -> "\n" - | 472 -> - "\n" - | 473 -> - "\n" - | 475 -> - "\n" - | 476 -> - "\n" - | 477 -> - "\n" - | 478 -> + | 486 -> "\n" | 487 -> "\n" - | 488 -> + | 504 -> "\n" - | 474 -> + | 513 -> + "\n" + | 498 -> "\n" | 499 -> "\n" | 497 -> "\n" - | 465 -> + | 488 -> "\n" - | 321 -> + | 489 -> + "\n" + | 490 -> + "\n" + | 492 -> + "\n" + | 493 -> + "\n" + | 494 -> + "\n" + | 495 -> + "\n" + | 509 -> + "\n" + | 510 -> + "\n" + | 491 -> + "\n" + | 520 -> + "\n" + | 518 -> + "\n" + | 485 -> + "\n" + | 372 -> + "\n" + | 366 -> + "\n" + | 367 -> + "\n" + | 369 -> + "\n" + | 368 -> + "\n" + | 365 -> + "\n" + | 76 -> + "\n" + | 446 -> + "\n" + | 326 -> + "\n" + | 332 -> + "\n" + | 333 -> + "\n" + | 336 -> + "\n" + | 337 -> + "\n" + | 328 -> + "\n" + | 339 -> + "\n" + | 100 -> + "\n" + | 78 -> + "\n" + | 80 -> "\n" | 315 -> "\n" | 316 -> "\n" - | 318 -> + | 117 -> "\n" - | 317 -> - "\n" - | 314 -> - "\n" - | 71 -> - "\n" - | 410 -> - "\n" - | 298 -> - "\n" - | 304 -> - "\n" - | 305 -> - "\n" - | 308 -> - "\n" - | 309 -> - "\n" - | 300 -> - "\n" - | 178 -> - "\n" - | 73 -> - "\n" - | 75 -> - "\n" - | 419 -> - "\n" - | 420 -> - "\n" - | 77 -> - "\n" - | 160 -> - "\n" - | 412 -> - "\n" - | 413 -> - "\n" - | 415 -> - "\n" - | 416 -> - "\n" - | 193 -> - "\n" - | 229 -> - "\n" - | 74 -> - "\n" - | 447 -> + | 82 -> "\n" | 448 -> "\n" - | 456 -> + | 449 -> "\n" - | 457 -> + | 451 -> "\n" - | 459 -> + | 452 -> + "\n" + | 200 -> + "\n" + | 236 -> + "\n" + | 79 -> + "\n" + | 467 -> + "\n" + | 468 -> + "\n" + | 476 -> + "\n" + | 477 -> + "\n" + | 479 -> + "\n" + | 480 -> + "\n" + | 469 -> + "\n" + | 470 -> + "\n" + | 81 -> "\n" | 460 -> "\n" - | 449 -> + | 461 -> "\n" - | 450 -> + | 455 -> "\n" - | 76 -> + | 454 -> + "\n" + | 458 -> + "\n" + | 348 -> + "\n" + | 356 -> + "\n" + | 360 -> + "\n" + | 359 -> + "\n" + | 355 -> + "\n" + | 349 -> + "\n" + | 457 -> + "\n" + | 340 -> + "\n" + | 341 -> + "\n" + | 346 -> + "\n" + | 347 -> + "\n" + | 342 -> + "\n" + | 343 -> + "\n" + | 344 -> + "\n" + | 84 -> + "\n" + | 85 -> + "\n" + | 318 -> + "\n" + | 323 -> + "\n" + | 324 -> + "\n" + | 389 -> + "\n" + | 436 -> + "\n" + | 437 -> + "\n" + | 438 -> + "\n" + | 439 -> "\n" | 440 -> "\n" | 441 -> "\n" - | 425 -> + | 435 -> "\n" - | 422 -> + | 325 -> "\n" - | 428 -> + | 362 -> "\n" - | 429 -> + | 363 -> "\n" - | 434 -> + | 373 -> "\n" - | 438 -> + | 374 -> "\n" - | 437 -> + | 413 -> "\n" - | 433 -> + | 420 -> "\n" - | 423 -> + | 408 -> "\n" - | 427 -> + | 409 -> "\n" - | 162 -> + | 407 -> "\n" - | 163 -> + | 375 -> "\n" - | 290 -> + | 376 -> "\n" - | 295 -> - "\n" - | 296 -> - "\n" - | 357 -> - "\n" - | 400 -> - "\n" - | 401 -> + | 377 -> "\n" | 402 -> "\n" @@ -406,105 +458,69 @@ let message = "\n" | 405 -> "\n" - | 399 -> + | 417 -> "\n" - | 297 -> + | 418 -> "\n" - | 311 -> + | 401 -> "\n" - | 312 -> + | 429 -> "\n" - | 322 -> + | 427 -> "\n" - | 323 -> - "\n" - | 377 -> + | 364 -> "\n" | 384 -> "\n" - | 342 -> + | 385 -> "\n" - | 343 -> + | 383 -> "\n" - | 324 -> - "\n" - | 344 -> - "\n" - | 345 -> - "\n" - | 346 -> - "\n" - | 370 -> - "\n" - | 371 -> - "\n" - | 372 -> - "\n" - | 373 -> + | 378 -> "\n" | 379 -> "\n" | 380 -> "\n" - | 369 -> + | 394 -> + "\n" + | 395 -> + "\n" + | 396 -> + "\n" + | 397 -> + "\n" + | 399 -> + "\n" + | 398 -> "\n" | 393 -> "\n" - | 391 -> + | 320 -> "\n" - | 313 -> + | 321 -> "\n" - | 348 -> + | 86 -> "\n" - | 349 -> + | 87 -> "\n" - | 347 -> + | 88 -> "\n" - | 350 -> + | 89 -> "\n" - | 351 -> + | 90 -> "\n" - | 352 -> + | 91 -> "\n" - | 359 -> + | 96 -> "\n" - | 360 -> + | 97 -> "\n" - | 361 -> + | 98 -> "\n" - | 362 -> + | 111 -> "\n" - | 364 -> - "\n" - | 363 -> - "\n" - | 358 -> - "\n" - | 292 -> - "\n" - | 293 -> - "\n" - | 164 -> - "\n" - | 165 -> - "\n" - | 166 -> - "\n" - | 167 -> - "\n" - | 168 -> - "\n" - | 169 -> - "\n" - | 174 -> - "\n" - | 175 -> - "\n" - | 176 -> - "\n" - | 188 -> - "\n" - | 237 -> + | 244 -> "\n" | _ -> raise Not_found diff --git a/src/passes/1-parser/reasonligo/Parser.mly b/src/passes/1-parser/reasonligo/Parser.mly index 804bcddea..12f2e7f42 100644 --- a/src/passes/1-parser/reasonligo/Parser.mly +++ b/src/passes/1-parser/reasonligo/Parser.mly @@ -148,6 +148,7 @@ declaration: type_decl: "type" type_name "=" type_expr { + Scoping.check_reserved_name $2; let region = cover $1 (type_expr_to_region $4) and value = {kwd_type = $1; name = $2; @@ -192,6 +193,7 @@ core_type: sum_type: "|" nsepseq(variant,"|") { + Scoping.check_variants (Utils.nsepseq_to_list $2); let region = nsepseq_to_region (fun x -> x.region) $2 in TSum {region; value=$2} } @@ -205,6 +207,8 @@ variant: record_type: "{" sep_or_term_list(field_decl,",") "}" { let ne_elements, terminator = $2 in + let () = Utils.nsepseq_to_list ne_elements + |> Scoping.check_fields in let region = cover $1 $3 and value = {compound = Braces ($1,$3); ne_elements; terminator} in TRecord {region; value} } @@ -240,21 +244,25 @@ es6_func: let_binding: "" type_annotation? "=" expr { - {binders = PVar $1,[]; lhs_type=$2; eq=$3; let_rhs=$4} + Scoping.check_reserved_name $1; + {binders = PVar $1, []; lhs_type=$2; eq=$3; let_rhs=$4} } | "_" type_annotation? "=" expr { - {binders = PWild $1,[]; lhs_type=$2; eq=$3; let_rhs=$4} + {binders = PWild $1, []; lhs_type=$2; eq=$3; let_rhs=$4} } | unit type_annotation? "=" expr { - {binders = PUnit $1,[]; lhs_type=$2; eq=$3; let_rhs=$4} + {binders = PUnit $1, []; lhs_type=$2; eq=$3; let_rhs=$4} } | record_pattern type_annotation? "=" expr { + Scoping.check_pattern (PRecord $1); {binders = PRecord $1, []; lhs_type=$2; eq=$3; let_rhs=$4} } | par(closed_irrefutable) type_annotation? "=" expr { + Scoping.check_pattern $1.value.inside; {binders = PPar $1, []; lhs_type=$2; eq=$3; let_rhs=$4} } | tuple(sub_irrefutable) type_annotation? "=" expr { + Utils.nsepseq_iter Scoping.check_pattern $1; let hd, tl = $1 in let start = pattern_to_region hd in let stop = last fst tl in @@ -419,8 +427,11 @@ fun_expr: let region = cover start stop in let rec arg_to_pattern = function - EVar v -> PVar v + EVar v -> + Scoping.check_reserved_name v; + PVar v | EAnnot {region; value = {inside = EVar v, colon, typ; _}} -> + Scoping.check_reserved_name v; let value = {pattern = PVar v; colon; type_expr = typ} in PTyped {region; value} | EPar p -> @@ -428,8 +439,22 @@ fun_expr: {p.value with inside = arg_to_pattern p.value.inside} in PPar {p with value} | EUnit u -> PUnit u - | e -> let open! SyntaxError - in raise (Error (WrongFunctionArguments e)) + | ETuple { value; region } -> + PTuple { value = Utils.nsepseq_map arg_to_pattern value; region} + | EAnnot {region; value = {inside = t, colon, typ; _}} -> + let value = { pattern = arg_to_pattern t; colon; type_expr = typ} in + PPar { + value = { + lpar = Region.ghost; + rpar = Region.ghost; + inside = PTyped {region; value} + }; + region + } + | e -> ( + let open! SyntaxError in + raise (Error (WrongFunctionArguments e)) + ) in let fun_args_to_pattern = function EAnnot { @@ -454,8 +479,9 @@ fun_expr: arg_to_pattern (EAnnot e), [] | ETuple {value = fun_args; _} -> let bindings = - List.map (arg_to_pattern <@ snd) (snd fun_args) - in arg_to_pattern (fst fun_args), bindings + List.map (arg_to_pattern <@ snd) (snd fun_args) in + List.iter Scoping.check_pattern bindings; + arg_to_pattern (fst fun_args), bindings | EUnit e -> arg_to_pattern (EUnit e), [] | e -> let open! SyntaxError @@ -521,7 +547,7 @@ switch_expr(right_expr): let region = cover start stop and cases = { region = nsepseq_to_region (fun x -> x.region) $4; - value = $4} in + value = $4} in let value = { kwd_match = $1; expr = $2; @@ -541,6 +567,7 @@ cases(right_expr): case_clause(right_expr): "|" pattern "=>" right_expr ";"? { + Scoping.check_pattern $2; let start = pattern_to_region $2 and stop = expr_to_region $4 in let region = cover start stop diff --git a/src/passes/1-parser/reasonligo/ParserMain.ml b/src/passes/1-parser/reasonligo/ParserMain.ml index 94f437f9d..c2df027e2 100644 --- a/src/passes/1-parser/reasonligo/ParserMain.ml +++ b/src/passes/1-parser/reasonligo/ParserMain.ml @@ -6,39 +6,101 @@ module IO = let options = EvalOpt.read "ReasonLIGO" ext end -module ExtParser = +module Parser = struct - type ast = AST.t + type ast = AST.t type expr = AST.expr include Parser end -module ExtParserLog = +module ParserLog = struct - type ast = AST.t + type ast = AST.t + type expr = AST.expr include ParserLog end -module MyLexer = Lexer.Make (LexToken) +module Lexer = Lexer.Make (LexToken) module Unit = - ParserUnit.Make (IO)(MyLexer)(AST)(ExtParser)(ParErr)(ExtParserLog) + ParserUnit.Make (Lexer)(AST)(Parser)(ParErr)(ParserLog)(IO) (* Main *) -let () = - try Unit.run () with - (* Ad hoc errors from the parsers *) +let issue_error point = + let error = Unit.format_error ~offsets:IO.options#offsets + IO.options#mode point + in Stdlib.Error error + +let parse parser : ('a,string) Stdlib.result = + try parser () with + (* Ad hoc errors from the parser *) SyntaxError.Error (SyntaxError.WrongFunctionArguments expr) -> - let () = Unit.close_all () in - let msg = "It looks like you are defining a function, \ - however we do not\n\ - understand the parameters declaration.\n\ - Examples of valid functions:\n\ - let x = (a: string, b: int) : int => 3;\n\ - let x = (a: string) : string => \"Hello, \" ++ a;\n" - and reg = AST.expr_to_region expr in - let error = Unit.short_error ~offsets:IO.options#offsets - IO.options#mode msg reg - in Printf.eprintf "\027[31m%s\027[0m%!" error + let msg = "It looks like you are defining a function, \ + however we do not\n\ + understand the parameters declaration.\n\ + Examples of valid functions:\n\ + let x = (a: string, b: int) : int => 3;\n\ + let x = (a: string) : string => \"Hello, \" ++ a;\n" + and reg = AST.expr_to_region expr in + let error = Unit.short_error ~offsets:IO.options#offsets + IO.options#mode msg reg + in Stdlib.Error error + + (* Scoping errors *) + + | Scoping.Error (Scoping.Reserved_name name) -> + let token = + Lexer.Token.mk_ident name.Region.value name.Region.region in + (match token with + (* Cannot fail because [name] is a not a + reserved name for the lexer. *) + Stdlib.Error _ -> assert false + | Ok invalid -> + issue_error + ("Reserved name.\nHint: Change the name.\n", None, invalid)) + + | Scoping.Error (Scoping.Duplicate_variant name) -> + let token = + Lexer.Token.mk_constr name.Region.value name.Region.region in + let point = "Duplicate constructor in this sum type declaration.\n\ + Hint: Change the constructor.\n", + None, token + in issue_error point + + | Scoping.Error (Scoping.Non_linear_pattern var) -> + let token = + Lexer.Token.mk_ident var.Region.value var.Region.region in + (match token with + (* Cannot fail because [var] is a not a + reserved name for the lexer. *) + Stdlib.Error _ -> assert false + | Ok invalid -> + let point = "Repeated variable in this pattern.\n\ + Hint: Change the name.\n", + None, invalid + in issue_error point) + + | Scoping.Error (Scoping.Duplicate_field name) -> + let token = + Lexer.Token.mk_ident name.Region.value name.Region.region in + (match token with + (* Cannot fail because [name] is a not a + reserved name for the lexer. *) + Stdlib.Error _ -> assert false + | Ok invalid -> + let point = + "Duplicate field name in this record declaration.\n\ + Hint: Change the name.\n", + None, invalid + in issue_error point) + +let () = + if IO.options#expr + then match parse (fun () -> Unit.parse Unit.parse_expr) with + Stdlib.Ok _ -> () + | Error msg -> Printf.eprintf "\027[31m%s\027[0m%!" msg + else match parse (fun () -> Unit.parse Unit.parse_contract) with + Stdlib.Ok _ -> () + | Error msg -> Printf.eprintf "\027[31m%s\027[0m%!" msg diff --git a/src/passes/1-parser/reasonligo/unlexer.ml b/src/passes/1-parser/reasonligo/Unlexer.ml similarity index 100% rename from src/passes/1-parser/reasonligo/unlexer.ml rename to src/passes/1-parser/reasonligo/Unlexer.ml diff --git a/src/passes/1-parser/reasonligo/dune b/src/passes/1-parser/reasonligo/dune index a38f523db..5f6970ee0 100644 --- a/src/passes/1-parser/reasonligo/dune +++ b/src/passes/1-parser/reasonligo/dune @@ -1,9 +1,15 @@ +;; Build of the lexer + (ocamllex LexToken) +;; Build of the parser + (menhir - (merge_into Parser) - (modules ParToken Parser) - (flags -la 1 --table --explain --strict --external-tokens LexToken)) + (merge_into Parser) + (modules ParToken Parser) + (flags -la 1 --table --explain --strict --external-tokens LexToken)) + +;; Build of the parser as a library (library (name parser_reasonligo) @@ -22,6 +28,18 @@ (pps bisect_ppx --conditional)) (flags (:standard -open Simple_utils -open Parser_shared -open Parser_cameligo))) +;; Build of the unlexer (for covering the +;; error states of the LR automaton) + +(executable + (name Unlexer) + (libraries str) + (preprocess + (pps bisect_ppx --conditional)) + (modules Unlexer)) + +;; Local build of a standalone lexer + (executable (name LexerMain) (libraries parser_reasonligo) @@ -30,6 +48,8 @@ (pps bisect_ppx --conditional)) (flags (:standard -open Parser_shared -open Parser_reasonligo))) +;; Local build of a standalone parser + (executable (name ParserMain) (libraries @@ -41,19 +61,16 @@ (pps bisect_ppx --conditional)) (flags (:standard -open Simple_utils -open Parser_cameligo -open Parser_shared -open Parser_reasonligo))) -(executable - (name Unlexer) - (libraries str) - (preprocess - (pps bisect_ppx --conditional)) - (modules Unlexer)) +;; Build of the covering of error states in the LR automaton (rule (targets Parser.msg) (deps (:script_messages ../../../../vendors/ligo-utils/simple-utils/messages.sh) Parser.mly LexToken.mli ParToken.mly) (action (run %{script_messages} --lex-tokens=LexToken.mli --par-tokens=ParToken.mly Parser.mly ))) +;; Build of all the LIGO source file that cover all error states + (rule - (targets all.ligo) + (targets all.religo) (deps (:script_cover ../../../../vendors/ligo-utils/simple-utils/cover.sh) Parser.mly LexToken.mli ParToken.mly Parser.msg Unlexer.exe) - (action (run %{script_cover} --lex-tokens=LexToken.mli --par-tokens=ParToken.mly --ext=ligo --unlexer=./Unlexer.exe --messages=Parser.msg --dir=. --concatenate Parser.mly ))) + (action (run %{script_cover} --lex-tokens=LexToken.mli --par-tokens=ParToken.mly --ext=religo --unlexer=./Unlexer.exe --messages=Parser.msg --dir=. --concatenate Parser.mly ))) diff --git a/src/passes/1-parser/shared/EvalOpt.ml b/src/passes/1-parser/shared/EvalOpt.ml index 7889c9c18..30277f72f 100644 --- a/src/passes/1-parser/shared/EvalOpt.ml +++ b/src/passes/1-parser/shared/EvalOpt.ml @@ -14,10 +14,11 @@ type options = < offsets : bool; mode : [`Byte | `Point]; cmd : command; - mono : bool + mono : bool; + expr : bool > -let make ~input ~libs ~verbose ~offsets ~mode ~cmd ~mono = +let make ~input ~libs ~verbose ~offsets ~mode ~cmd ~mono ~expr = object method input = input method libs = libs @@ -26,6 +27,7 @@ let make ~input ~libs ~verbose ~offsets ~mode ~cmd ~mono = method mode = mode method cmd = cmd method mono = mono + method expr = expr end (** {1 Auxiliary functions} *) @@ -42,17 +44,18 @@ let abort msg = let help language extension () = let file = Filename.basename Sys.argv.(0) in printf "Usage: %s [