Merge branch 'dev' into contract/hashlock

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-->
 ```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-->
 ```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);
 ```
 
 <!--END_DOCUSAURUS_CODE_TABS-->

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

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

gitlab-pages/docs/language-basics/maps-records.md

@@ -182,14 +182,14 @@ function iter_op (const m : moveset) : unit is
 <!--CameLIGO-->
 ```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-->
 ```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-->
 ```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-->
 ```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-->
 ```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-->
 ```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);
 };
 

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-->
 
 ```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);
 ```

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.
+
+<!--DOCUSAURUS_CODE_TABS-->
+
+<!--PascaLIGO-->
+```pascaligo
+function id_string (const p : string) : option(string) is block {
+  const packed : bytes = bytes_pack(p) ;
+} with (bytes_unpack(packed): option(string))
+```
+
+<!--CameLIGO-->
+```cameligo
+let id_string (p: string) : string option =
+  let packed: bytes = Bytes.pack p in
+  ((Bytes.unpack packed): string option)
+```
+
+<!--ReasonLIGO-->
+```reasonligo
+let id_string = (p: string) : option(string) => {
+  let packed : bytes = Bytes.pack(p);
+  ((Bytes.unpack(packed)): option(string));
+};
+```
+
+<!--END_DOCUSAURUS_CODE_TABS-->
+
+## 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.
+
+<!--DOCUSAURUS_CODE_TABS-->
+
+<!--PascaLIGO-->
+```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-->
+```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-->
+```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);
+  }
+};
+```
+
+<!--END_DOCUSAURUS_CODE_TABS-->
+
+## 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.
+
+<!--DOCUSAURUS_CODE_TABS-->
+
+<!--PascaLIGO-->
+```pascaligo
+function check_signature
+    (const pk: key;
+     const signed: signature;
+     const msg: bytes) : bool
+  is crypto_check(pk, signed, msg)
+```
+
+<!--CameLIGO-->
+```cameligo
+let check_signature (pk, signed, msg: key * signature * bytes) : bool =
+  Crypto.check pk signed msg
+```
+
+<!--ReasonLIGO-->
+```reasonligo
+let check_signature = ((pk, signed, msg): (key, signature, bytes)) : bool => {
+  Crypto.check(pk, signed, msg);
+};
+```
+
+<!--END_DOCUSAURUS_CODE_TABS-->
+ 
+## 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.
+
+<!--DOCUSAURUS_CODE_TABS-->
+
+<!--PascaLIGO-->
+```pascaligo
+const current_addr : address = self_address;
+```
+
+<!--CameLIGO-->
+```cameligo
+let current_addr : address = Current.self_address
+```
+
+<!--ReasonLIGO-->
+```reasonligo
+let current_addr : address = Current.self_address;
+```
+
+<!--END_DOCUSAURUS_CODE_TABS-->

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

gitlab-pages/website/core/CodeExamples.js

@@ -30,16 +30,16 @@ type action =
 | Increment of int
 | Decrement of int
 
-let add (a: int) (b: int) : int = a + b
-let sub (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
 
 (* real entrypoint that re-routes the flow based on the action provided *)
 
 let main (p,s: action * storage) =
  let storage =
    match p with
-   | Increment n -> add s n
-   | Decrement n -> sub s n
+   | Increment n -> add (s, n)
+   | Decrement n -> sub (s, n)
  in ([] : operation list), storage
 ${pre}`;
 
@@ -53,22 +53,19 @@ type action =
   | Increment(int)
   | Decrement(int);
 
-let add = (a: int, b: int): int => a + b;
-let sub = (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;
 
 /* real entrypoint that re-routes the flow based on the action provided */
 
-let main2 = (p: action, storage) => {
+let main = ((p,storage): (action, storage)) => {
   let storage =
     switch (p) {
-    | Increment(n) => add(storage, n)
-    | Decrement(n) => sub(storage, n)
+    | Increment(n) => add((storage, n))
+    | Decrement(n) => sub((storage, n))
     };
   ([]: list(operation), storage);
 };
-
-let main = (x: (action, storage)) => main2(x[0],x[1]);
-
 ${pre}`;
 
 

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",

src/bin/cli.ml

@@ -374,7 +374,7 @@ let evaluate_value =
     let%bind compiled          = Compile.Of_mini_c.aggregate_and_compile_expression mini_c exp in
     let%bind options           = Run.make_dry_run_options {predecessor_timestamp ; amount ; sender ; source } in
     let%bind michelson_output  = Run.run_no_failwith ~options compiled.expr compiled.expr_ty in
-    let%bind simplified_output = Uncompile.uncompile_typed_program_entry_function_result typed_prg entry_point michelson_output in
+    let%bind simplified_output = Uncompile.uncompile_typed_program_entry_expression_result typed_prg entry_point michelson_output in
     ok @@ Format.asprintf "%a\n" Ast_simplified.PP.expression simplified_output
   in
   let term =

src/bin/expect_tests/eval_value_tests.ml

@@ -0,0 +1,10 @@
+open Cli_expect
+
+let%expect_test _ =
+  run_ligo_good [ "evaluate-value" ; "../../test/contracts/evaluation_tests.ligo" ; "a" ] ;
+  [%expect {|
+    {foo = +0 , bar = "bar"} |} ];
+
+  run_ligo_good [ "evaluate-value" ; "../../test/contracts/evaluation_tests.ligo" ; "b" ] ;
+  [%expect {|
+    2 |} ]

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

src/main/compile/helpers.ml

@@ -137,17 +137,17 @@ let parsify_string = fun (syntax : v_syntax) source_filename ->
 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
+  let state = Parser_pascaligo.ParserLog.mk_state
     ~offsets:true
     ~mode:`Byte
     ~buffer in
-  Parser.Pascaligo.ParserLog.pp_ast state ast;
+  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
+  let state = Parser_cameligo.ParserLog.mk_state
     ~offsets:true
     ~mode:`Byte
     ~buffer in

src/passes/1-parser/cameligo.ml

@@ -18,7 +18,7 @@ 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
         ""
@@ -29,18 +29,18 @@ module Errors = struct
               "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_)
+        ~stop:(Pos.from_byte stop)
     in
     let data =
       [
@@ -51,7 +51,7 @@ module Errors = struct
     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
         ""
@@ -62,13 +62,13 @@ module Errors = struct
               "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_) 
+      ~stop:(Pos.from_byte stop)
     in
     let data = [
       ("unrecognized_loc",
@@ -91,15 +91,15 @@ let parse (parser: 'a parser) source 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
+  parse Parser.interactive_expr "" lexbuf

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

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

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

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 = 
+let mk_attr header lexeme region =
+  if header = "[@" then
     Error Invalid_attribute
-
-let mk_attr2 lexeme region = 
-  Ok (Attr2 { value = lexeme; region })
+  else Ok (Attr Region.{value=lexeme; region})
 
 (* Predicates *)
 

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

src/passes/1-parser/cameligo/ParErr.ml

@@ -46,7 +46,7 @@ let message =
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 33 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 460 ->
+    | 478 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 27 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
@@ -68,9 +68,13 @@ let message =
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 133 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 373 ->
+    | 379 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 375 ->
+    | 381 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 472 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 169 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 134 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
@@ -80,7 +84,7 @@ let message =
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 153 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 374 ->
+    | 380 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 63 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
@@ -144,137 +148,141 @@ let message =
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 156 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 463 ->
+    | 481 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 465 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 217 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 242 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 219 ->
+    | 483 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 221 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 215 ->
+    | 246 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 226 ->
+    | 223 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 255 ->
+    | 225 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 256 ->
+    | 219 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 243 ->
+    | 230 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 264 ->
+    | 259 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 228 ->
+    | 260 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 257 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 258 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 266 ->
+    | 247 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 268 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 232 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 261 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 262 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 270 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 272 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 274 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 192 ->
+    | 276 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 259 ->
+    | 278 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 285 ->
+    | 195 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 288 ->
+    | 263 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 245 ->
+    | 289 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 293 ->
+    | 292 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 262 ->
+    | 249 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 297 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 266 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 160 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 164 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 429 ->
+    | 445 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 332 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 313 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 431 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 315 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 316 ->
+    | 337 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 317 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 432 ->
+    | 447 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 445 ->
+    | 319 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 446 ->
+    | 320 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 433 ->
+    | 321 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 434 ->
+    | 448 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 435 ->
+    | 462 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 436 ->
+    | 463 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 437 ->
+    | 449 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 438 ->
+    | 450 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 440 ->
+    | 452 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 328 ->
+    | 451 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 330 ->
+    | 453 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 454 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 455 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 457 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 333 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 335 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 339 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 336 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 334 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 331 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 329 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 340 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 341 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 342 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 343 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 344 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 345 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 367 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 346 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 348 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 441 ->
+    | 347 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 443 ->
+    | 349 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 447 ->
+    | 350 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 430 ->
+    | 351 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 312 ->
+    | 373 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 428 ->
+    | 352 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 354 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 458 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 460 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 464 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 446 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 316 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 444 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 165 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
@@ -282,65 +290,71 @@ let message =
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 168 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 169 ->
+    | 172 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 171 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 163 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 448 ->
+    | 465 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 450 ->
+    | 467 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 451 ->
+    | 468 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 166 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 235 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 236 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 239 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 240 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 425 ->
+    | 243 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 170 ->
+    | 244 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 171 ->
+    | 441 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 172 ->
+    | 173 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 418 ->
+    | 428 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 419 ->
+    | 429 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 174 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 175 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 434 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 435 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 438 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 439 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 427 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 421 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 422 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 423 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 174 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 304 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 305 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 405 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 412 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 404 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 306 ->
+    | 177 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 308 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 320 ->
+    | 309 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 321 ->
+    | 412 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 322 ->
+    | 419 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 323 ->
+    | 411 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 310 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 312 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 324 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
@@ -350,67 +364,79 @@ let message =
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 327 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 378 ->
+    | 329 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 379 ->
+    | 328 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 381 ->
+    | 330 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 335 ->
+    | 331 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 310 ->
+    | 332 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 307 ->
+    | 384 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 395 ->
+    | 385 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 396 ->
+    | 387 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 397 ->
+    | 340 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 398 ->
+    | 314 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 399 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 400 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 408 ->
+    | 311 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 401 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 402 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 404 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 403 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 175 ->
+    | 405 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 176 ->
+    | 406 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 407 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 415 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 408 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 410 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 178 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 179 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 180 ->
+    | 182 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 183 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 302 ->
+    | 186 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 300 ->
+    | 306 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 185 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 187 ->
+    | 304 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 188 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 189 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 190 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 195 ->
+    | 191 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 192 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 193 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 198 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 218 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 197 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 214 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 194 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 210 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | _ ->
         raise Not_found

src/passes/1-parser/cameligo/ParToken.mly

@@ -12,7 +12,7 @@
 %token            <(string * Z.t) Region.reg> Mutez  "<mutez>"
 %token                    <string Region.reg> Ident  "<ident>"
 %token                    <string Region.reg> Constr "<constr>"
-%token                    <string Region.reg> Attr2  "<attr>"
+%token                    <string Region.reg> Attr   "<attr>"
 
   (* Symbols *)
 

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,7 +206,7 @@ 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
@@ -214,9 +218,11 @@ let_declaration:
 let_binding:
   "<ident>" 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,10 +447,12 @@ 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" let_binding seq(Attr) "in" right_expr  {
     let kwd_let    = $1
     and binding    = $2
     and attributes = $3

src/passes/1-parser/cameligo/ParserLog.ml

@@ -131,7 +131,7 @@ let rec print_tokens state {decl;eof} =
 and print_attributes state attributes =
   List.iter (
     fun ({value = attribute; region}) ->
-      let attribute_formatted = sprintf "[@%s]" attribute in
+      let attribute_formatted = sprintf "[@@%s]" attribute in
       print_token state region attribute_formatted
    ) 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 "<binders>";
-    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 "<lhs type>";
-       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 "<rhs>";
-    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 "<attributes>";
+      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 "<binders>";
-    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 "<lhs type>";
-       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 "<rhs>";
-    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 "<body>";
-    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 "<attributes>";
+      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; _} =

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_expr : state -> AST.expr -> unit

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 expr = AST.expr
     include Parser
   end
 
-module ExtParserLog =
+module ParserLog =
   struct
     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

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

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

src/passes/1-parser/cameligo/check_dot_git_is_dir.sh

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

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)))
 
+;; 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 )))
+  (action (run %{script_cover} --lex-tokens=LexToken.mli --par-tokens=ParToken.mly --ext=mligo --unlexer=./Unlexer.exe --messages=Parser.msg --dir=. --concatenate Parser.mly )))

src/passes/1-parser/dune

@@ -7,10 +7,7 @@
      parser_shared
      parser_pascaligo
      parser_cameligo
-    parser_reasonligo
-  )
+     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)))

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 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_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 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 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 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
-
-  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 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_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 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
-
+           fun () -> Format.asprintf "%a" Location.pp_lift @@ e.region)]
+      in error ~data title message
 end
 
 open Errors
@@ -133,33 +107,27 @@ 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 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 =

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

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

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
@@ -144,12 +145,13 @@ type t = {
 
 and ast = t
 
-and attributes = attribute list reg
-
 and declaration =
   TypeDecl  of type_decl  reg
 | ConstDecl of const_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,6 +262,7 @@ 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
@@ -562,6 +565,7 @@ and field_assign = {
   equal      : equal;
   field_expr : expr
 }
+
 and record = field_assign reg ne_injection
 
 and projection = {

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

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

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

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

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

src/passes/1-parser/pascaligo/ParErr.ml

@@ -58,13 +58,13 @@ let message =
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 64 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 517 ->
+    | 543 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 29 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 32 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 515 ->
+    | 541 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 35 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
@@ -78,23 +78,9 @@ let message =
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 67 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 70 ->
+    | 68 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 71 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 72 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 73 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 80 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 81 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 76 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 77 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 78 ->
+    | 84 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 85 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
@@ -102,241 +88,225 @@ let message =
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 87 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 88 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 512 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 358 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 359 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 499 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 362 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 360 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 361 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 363 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 364 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 365 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 366 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 367 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 475 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 476 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 477 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 478 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 496 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 503 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 502 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 371 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 372 ->
+    | 514 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 373 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 374 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 507 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 377 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 375 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 376 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 378 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 379 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 380 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 381 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 382 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 383 ->
+    | 484 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 485 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 486 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 487 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 504 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 511 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 510 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 386 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 387 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 384 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 385 ->
+    | 388 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 389 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 390 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 391 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 393 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 395 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 399 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 396 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 397 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 375 ->
+    | 398 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 381 ->
+    | 402 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 399 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 400 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 404 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 408 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 405 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 406 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 492 ->
+    | 390 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 493 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 494 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 407 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 488 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 408 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 452 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 447 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 453 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 409 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 410 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 416 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 420 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 421 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 411 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 424 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 425 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 426 ->
+    | 396 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 413 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 414 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 415 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 435 ->
+    | 500 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 436 ->
+    | 501 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 437 ->
+    | 502 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 440 ->
+    | 416 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 441 ->
+    | 496 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 469 ->
+    | 417 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 470 ->
+    | 461 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 473 ->
+    | 456 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 472 ->
+    | 462 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 438 ->
+    | 418 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 467 ->
+    | 419 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 439 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 69 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 428 ->
+    | 425 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 429 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 430 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 431 ->
+    | 420 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 432 ->
+    | 433 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 508 ->
+    | 434 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 521 ->
+    | 435 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 159 ->
+    | 422 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 523 ->
+    | 424 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 137 ->
+    | 444 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 150 ->
+    | 445 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 166 ->
+    | 446 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 167 ->
+    | 449 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 158 ->
+    | 450 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 173 ->
+    | 478 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 152 ->
+    | 479 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 168 ->
+    | 482 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 169 ->
+    | 481 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 175 ->
+    | 447 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 177 ->
+    | 476 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 179 ->
+    | 448 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 437 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 438 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 439 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 440 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 441 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 536 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 515 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 516 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 517 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 518 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 519 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 520 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 529 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 532 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 524 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 525 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 547 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 181 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 183 ->
+    | 549 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 160 ->
+    | 159 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 170 ->
+    | 172 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 157 ->
+    | 188 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 163 ->
+    | 189 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 187 ->
+    | 180 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 92 ->
+    | 195 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 318 ->
+    | 174 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 319 ->
+    | 190 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 322 ->
+    | 191 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 323 ->
+    | 197 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 356 ->
+    | 199 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 351 ->
+    | 201 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 353 ->
+    | 203 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 93 ->
+    | 205 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 94 ->
+    | 182 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 338 ->
+    | 192 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 95 ->
+    | 179 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 96 ->
+    | 185 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 209 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 91 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 342 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
@@ -346,169 +316,231 @@ let message =
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 347 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 349 ->
+    | 371 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 97 ->
+    | 366 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 136 ->
+    | 368 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 92 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 93 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 362 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 94 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 95 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 144 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 145 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 148 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 149 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 364 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 96 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 158 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 100 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 217 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 218 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 220 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 221 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 224 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 225 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 358 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 353 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 355 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 101 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 195 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 196 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 198 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 199 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 202 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 203 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 334 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 329 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 331 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 102 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 350 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 336 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 338 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 103 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 326 ->
+    | 332 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 312 ->
+    | 330 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 314 ->
+    | 333 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 104 ->
+    | 334 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 308 ->
+    | 328 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 306 ->
+    | 156 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 105 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 320 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 321 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 322 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 323 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 324 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 137 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 138 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 139 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 140 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 151 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 106 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 107 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 309 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 310 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 304 ->
+    | 154 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 134 ->
+    | 177 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 106 ->
+    | 312 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 296 ->
+    | 315 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 297 ->
+    | 316 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 298 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 299 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 300 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 107 ->
+    | 133 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 108 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 285 ->
+    | 69 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 286 ->
+    | 70 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 132 ->
+    | 71 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 155 ->
+    | 72 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 79 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 80 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 75 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 76 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 77 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 109 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 110 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 111 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 112 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 114 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 117 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 230 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 231 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 269 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 293 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 270 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 272 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 273 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 294 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 300 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 299 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 303 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 302 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 240 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 283 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 284 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 287 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 288 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 291 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 292 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 128 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 110 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 113 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 208 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 209 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 247 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 271 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 248 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 250 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 251 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 272 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 278 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 277 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 281 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 280 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 218 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 261 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 262 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 265 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 266 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 269 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 255 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 257 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 219 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 244 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 245 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 253 ->
+    | 279 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 241 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 210 ->
+    | 266 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 267 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 275 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 211 ->
+    | 263 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 223 ->
+    | 232 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 224 ->
+    | 297 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 240 ->
+    | 233 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 225 ->
+    | 245 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 226 ->
+    | 246 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 234 ->
+    | 262 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 114 ->
+    | 247 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 248 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 256 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 118 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 206 ->
+    | 122 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 119 ->
+    | 228 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 125 ->
+    | 123 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 130 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | _ ->
         raise Not_found

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 *)
 %}
 
@@ -146,12 +113,21 @@ declaration:
   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","<string>") { $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;
@@ -268,21 +244,19 @@ 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
+  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;
+                  fun_name     = $2;
                   param        = $3;
                   colon        = $4;
                   ret_type     = $5;
@@ -290,14 +264,15 @@ open_fun_decl:
                   block_with   = Some ($7, $8);
                   return       = $9;
                   terminator   = None;
-                    attributes   = {value = []; region = Region.ghost}}
-    in {region; value} }
+                  attributes   = None}
+    in {region; value}
+  }
 | "function" fun_name parameters ":" type_expr "is" expr {
-    let fun_name = SyntaxError.check_reserved_name $2 in
+    Scoping.check_reserved_name $2;
     let stop   = expr_to_region $7 in
     let region = cover $1 stop
     and value  = {kwd_function = $1;
-                    fun_name;
+                  fun_name     = $2;
                   param        = $3;
                   colon        = $4;
                   ret_type     = $5;
@@ -305,39 +280,36 @@ open_fun_decl:
                   block_with   = None;
                   return       = $7;
                   terminator   = None;
-                    attributes   = {value = []; region = Region.ghost}}
+                  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} }
@@ -350,7 +322,7 @@ block:
      let statements, terminator = $2 in
      let region = cover $1 $3
      and value  = {opening = Begin $1;
-                   statements = attributes_to_statement statements;
+                   statements;
                    terminator;
                    closing = End $3}
      in {region; value}
@@ -359,15 +331,15 @@ block:
      let statements, terminator = $3 in
      let region = cover $1 $4
      and value  = {opening = Block ($1,$2);
-                   statements = attributes_to_statement statements;
+                   statements;
                    terminator;
                    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 *)
 

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
@@ -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 "<parameters>";
     pp_parameters state decl.param in
   let () =
-    let state = state#pad 5 2 in
+    let state = state#pad arity 2 in
     pp_node state "<return type>";
     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 "<body>";
     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 "<return>";
     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} ->

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_expr : state -> AST.expr -> unit

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 expr = AST.expr
     include Parser
   end
 
-module ExtParserLog =
+module ParserLog =
   struct
     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

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

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

src/passes/1-parser/pascaligo/SyntaxError.mli

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

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

src/passes/1-parser/pascaligo/check_dot_git_is_dir.sh

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

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,31 +53,20 @@
   (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)))
 
+;; 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)

src/passes/1-parser/pascaligo/pascaligo.ml

@@ -1,5 +1,5 @@
-module Parser = Parser
-module AST = AST
 module Lexer     = Lexer
 module LexToken  = LexToken
+module AST       = AST
+module Parser    = Parser
 module ParserLog = ParserLog

src/passes/1-parser/reasonligo.ml

@@ -6,18 +6,17 @@ 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
+           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
@@ -25,68 +24,58 @@ module Errors = struct
       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
+           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 parser_error source (start: Lexing.position)
+                     (end_: Lexing.position) lexbuf =
       let title () = "parser error" in
-    let file = if source = "" then
-        ""
+      let file =
+        if source = "" then ""
         else
-        Format.sprintf "In file \"%s|%s\"" start.pos_fname source
-    in
-    let str = Format.sprintf
+          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
+          file in
       let message () = str in
-    let loc = if start.pos_cnum = -1 then
-      Region.make
-        ~start: Pos.min
+      let loc =
+        if start.pos_cnum = -1
+        then Region.make
+               ~start:(Pos.min ~file:source)
                ~stop:(Pos.from_byte end_)
-    else
-      Region.make
+        else Region.make
                ~start:(Pos.from_byte start)
-        ~stop:(Pos.from_byte end_)
-    in 
+               ~stop:(Pos.from_byte end_) in
       let data =
-      [
-        ("parser_loc",
-          fun () -> Format.asprintf "%a" Location.pp_lift @@ loc
-        )
-      ]    
-    in
-    error ~data title message
+        [("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
-        ""
+      let file =
+        if source = "" then ""
         else
-        Format.sprintf "In file \"%s|%s\"" start.pos_fname source
-    in
-    let str = Format.sprintf
+          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
+          file in
       let message () = str in
       let loc = Region.make
                   ~start:(Pos.from_byte start)
-      ~stop:(Pos.from_byte end_)
-    in
+                  ~stop:(Pos.from_byte end_) in
       let data = [
           ("location",
-        fun () -> Format.asprintf "%a" Location.pp_lift @@ loc
-      )
-    ] in
-    error ~data title message
+           fun () -> Format.asprintf "%a" Location.pp_lift @@ loc)]
+      in error ~data title message
 
 end
 

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

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

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

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

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
+ *)

src/passes/1-parser/reasonligo/ParErr.ml

@@ -46,9 +46,9 @@ let message =
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 11 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 509 ->
+    | 528 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 503 ->
+    | 61 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 48 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
@@ -68,335 +68,387 @@ let message =
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 14 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 60 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 65 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 505 ->
+    | 70 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 145 ->
+    | 524 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 146 ->
+    | 185 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 144 ->
+    | 186 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 329 ->
+    | 184 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 331 ->
+    | 302 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 330 ->
+    | 304 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 61 ->
+    | 303 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 66 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 69 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 64 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 59 ->
+    | 183 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 143 ->
+    | 311 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 338 ->
+    | 313 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 340 ->
+    | 312 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 339 ->
+    | 191 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 151 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 152 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 78 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 325 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 327 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 326 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 92 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 155 ->
+    | 192 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 118 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 125 ->
+    | 298 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 87 ->
+    | 300 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 105 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 107 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 108 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 106 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 88 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 93 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 80 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 81 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 82 ->
+    | 299 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 132 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 334 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 336 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 335 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 133 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 136 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 137 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 157 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 159 ->
+    | 195 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 158 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 512 ->
+    | 165 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 218 ->
+    | 127 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 514 ->
+    | 145 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 216 ->
+    | 147 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 250 ->
+    | 148 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 248 ->
+    | 146 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 249 ->
+    | 128 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 230 ->
+    | 133 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 235 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 252 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 254 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 255 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 258 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 219 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 226 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 227 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 260 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 262 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 264 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 266 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 194 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 195 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 206 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 215 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 199 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 207 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 208 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 196 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 197 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 198 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 256 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 257 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 277 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 233 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 279 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 67 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 463 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 464 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 387 ->
+    | 120 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 121 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 122 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 120 ->
+    | 172 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 466 ->
+    | 307 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 467 ->
+    | 309 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 308 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 173 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 176 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 177 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 197 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 199 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 198 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 59 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 531 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 225 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 533 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 223 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 257 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 255 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 256 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 237 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 242 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 259 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 261 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 262 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 265 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 226 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 233 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 234 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 267 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 269 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 271 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 273 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 201 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 202 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 213 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 222 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 206 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 214 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 215 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 203 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 204 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 205 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 263 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 284 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 240 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 286 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 72 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 483 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 492 ->
+    | 484 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 469 ->
+    | 423 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 470 ->
+    | 161 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 468 ->
+    | 162 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 471 ->
+    | 160 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 472 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 473 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 475 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 476 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 477 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 478 ->
+    | 486 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 487 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 488 ->
+    | 504 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 474 ->
+    | 513 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 498 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 499 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 497 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 465 ->
+    | 488 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 321 ->
+    | 489 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 490 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 492 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 493 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 494 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 495 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 509 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 510 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 491 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 520 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 518 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 485 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 372 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 366 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 367 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 369 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 368 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 365 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 76 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 446 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 326 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 332 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 333 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 336 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 337 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 328 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 339 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 100 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 78 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 80 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 315 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 316 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 318 ->
+    | 117 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 317 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 314 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 71 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 410 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 298 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 304 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 305 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 308 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 309 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 300 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 178 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 73 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 75 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 419 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 420 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 77 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 160 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 412 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 413 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 415 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 416 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 193 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 229 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 74 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 447 ->
+    | 82 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 448 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 456 ->
+    | 449 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 457 ->
+    | 451 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 459 ->
+    | 452 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 200 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 236 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 79 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 467 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 468 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 476 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 477 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 479 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 480 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 469 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 470 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 81 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 460 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 449 ->
+    | 461 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 450 ->
+    | 455 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 76 ->
+    | 454 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 458 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 348 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 356 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 360 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 359 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 355 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 349 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 457 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 340 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 341 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 346 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 347 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 342 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 343 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 344 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 84 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 85 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 318 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 323 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 324 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 389 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 436 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 437 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 438 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 439 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 440 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 441 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 425 ->
+    | 435 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 422 ->
+    | 325 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 428 ->
+    | 362 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 429 ->
+    | 363 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 434 ->
+    | 373 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 438 ->
+    | 374 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 437 ->
+    | 413 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 433 ->
+    | 420 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 423 ->
+    | 408 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 427 ->
+    | 409 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 162 ->
+    | 407 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 163 ->
+    | 375 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 290 ->
+    | 376 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 295 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 296 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 357 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 400 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 401 ->
+    | 377 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 402 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
@@ -406,105 +458,69 @@ let message =
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 405 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 399 ->
+    | 417 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 297 ->
+    | 418 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 311 ->
+    | 401 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 312 ->
+    | 429 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 322 ->
+    | 427 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 323 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 377 ->
+    | 364 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 384 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 342 ->
+    | 385 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 343 ->
+    | 383 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 324 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 344 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 345 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 346 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 370 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 371 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 372 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 373 ->
+    | 378 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 379 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 380 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 369 ->
+    | 394 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 395 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 396 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 397 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 399 ->
+        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
+    | 398 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | 393 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 391 ->
+    | 320 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 313 ->
+    | 321 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 348 ->
+    | 86 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 349 ->
+    | 87 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 347 ->
+    | 88 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 350 ->
+    | 89 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 351 ->
+    | 90 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 352 ->
+    | 91 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 359 ->
+    | 96 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 360 ->
+    | 97 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 361 ->
+    | 98 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 362 ->
+    | 111 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 364 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 363 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 358 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 292 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 293 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 164 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 165 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 166 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 167 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 168 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 169 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 174 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 175 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 176 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 188 ->
-        "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
-    | 237 ->
+    | 244 ->
         "<YOUR SYNTAX ERROR MESSAGE HERE>\n"
     | _ ->
         raise Not_found

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,6 +244,7 @@ es6_func:
 
 let_binding:
   "<ident>" type_annotation? "=" expr {
+    Scoping.check_reserved_name $1;
     {binders = PVar $1, []; lhs_type=$2; eq=$3; let_rhs=$4}
   }
 | "_" type_annotation? "=" expr {
@@ -249,12 +254,15 @@ let_binding:
     {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 ->
@@ -468,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
@@ -555,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

src/passes/1-parser/reasonligo/ParserMain.ml

@@ -6,32 +6,37 @@ module IO =
     let options = EvalOpt.read "ReasonLIGO" ext
   end
 
-module ExtParser =
+module Parser =
   struct
     type ast  = AST.t
     type expr = AST.expr
     include Parser
   end
 
-module ExtParserLog =
+module ParserLog =
   struct
     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\
@@ -41,4 +46,61 @@ let () =
     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
+    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

src/passes/1-parser/reasonligo/dune

@@ -1,10 +1,16 @@
+;; 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))
 
+;; Build of the parser as a library
+
 (library
  (name parser_reasonligo)
  (public_name ligo.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 )))

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 [<option> ...] [<input>%s | \"-\"]\n" file extension;
-  printf "where <input>%s is the %s source file (default: stdin)," extension language;
+  printf "where <input>%s is the %s source file (default: stdin),\n" extension language;
   print "and each <option> (if any) is one of the following:";
   print "  -I <paths>             Library paths (colon-separated)";
-  print "  -c, --copy             Print lexemes of tokens and markup (lexer)";
-  print "  -t, --tokens           Print tokens (lexer)";
-  print "  -u, --units            Print tokens and markup (lexer)";
+  print "  -t, --tokens           Print tokens";
+  print "  -u, --units            Print lexical units";
+  print "  -c, --copy             Print lexemes and markup";
   print "  -q, --quiet            No output, except errors (default)";
   print "      --columns          Columns for source locations";
   print "      --bytes            Bytes for source locations";
   print "      --mono             Use Menhir monolithic API";
-  print "      --verbose=<stages> cmdline, cpp, ast-tokens, ast (colon-separated)";
+  print "      --expr             Parse an expression";
+  print "      --verbose=<stages> cli, cpp, ast-tokens, ast (colon-separated)";
   print "      --version          Commit hash on stdout";
   print "  -h, --help             This help";
   exit 0
@@ -74,6 +77,7 @@ and input    = ref None
 and libs     = ref []
 and verb_str = ref ""
 and mono     = ref false
+and expr     = ref false
 
 let split_at_colon = Str.(split (regexp ":"))
 
@@ -94,6 +98,7 @@ let specs language extension =
     noshort, "columns", set columns true, None;
     noshort, "bytes",   set bytes true, None;
     noshort, "mono",    set mono true, None;
+    noshort, "expr",    set expr true, None;
     noshort, "verbose", None, Some add_verbose;
     'h',     "help",    Some (help language extension), None;
     noshort, "version", Some version, None
@@ -129,7 +134,8 @@ let print_opt () =
   printf "quiet    = %b\n" !quiet;
   printf "columns  = %b\n" !columns;
   printf "bytes    = %b\n" !bytes;
-  printf "mono     = %b\b" !mono;
+  printf "mono     = %b\n" !mono;
+  printf "expr     = %b\n" !expr;
   printf "verbose  = %s\n" !verb_str;
   printf "input    = %s\n" (string_of quote !input);
   printf "libs     = %s\n" (string_of_path !libs)
@@ -137,7 +143,7 @@ let print_opt () =
 
 let check extension =
   let () =
-    if Utils.String.Set.mem "cmdline" !verbose then print_opt () in
+    if Utils.String.Set.mem "cli" !verbose then print_opt () in
 
   let input =
     match !input with
@@ -158,11 +164,12 @@ let check extension =
   and offsets = not !columns
   and mode    = if !bytes then `Byte else `Point
   and mono    = !mono
+  and expr    = !expr
   and verbose = !verbose
   and libs    = !libs in
 
   let () =
-    if Utils.String.Set.mem "cmdline" verbose then
+    if Utils.String.Set.mem "cli" verbose then
       begin
         printf "\nEXPORTED COMMAND LINE\n";
         printf "copy     = %b\n" copy;
@@ -172,6 +179,7 @@ let check extension =
         printf "offsets  = %b\n" offsets;
         printf "mode     = %s\n" (if mode = `Byte then "`Byte" else "`Point");
         printf "mono     = %b\n" mono;
+        printf "expr     = %b\n" expr;
         printf "verbose  = %s\n" !verb_str;
         printf "input    = %s\n" (string_of quote input);
         printf "libs     = %s\n" (string_of_path libs)
@@ -186,7 +194,7 @@ let check extension =
     | false, false, false,  true -> Tokens
     | _ -> abort "Choose one of -q, -c, -u, -t."
 
-  in make ~input ~libs ~verbose ~offsets ~mode ~cmd ~mono
+  in make ~input ~libs ~verbose ~offsets ~mode ~cmd ~mono ~expr
 
 (** {1 Parsing the command-line options} *)
 
@@ -195,7 +203,7 @@ let read language extension =
     Getopt.parse_cmdline (specs language extension) anonymous;
     (verb_str :=
        let apply e a =
-         if a <> "" then Printf.sprintf "%s, %s" e a else e
+         if a = "" then e else Printf.sprintf "%s, %s" e a
        in Utils.String.Set.fold apply !verbose "");
     check extension
   with Getopt.Error msg -> abort msg

src/passes/1-parser/shared/EvalOpt.mli

@@ -1,4 +1,4 @@
-(** Parsing the command-line options of PascaLIGO *)
+(** Parsing the command-line options of LIGO *)
 
 (** The type [command] denotes some possible behaviours of the
     compiler. The constructors are
@@ -23,12 +23,11 @@ type command = Quiet | Copy | Units | Tokens
 (** The type [options] gathers the command-line options.
     {ul
 
-      {li If the field [input] is [Some src], the name of the
-          PascaLIGO source file, with the extension ".ligo", is
-          [src]. If [input] is [Some "-"] or [None], the source file
-          is read from standard input.}
+      {li If the field [input] is [Some src], the name of the LIGO
+          source file is [src]. If [input] is [Some "-"] or [None],
+          the source file is read from standard input.}
 
-      {li The field [libs] is the paths where to find PascaLIGO files
+      {li The field [libs] is the paths where to find LIGO files
           for inclusion (#include).}
 
       {li The field [verbose] is a set of stages of the compiler
@@ -41,8 +40,14 @@ type command = Quiet | Copy | Units | Tokens
       {li If the value [mode] is [`Byte], then the unit in which
           source positions and regions are expressed in messages is
           the byte. If [`Point], the unit is unicode points.}
-    }
- *)
+
+      {li If the field [mono] is [true], then the monolithic API of
+          Menhir is called, otherwise the incremental API is.}
+
+      {li If the field [expr] is [true], then the parser for
+          expressions is used, otherwise a full-fledged contract is
+          expected.}
+} *)
 type options = <
   input   : string option;
   libs    : string list;
@@ -50,7 +55,8 @@ type options = <
   offsets : bool;
   mode    : [`Byte | `Point];
   cmd     : command;
-  mono    : bool
+  mono    : bool;
+  expr    : bool
 >
 
 val make :
@@ -61,6 +67,7 @@ val make :
   mode:[`Byte | `Point] ->
   cmd:command ->
   mono:bool ->
+  expr:bool ->
   options
 
 (** Parsing the command-line options on stdin.  The first parameter is

src/passes/1-parser/shared/Lexer.mli

@@ -77,8 +77,7 @@ module type TOKEN =
     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 *)
@@ -108,6 +107,8 @@ module type TOKEN =
      * a function [get_pos] that returns the current position, and
      * a function [get_last] that returns the region of the last
        recognised token.
+     * a function [get_file] that returns the name of the file being scanned
+       (empty string if [stdin]).
 
    Note that a module [Token] is exported too, because the signature
    of the exported functions depend on it.
@@ -140,6 +141,7 @@ module type S =
       get_win  : unit -> window;
       get_pos  : unit -> Pos.t;
       get_last : unit -> Region.t;
+      get_file : unit -> file_path;
       close    : unit -> unit
     }
 

src/passes/1-parser/shared/Lexer.mll

@@ -119,8 +119,7 @@ module type TOKEN =
     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 *)
@@ -164,6 +163,7 @@ module type S =
       get_win  : unit -> window;
       get_pos  : unit -> Pos.t;
       get_last : unit -> Region.t;
+      get_file : unit -> file_path;
       close    : unit -> unit
       }
 
@@ -177,7 +177,8 @@ module type S =
 
     exception Error of error Region.reg
 
-    val format_error : ?offsets:bool -> [`Byte | `Point] ->
+    val format_error :
+      ?offsets:bool -> [`Byte | `Point] ->
       error Region.reg -> file:bool -> string
   end
 
@@ -441,9 +442,9 @@ module Make (Token: TOKEN) : (S with module Token = Token) =
     exception Error of error Region.reg
 
     let format_error ?(offsets=true) mode Region.{region; value} ~file =
-      let  msg = error_to_string value in
-      let  reg = region#to_string ~file ~offsets mode in
-      sprintf "\027[31mLexical error %s:\n%s\027[0m%!" reg msg
+      let msg = error_to_string value
+      and reg = region#to_string ~file ~offsets mode
+      in sprintf "Lexical error %s:\n%s" reg msg
 
     let fail region value = raise (Error Region.{region; value})
 
@@ -530,17 +531,9 @@ module Make (Token: TOKEN) : (S with module Token = Token) =
         Ok token -> token, state
       | Error Token.Reserved_name -> fail region (Reserved_name lexeme)
 
-    let mk_attr state buffer attr = 
+    let mk_attr header attr state buffer =
       let region, _, state = sync state buffer in
-      match Token.mk_attr attr region with
-        Ok token -> 
-        token, state
-      | Error Token.Invalid_attribute -> 
-        fail region Invalid_attribute
-
-    let mk_attr2 state buffer attr = 
-      let region, _, state = sync state buffer in
-      match Token.mk_attr2 attr region with
+      match Token.mk_attr header attr region with
         Ok token ->
           token, state
       | Error Token.Invalid_attribute ->
@@ -579,6 +572,7 @@ let capital    = ['A'-'Z']
 let letter     = small | capital
 let ident      = small (letter | '_' | digit)*
 let constr     = capital (letter | '_' | digit)*
+let attr       = ident | constr
 let hexa_digit = digit | ['A'-'F']
 let byte       = hexa_digit hexa_digit
 let byte_seq   = byte | byte (byte | '_')* byte
@@ -586,8 +580,8 @@ let bytes      = "0x" (byte_seq? as seq)
 let esc        = "\\n" | "\\\"" | "\\\\" | "\\b"
                | "\\r" | "\\t" | "\\x" byte
 let pascaligo_sym = "=/=" | '#' | ":="
-let cameligo_sym = "<>" | "::" | "||" | "&&" | "[@"
-let reasonligo_sym = '!' | "=>" | "!=" | "==" | "++" | "..." | "||" | "&&" | "[@"
+let cameligo_sym = "<>" | "::" | "||" | "&&"
+let reasonligo_sym = '!' | "=>" | "!=" | "==" | "++" | "..." | "||" | "&&"
 
 let symbol =
   ';' | ',' | '(' | ')'| '[' | ']' | '{' | '}'
@@ -618,16 +612,19 @@ and scan state = parse
 | '\t'+                  { scan (push_tabs state lexbuf) lexbuf    }
 | ident                  { mk_ident        state lexbuf |> enqueue  }
 | constr                 { mk_constr       state lexbuf |> enqueue  }
-| bytes           { (mk_bytes seq) state lexbuf |> enqueue   }
+| bytes                  { mk_bytes seq    state lexbuf |> enqueue  }
 | natural 'n'            { mk_nat          state lexbuf |> enqueue  }
 | natural "mutez"        { mk_mutez        state lexbuf |> enqueue  }
-| natural "tz"    { mk_tz          state lexbuf |> enqueue   }
-| decimal "tz"    { mk_tz_decimal  state lexbuf |> enqueue   }
+| natural "tz"
+| natural "tez"          { mk_tz           state lexbuf |> enqueue  }
+| decimal "tz"
+| decimal "tez"          { mk_tz_decimal   state lexbuf |> enqueue  }
 | natural                { mk_int          state lexbuf |> enqueue  }
 | symbol                 { mk_sym          state lexbuf |> enqueue  }
 | eof                    { mk_eof          state lexbuf |> enqueue  }
-| "[@"  (ident|constr as attr) "]"  { mk_attr state lexbuf attr |> enqueue } 
-| "[@@" (ident|constr as attr) "]"  { mk_attr2 state lexbuf attr |> enqueue } 
+| "[@"  (attr as a) "]"  { mk_attr "[@"  a state lexbuf |> enqueue  }
+| "[@@" (attr as a) "]"  { mk_attr "[@@" a state lexbuf |> enqueue  }
+
 | '"'  { let opening, _, state = sync state lexbuf in
          let thread = {opening; len=1; acc=['"']} in
          scan_string thread state lexbuf |> mk_string |> enqueue }
@@ -676,8 +673,7 @@ and scan state = parse
     and file         = Filename.basename file in
     let pos          = state.pos#set ~file ~line ~offset:0 in
     let state        = {state with pos} in
-    scan state lexbuf
-  }
+    scan state lexbuf }
 
   (* Some special errors
 
@@ -864,6 +860,7 @@ type instance = {
   get_win  : unit -> window;
   get_pos  : unit -> Pos.t;
   get_last : unit -> Region.t;
+  get_file : unit -> file_path;
   close    : unit -> unit
 }
 
@@ -871,7 +868,7 @@ let open_token_stream file_path_opt =
   let  file_path = match file_path_opt with
                      None | Some "-" -> ""
                    | Some file_path  -> file_path in
-  let        pos = Pos.min#set_file file_path in
+  let        pos = Pos.min ~file:file_path in
   let    buf_reg = ref (pos#byte, pos#byte)
   and first_call = ref true
   and    decoder = Uutf.decoder ~encoding:`UTF_8 `Manual in
@@ -886,7 +883,8 @@ let open_token_stream file_path_opt =
 
   let get_pos  () = !state.pos
   and get_last () = !state.last
-  and get_win  () = !state.window in
+  and get_win  () = !state.window
+  and get_file () = file_path in
 
   let patch_buffer (start, stop) buffer =
     let open Lexing in
@@ -958,7 +956,7 @@ let open_token_stream file_path_opt =
                    None | Some "-" -> ()
                  | Some file_path  -> reset ~file:file_path buffer
   and close () = close_in cin in
-  {read = read_token; buffer; get_win; get_pos; get_last; close}
+  {read = read_token; buffer; get_win; get_pos; get_last; get_file; close}
 
 end (* of functor [Make] in HEADER *)
 (* END TRAILER *)

src/passes/1-parser/shared/LexerLog.ml

@@ -1,7 +1,5 @@
 (** Embedding the LIGO lexer in a debug module *)
 
-let sprintf = Printf.sprintf
-
 module type S =
   sig
     module Lexer : Lexer.S
@@ -15,12 +13,12 @@ module type S =
 
     val trace :
       ?offsets:bool -> [`Byte | `Point] ->
-      file_path option -> EvalOpt.command -> unit
+      file_path option -> EvalOpt.command ->
+      (unit, string) Stdlib.result
   end
 
 module Make (Lexer: Lexer.S) : (S with module Lexer = Lexer) =
   struct
-
     module Lexer = Lexer
     module Token = Lexer.Token
 
@@ -49,28 +47,29 @@ module Make (Lexer: Lexer.S) : (S with module Lexer = Lexer) =
 
     type file_path = string
 
-    let trace ?(offsets=true) mode file_path_opt command : unit =
+    let trace ?(offsets=true) mode file_path_opt command :
+          (unit, string) Stdlib.result =
       try
         let Lexer.{read; buffer; close; _} =
-          Lexer.open_token_stream file_path_opt
-        and cout = stdout in
-        let log = output_token ~offsets mode command cout
-        and close_all () = close (); close_out cout in
+          Lexer.open_token_stream file_path_opt in
+        let log = output_token ~offsets mode command stdout
+        and close_all () = close (); close_out stdout in
         let rec iter () =
           match read ~log buffer with
             token ->
-              if Token.is_eof token then close_all ()
+              if   Token.is_eof token
+              then Stdlib.Ok ()
               else iter ()
-          | exception Lexer.Error e ->
+          | exception Lexer.Error error ->
               let file =
                 match file_path_opt with
                   None | Some "-" -> false
                 |         Some _  -> true in
               let msg =
-                Lexer.format_error ~offsets mode e ~file
-              in prerr_string msg;
-                 close_all ()
-        in iter ()
-      with Sys_error msg -> Utils.highlight (sprintf "%s\n" msg)
+                Lexer.format_error ~offsets mode ~file error
+              in Stdlib.Error msg in
+          let result = iter ()
+          in (close_all (); result)
+      with Sys_error msg -> Stdlib.Error msg
 
   end

src/passes/1-parser/shared/LexerLog.mli

@@ -11,7 +11,8 @@ module type S =
 
     val trace :
       ?offsets:bool -> [`Byte | `Point] ->
-      file_path option -> EvalOpt.command -> unit
+      file_path option -> EvalOpt.command ->
+      (unit, string) Stdlib.result
   end
 
 module Make (Lexer: Lexer.S) : S with module Lexer = Lexer

src/passes/1-parser/shared/LexerUnit.ml

@@ -1,21 +1,20 @@
 (* Functor to build a standalone LIGO lexer *)
 
-module type S =
+module type IO =
   sig
     val ext : string              (* LIGO file extension *)
     val options : EvalOpt.options (* CLI options *)
   end
 
-module Make (IO: S) (Lexer: Lexer.S) =
+module Make (IO: IO) (Lexer: Lexer.S) =
   struct
     open Printf
+    module SSet = Utils.String.Set
+
     (* Error printing and exception tracing *)
 
     let () = Printexc.record_backtrace true
 
-    let external_ text =
-      Utils.highlight (sprintf "External error: %s" text); exit 1
-
     (*  Preprocessing the input source and opening the input channels *)
 
     (* Path for CPP inclusions (#include) *)
@@ -48,18 +47,62 @@ module Make (IO: S) (Lexer: Lexer.S) =
           sprintf "cpp -traditional-cpp%s %s > %s"
                   lib_path file pp_input
 
-    let () =
-      if Utils.String.Set.mem "cpp" IO.options#verbose
-      then eprintf "%s\n%!" cpp_cmd;
-      if Sys.command cpp_cmd <> 0 then
-        external_ (sprintf "the command \"%s\" failed." cpp_cmd)
-
     (* Running the lexer on the input file *)
 
+    let scan () : (Lexer.token list, string) Stdlib.result =
+      (* Preprocessing the input *)
+
+      if SSet.mem "cpp" IO.options#verbose
+      then eprintf "%s\n%!" cpp_cmd
+      else ();
+
+      if Sys.command cpp_cmd <> 0 then
+        let msg =
+          sprintf "External error: the command \"%s\" failed." cpp_cmd
+        in Stdlib.Error msg
+      else
+        try
+          let Lexer.{read; buffer; close; _} =
+            Lexer.open_token_stream (Some pp_input) in
+          let close_all () = close (); close_out stdout in
+          let rec read_tokens tokens =
+            match read ~log:(fun _ _ -> ()) buffer with
+              token ->
+                if   Lexer.Token.is_eof token
+                then Stdlib.Ok (List.rev tokens)
+                else read_tokens (token::tokens)
+            | exception Lexer.Error error ->
+                let file =
+                  match IO.options#input with
+                    None | Some "-" -> false
+                  |         Some _  -> true in
+                let msg =
+                  Lexer.format_error ~offsets:IO.options#offsets
+                                     IO.options#mode ~file error
+                in Stdlib.Error msg in
+          let result = read_tokens []
+          in close_all (); result
+        with Sys_error msg -> close_out stdout; Stdlib.Error msg
+
+    (* Tracing the lexing (effectful) *)
+
     module Log = LexerLog.Make (Lexer)
 
-    let () = Log.trace ~offsets:IO.options#offsets
-                       IO.options#mode (Some pp_input)
+    let trace () : (unit, string) Stdlib.result =
+      (* Preprocessing the input *)
+
+      if SSet.mem "cpp" IO.options#verbose
+      then eprintf "%s\n%!" cpp_cmd
+      else ();
+
+      if Sys.command cpp_cmd <> 0 then
+        let msg =
+          sprintf "External error: the command \"%s\" failed." cpp_cmd
+        in Stdlib.Error msg
+      else
+        Log.trace ~offsets:IO.options#offsets
+                  IO.options#mode
+                  (Some pp_input)
                   IO.options#cmd
 
   end

src/passes/1-parser/shared/LexerUnit.mli

@@ -0,0 +1,13 @@
+(* Functor to build a standalone LIGO lexer *)
+
+module type IO =
+  sig
+    val ext : string              (* LIGO file extension *)
+    val options : EvalOpt.options (* CLI options *)
+  end
+
+module Make (IO: IO) (Lexer: Lexer.S) :
+  sig
+    val scan  : unit -> (Lexer.token list, string) Stdlib.result
+    val trace : unit -> (unit, string) Stdlib.result
+  end

src/passes/1-parser/shared/Memo.ml

@@ -0,0 +1,163 @@
+module Region = Simple_utils.Region
+
+type macro = {
+  origin  : Region.t; (* Not ghost   *)
+  current : Region.t  (* Maybe ghost *)
+}
+
+type location =
+  Loc  of Region.t (* Not ghost *)
+| Link of macro
+
+(* Regions must not be ghosts and strings must not be empty. *)
+
+type valid_lexeme   = string Region.reg (* Not ghost, not empty.    *)
+type invalid_lexeme = string Region.reg (* Not ghost, empty if EOF. *)
+
+type phase =
+  Lexer
+| Parser  of valid_lexeme option * invalid_lexeme
+| Scoping
+
+type error = <
+  location : location;
+  message  : string;   (* Sentence ending with a period *)
+  hint     : string;   (* Suggestion to solve the issue *)
+  help     : string    (* Off-program help *)
+>
+
+type invalid_error = Ghost_region
+
+let check_loc = function
+  Loc reg ->
+    if reg#is_ghost then
+      Stdlib.Error Ghost_region
+    else Ok ()
+| Link {origin; _} ->
+    if origin#is_ghost then
+      Stdlib.Error Ghost_region
+    else Ok ()
+
+let make_error ~location ~message ~hint ~help =
+  match check_loc location with
+    Stdlib.Ok () ->
+      Ok (object
+            method location = location
+            method message  = message
+            method hint     = hint
+            method help     = help
+          end)
+  | Error _ as e -> e
+
+type warning = <
+  location : location;
+  message  : string;   (* Sentence ending with a period *)
+  hint     : string;   (* Idem *)
+>
+
+type invalid_warning = invalid_error
+
+let make_warning ~location ~message ~hint =
+  match check_loc location with
+    Stdlib.Ok () ->
+      Ok (object
+            method location = location
+            method message  = message
+            method hint     = hint
+            method help     = help
+          end)
+  | Error _ as e -> e
+
+type kind =
+  Error    of error   (* Failure of an external invariant *)
+| Internal of string  (* Failure of an internal invariant *)
+| External of string  (* Failure of an external process   *)
+| Warning  of warning
+| Info     of (unit -> string)  (* Log *)
+
+type entry = <
+  phase : phase;
+  kind  : kind
+>
+
+type invalid_entry =
+  Ghost_lexeme
+| Empty_lexeme
+
+let check_phase = function
+  Parser (Some valid_lexeme, invalid_lexeme) ->
+    let open Region in
+    if  valid_lexeme.region#is_ghost
+    ||  invalid_lexeme.region#is_ghost
+    then Stdlib.Error Ghost_lexeme
+    else if valid_lexeme.value = ""
+    then Stdlib.Error Empty_lexeme
+    else Ok ()
+| Parser (None, invalid_lexeme) ->
+    if   invalid_lexeme.region#is_ghost
+    then Stdlib.Error Ghost_lexeme
+    else Ok ()
+| Lexer
+| Scoping -> Ok ()
+
+let make_entry ~phase ~kind =
+  match check_phase phase with
+    Stdlib.Error _ as e -> e
+  | Ok () -> Ok (object
+                  method phase = phase
+                  method kind  = kind
+                end)
+
+type memo = <
+  mode    : [`Byte | `Point]; (* Bytes vs UTF-8 *)
+  offsets : bool;             (* [true] for horizontal offsets *)
+  log     : entry FQueue.t
+>
+
+type t = memo
+
+let empty_memo ~mode ~offsets : memo =
+  object
+    method mode          = mode
+    method offsets       = offsets
+    method log           = FQueue.empty
+    method enqueue entry = {< log = FQueue.enq entry log >}
+    method dequeue       =
+      match FQueue.deq log with
+                     None -> None
+      | Some (log, entry) -> Some ({< log=log >}, entry)
+  end
+
+let sprintf = Printf.sprintf
+
+let string_of_entry ~(file:bool) entry : string =
+  let reg = entry#region#to_string
+              ~file
+              ~offsets:entry#offsets
+              error#mode in
+  let string =
+    match error#phase with
+      Parser (None, invalid_lexeme) ->
+       (match invalid_lexeme.Region.value with
+              "" -> sprintf "Parse error %s" reg (* EOF *)
+        | lexeme -> sprintf "Parse error %s, before \"%s\""
+                           reg lexeme)
+    | Parser (Some valid_lexeme, invalid_lexeme) ->
+       let string =
+         sprintf "Parse error %s, after \"%s\""
+                 reg valid_lexeme.Region.value in
+       (match invalid_lexeme.Region.value with
+              "" -> string (* EOF *)
+        | lexeme -> sprintf "%s and before \"%s\"" string lexeme)
+    | Lexer ->
+        sprintf "Lexical error %s" reg
+    | Scoping ->
+       sprintf "Scoping error %s" reg in
+  let string =
+    string
+    ^ (if error#message = "" then "."
+       else ":\n" ^ error#message) ^ "\n" in
+  let string =
+    string ^ (if error#hint = "" then ""
+              else sprintf "Hint: %s\n" error#hint)
+  in string

src/passes/1-parser/shared/Memo.mli

@@ -0,0 +1,120 @@
+(* This module defines compilation memos. *)
+
+(* Locations *)
+
+module Region = Simple_utils.Region
+
+type macro = private <
+  origin  : Region.t; (* Not ghost   *)
+  current : Region.t  (* Maybe ghost *)
+>
+
+type location = private
+  Loc  of Region.t (* Not ghost *)
+| Link of macro
+
+type invalid_loc = Ghost_region
+
+val make_loc :
+  Region.t -> (location, invalid_loc) Stdlib.result
+
+val make_link :
+  origin:Region.t ->
+  current:Region.t ->
+  (location, invalid_loc) Stdlib.result
+
+type 'a located = <
+  value    : 'a;
+  location : location
+>
+
+val make_located : value:'a -> location:location -> 'a located
+
+(* Lexemes *)
+
+type lexeme = string location (* Not ghost, empty => EOF *)
+
+type window = <
+  valid_lexeme   : lexeme option;
+  invalid_lexeme : lexeme
+>
+
+val make_window : ?valid:lexeme -> invalid:lexeme -> window
+
+(* Compilation phases *)
+
+type phase =
+  Lexer
+| Parser  of window
+| Scoping
+
+(* Messages *)
+
+type message = private string
+
+type invalid_message = Empty_message
+
+val make_message : string -> (message, invalid_error) Stdlib.result
+val string_of_message : message -> string
+
+(* Errors *)
+
+type error = <
+  location : location;
+  message  : message;  (* Non-empty string (ending with a period)      *)
+  hint     : string;   (* Suggestion to solve the issue (may be empty) *)
+  help     : string    (* Off-program help (may be empty)              *)
+>
+
+val make_error :
+  location:location ->
+  message:message ->
+  hint:string ->
+  help:string ->
+  error
+
+(* Warnings *)
+
+type warning = <
+  location : location;
+  message  : message;  (* Non-empty string (ending with a period) *)
+  hint     : string;   (* May empty *)
+>
+
+val make_warning :
+  location:location ->
+  message:message ->
+  hint:string ->
+  warning
+
+(* Kinds of entries *)
+
+type kind =
+  Error    of error   (* Failure of an external invariant             *)
+| Internal of message (* Failure of an internal invariant (non-empty) *)
+| External of message (* Failure of an external process (non-empty)   *)
+| Warning  of warning
+| Info     of (unit -> message)  (* Log (not-empty) *)
+
+type entry = private <
+  phase : phase;
+  kind  : kind
+>
+
+val make_entry : phase:phase -> kind:kind -> entry
+
+val string_of_entry : file:bool -> entry -> string
+
+(* Memos *)
+
+type memo = <
+  mode    : [`Byte | `Point]; (* Bytes vs UTF-8 *)
+  offsets : bool;             (* [true] for horizontal offsets *)
+  log     : entry FQueue.t;
+  enqueue : entry -> memo;
+  dequeue : (memo * entry) option
+>
+
+type t = memo
+
+val empty_memo : mode:[`Byte | `Point] -> offsets:bool -> memo

src/passes/1-parser/shared/ParserAPI.ml

@@ -77,28 +77,6 @@ module Make (Lexer: Lexer.S)
 
     exception Point of error
 
-    let failure get_win checkpoint =
-      let message = ParErr.message (state checkpoint) in
-      match get_win () with
-        Lexer.Nil -> assert false
-      | Lexer.One invalid ->
-          raise (Point (message, None, invalid))
-      | Lexer.Two (invalid, valid) ->
-          raise (Point (message, Some valid, invalid))
-
-    (* The two Menhir APIs are called from the following two functions. *)
-
-    let incr_contract Lexer.{read; buffer; get_win; close; _} : Parser.ast =
-      let supplier = I.lexer_lexbuf_to_supplier read buffer
-      and failure  = failure get_win in
-      let parser   = Parser.Incremental.contract buffer.Lexing.lex_curr_p in
-      let ast      = I.loop_handle success failure supplier parser
-      in close (); ast
-
-    let mono_contract = Parser.contract
-
-    (* Errors *)
-
     let format_error ?(offsets=true) mode (msg, valid_opt, invalid) =
       let invalid_region = Lexer.Token.to_region invalid in
       let header =
@@ -119,9 +97,37 @@ module Make (Lexer: Lexer.S)
       let header = header ^ trailer in
       header ^ (if msg = "" then ".\n" else ":\n" ^ msg)
 
-    let short_error ?(offsets=true) mode msg (invalid_region: Region.t) =
-      let () = assert (not (invalid_region#is_ghost)) in
-      let header =
-        "Parse error " ^ invalid_region#to_string ~offsets mode in
-      header ^ (if msg = "" then ".\n" else ":\n" ^ msg)
+    let failure get_win checkpoint =
+      let message = ParErr.message (state checkpoint) in
+      match get_win () with
+        Lexer.Nil -> assert false
+      | Lexer.One invalid ->
+          raise (Point (message, None, invalid))
+      | Lexer.Two (invalid, valid) ->
+          raise (Point (message, Some valid, invalid))
+
+    (* The monolithic API of Menhir *)
+
+    let mono_contract = Parser.contract
+
+    let mono_expr = Parser.interactive_expr
+
+    (* Incremental API of Menhir *)
+
+    module Incr = Parser.Incremental
+
+    let incr_contract Lexer.{read; buffer; get_win; close; _} =
+      let supplier = I.lexer_lexbuf_to_supplier read buffer
+      and failure  = failure get_win in
+      let parser   = Incr.contract buffer.Lexing.lex_curr_p in
+      let ast      = I.loop_handle success failure supplier parser
+      in close (); ast
+
+    let incr_expr  Lexer.{read; buffer; get_win; close; _} =
+      let supplier = I.lexer_lexbuf_to_supplier read buffer
+      and failure  = failure get_win in
+      let parser   = Incr.interactive_expr buffer.Lexing.lex_curr_p in
+      let expr     = I.loop_handle success failure supplier parser
+      in close (); expr
+
   end

src/passes/1-parser/shared/ParserAPI.mli

@@ -2,6 +2,9 @@
 
 module Region = Simple_utils.Region
 
+(* The signature generated by Menhir with additional type definitions
+   for [ast] and [expr]. *)
+
 module type PARSER =
   sig
     (* The type of tokens. *)
@@ -16,8 +19,10 @@ module type PARSER =
 
     (* The monolithic API. *)
 
-    val interactive_expr : (Lexing.lexbuf -> token) -> Lexing.lexbuf -> expr
-    val contract : (Lexing.lexbuf -> token) -> Lexing.lexbuf -> ast
+    val interactive_expr :
+      (Lexing.lexbuf -> token) -> Lexing.lexbuf -> expr
+    val contract :
+      (Lexing.lexbuf -> token) -> Lexing.lexbuf -> ast
 
     (* The incremental API. *)
 
@@ -42,14 +47,15 @@ module Make (Lexer: Lexer.S)
             (Parser: PARSER with type token = Lexer.Token.token)
             (ParErr: sig val message : int -> string end) :
   sig
-    (* Monolithic and incremental APIs of Menhir for parsing *)
+    (* The monolithic API of Menhir *)
 
     val mono_contract :
       (Lexing.lexbuf -> Lexer.token) -> Lexing.lexbuf -> Parser.ast
-    val incr_contract :
-      Lexer.instance -> Parser.ast
 
-    (* Error handling *)
+    val mono_expr :
+      (Lexing.lexbuf -> Lexer.token) -> Lexing.lexbuf -> Parser.expr
+
+    (* Incremental API of Menhir *)
 
     type message = string
     type valid   = Parser.token
@@ -58,9 +64,8 @@ module Make (Lexer: Lexer.S)
 
     exception Point of error
 
-    val format_error :
-      ?offsets:bool -> [`Byte | `Point] -> error -> string
+    val incr_contract : Lexer.instance -> Parser.ast
+    val incr_expr     : Lexer.instance -> Parser.expr
 
-    val short_error :
-      ?offsets:bool -> [`Byte | `Point] -> message -> Region.t -> string
+    val format_error : ?offsets:bool -> [`Point | `Byte] -> error -> string
   end

src/passes/1-parser/shared/ParserUnit.ml

@@ -1,6 +1,8 @@
 (* Functor to build a standalone LIGO parser *)
 
-module type S =
+module Region = Simple_utils.Region
+
+module type IO =
   sig
     val ext : string              (* LIGO file extension *)
     val options : EvalOpt.options (* CLI options *)
@@ -10,40 +12,35 @@ module type Pretty =
   sig
     type state
     type ast
-    val pp_ast :
-      state -> ast -> unit
+    type expr
+
     val mk_state :
       offsets:bool -> mode:[`Point|`Byte] -> buffer:Buffer.t -> state
-    val print_tokens :
-      state -> ast -> unit
+
+    val pp_ast       : state -> ast -> unit
+    val pp_expr      : state -> expr -> unit
+    val print_tokens : state -> ast -> unit
+    val print_expr   : state -> expr -> unit
   end
 
-module Make (IO: S)
-            (Lexer: Lexer.S)
+module Make (Lexer: Lexer.S)
             (AST: sig type t type expr end)
             (Parser: ParserAPI.PARSER
                      with type ast   = AST.t
                       and type expr  = AST.expr
                       and type token = Lexer.token)
             (ParErr: sig val message : int -> string end)
-            (ParserLog: Pretty with type ast = AST.t) =
+            (ParserLog: Pretty with type ast  = AST.t
+                                and type expr = AST.expr)
+            (IO: IO) =
   struct
     open Printf
+    module SSet = Utils.String.Set
 
     (* Error printing and exception tracing *)
 
     let () = Printexc.record_backtrace true
 
-    let external_ text =
-      Utils.highlight (sprintf "External error: %s" text); exit 1
-
-    (* Extracting the input file *)
-
-    let file =
-      match IO.options#input with
-        None | Some "-" -> false
-      |          Some _ -> true
-
     (* Preprocessing the input source and opening the input channels *)
 
     (* Path for CPP inclusions (#include) *)
@@ -62,9 +59,10 @@ module Make (IO: S)
     let suffix = ".pp" ^ IO.ext
 
     let pp_input =
-      if Utils.String.Set.mem "cpp" IO.options#verbose
+      if SSet.mem "cpp" IO.options#verbose
       then prefix ^ suffix
-      else let pp_input, pp_out = Filename.open_temp_file prefix suffix
+      else let pp_input, pp_out =
+             Filename.open_temp_file prefix suffix
            in close_out pp_out; pp_input
 
     let cpp_cmd =
@@ -76,100 +74,161 @@ module Make (IO: S)
           sprintf "cpp -traditional-cpp%s %s > %s"
                   lib_path file pp_input
 
-    let () =
-      if Utils.String.Set.mem "cpp" IO.options#verbose
-      then eprintf "%s\n%!" cpp_cmd;
-      if Sys.command cpp_cmd <> 0 then
-        external_ (sprintf "the command \"%s\" failed." cpp_cmd)
+    (* Error handling (reexported from [ParserAPI]) *)
 
-    (* Instanciating the lexer *)
+    type message = string
+    type valid   = Parser.token
+    type invalid = Parser.token
+    type error   = message * valid option * invalid
 
-    module ParserFront = ParserAPI.Make (Lexer) (Parser) (ParErr)
+    exception Point of error
 
-    let format_error = ParserFront.format_error
-    let short_error = ParserFront.short_error
+    (* Instantiating the parser *)
 
-    let lexer_inst = Lexer.open_token_stream (Some pp_input)
-    let Lexer.{read; buffer; get_win; get_pos; get_last; close} = lexer_inst
+    module Front = ParserAPI.Make (Lexer)(Parser)(ParErr)
 
-    and cout = stdout
+    let format_error = Front.format_error
 
-    let close_all () = close (); close_out cout
+    let short_error ?(offsets=true) mode msg (reg: Region.t) =
+      sprintf "Parse error %s:\n%s" (reg#to_string ~offsets mode) msg
 
-    (* Tokeniser *)
+    (* Parsing an expression *)
 
-    module Log = LexerLog.Make (Lexer)
-
-    let log = Log.output_token ~offsets:IO.options#offsets
-                               IO.options#mode IO.options#cmd cout
-
-    let tokeniser = read ~log
-
-    (* Main *)
-
-    let run () =
+    let parse_expr lexer_inst tokeniser output state :
+          (AST.expr, string) Stdlib.result =
+      let close_all () =
+        lexer_inst.Lexer.close (); close_out stdout in
+      let lexbuf = lexer_inst.Lexer.buffer in
+      let expr =
         try
+          if IO.options#mono then
+            Front.mono_expr tokeniser lexbuf
+          else
+            Front.incr_expr lexer_inst
+        with exn -> close_all (); raise exn in
+      let () =
+        if SSet.mem "ast-tokens" IO.options#verbose then
+          begin
+            Buffer.clear output;
+            ParserLog.print_expr state expr;
+            Buffer.output_buffer stdout output
+          end in
+      let () =
+        if SSet.mem "ast" IO.options#verbose then
+          begin
+            Buffer.clear output;
+            ParserLog.pp_expr state expr;
+            Buffer.output_buffer stdout output
+          end
+      in close_all (); Ok expr
+
+    (* Parsing a contract *)
+
+    let parse_contract lexer_inst tokeniser output state
+        : (AST.t, string) Stdlib.result =
+      let close_all () =
+        lexer_inst.Lexer.close (); close_out stdout in
+      let lexbuf = lexer_inst.Lexer.buffer in
       let ast =
-          if   IO.options#mono
-          then ParserFront.mono_contract tokeniser buffer
-          else ParserFront.incr_contract lexer_inst in
-        if Utils.String.Set.mem "ast" IO.options#verbose
-        then let buffer = Buffer.create 131 in
-             let state = ParserLog.mk_state
-                           ~offsets:IO.options#offsets
-                           ~mode:IO.options#mode
-                           ~buffer in
-             begin
-               ParserLog.pp_ast state ast;
-               Buffer.output_buffer stdout buffer
-             end
-        else if Utils.String.Set.mem "ast-tokens" IO.options#verbose
-        then let buffer = Buffer.create 131 in
-             let state = ParserLog.mk_state
-                           ~offsets:IO.options#offsets
-                           ~mode:IO.options#mode
-                           ~buffer in
+        try
+          if IO.options#mono then
+            Front.mono_contract tokeniser lexbuf
+          else
+            Front.incr_contract lexer_inst
+        with exn -> close_all (); raise exn in
+      let () =
+        if SSet.mem "ast-tokens" IO.options#verbose then
           begin
+            Buffer.clear output;
             ParserLog.print_tokens state ast;
-               Buffer.output_buffer stdout buffer
+            Buffer.output_buffer stdout output
+          end in
+      let () =
+        if SSet.mem "ast" IO.options#verbose then
+          begin
+            Buffer.clear output;
+            ParserLog.pp_ast state ast;
+            Buffer.output_buffer stdout output
           end
-      with
+      in close_all (); Ok ast
+
+    (* Wrapper for the parsers above *)
+
+    let parse parser =
+      (* Preprocessing the input *)
+
+      if SSet.mem "cpp" IO.options#verbose
+      then eprintf "%s\n%!" cpp_cmd
+      else ();
+
+      if Sys.command cpp_cmd <> 0 then
+        let msg =
+          sprintf "External error: \"%s\" failed." cpp_cmd
+        in Stdlib.Error msg
+      else
+        (* Instantiating the lexer *)
+
+        let lexer_inst = Lexer.open_token_stream (Some pp_input) in
+
+        (* Making the tokeniser *)
+
+        let module Log = LexerLog.Make (Lexer) in
+
+        let log =
+          Log.output_token ~offsets:IO.options#offsets
+                           IO.options#mode IO.options#cmd stdout in
+
+        let tokeniser = lexer_inst.Lexer.read ~log in
+
+        let output = Buffer.create 131 in
+        let state = ParserLog.mk_state
+                      ~offsets:IO.options#offsets
+                      ~mode:IO.options#mode
+                      ~buffer:output in
+
+        (* Calling the specific parser (that is, the parameter) *)
+
+        match parser lexer_inst tokeniser output state with
+          Stdlib.Error _ as error -> error
+        | Stdlib.Ok _ as node -> node
+
         (* Lexing errors *)
 
-        Lexer.Error err ->
-          close_all ();
-          let msg =
+        | exception Lexer.Error err ->
+            let file =
+              match IO.options#input with
+                None | Some "-" -> false
+              |          Some _ -> true in
+            let error =
               Lexer.format_error ~offsets:IO.options#offsets
                                  IO.options#mode err ~file
-          in prerr_string msg
+            in Stdlib.Error error
 
         (* Incremental API of Menhir *)
 
-      | ParserFront.Point point ->
-          let () = close_all () in
+        | exception Front.Point point ->
             let error =
-            ParserFront.format_error ~offsets:IO.options#offsets
+              Front.format_error ~offsets:IO.options#offsets
                                  IO.options#mode point
-          in eprintf "\027[31m%s\027[0m%!" error
+            in Stdlib.Error error
 
         (* Monolithic API of Menhir *)
 
-      | Parser.Error ->
-          let () = close_all () in
+        | exception Parser.Error ->
             let invalid, valid_opt =
-           match get_win () with
+              match lexer_inst.Lexer.get_win () with
                 Lexer.Nil ->
                   assert false (* Safe: There is always at least EOF. *)
               | Lexer.One invalid -> invalid, None
               | Lexer.Two (invalid, valid) -> invalid, Some valid in
             let point = "", valid_opt, invalid in
             let error =
-            ParserFront.format_error ~offsets:IO.options#offsets
+              Front.format_error ~offsets:IO.options#offsets
                                  IO.options#mode point
-          in eprintf "\027[31m%s\027[0m%!" error
+            in Stdlib.Error error
 
         (* I/O errors *)
 
-      | Sys_error msg -> Utils.highlight msg
+        | exception Sys_error error -> Stdlib.Error error
 
   end

src/passes/1-parser/shared/ParserUnit.mli

@@ -0,0 +1,71 @@
+(* Functor to build a standalone LIGO parser *)
+
+module Region = Simple_utils.Region
+
+module type IO =
+  sig
+    val ext : string              (* LIGO file extension *)
+    val options : EvalOpt.options (* CLI options *)
+  end
+
+module type Pretty =
+  sig
+    type state
+    type ast
+    type expr
+
+    val mk_state :
+      offsets:bool -> mode:[`Point|`Byte] -> buffer:Buffer.t -> state
+
+    val pp_ast       : state -> ast -> unit
+    val pp_expr      : state -> expr -> unit
+    val print_tokens : state -> ast -> unit
+    val print_expr   : state -> expr -> unit
+  end
+
+module Make (Lexer: Lexer.S)
+            (AST: sig type t type expr end)
+            (Parser: ParserAPI.PARSER
+                     with type ast   = AST.t
+                      and type expr  = AST.expr
+                      and type token = Lexer.token)
+            (ParErr: sig val message : int -> string end)
+            (ParserLog: Pretty with type ast  = AST.t
+                                and type expr = AST.expr)
+            (IO: IO) :
+  sig
+    (* Error handling (reexported from [ParserAPI]) *)
+
+    type message = string
+    type valid   = Parser.token
+    type invalid = Parser.token
+    type error   = message * valid option * invalid
+
+    exception Point of error
+
+    val format_error :
+      ?offsets:bool -> [`Byte | `Point] -> error -> string
+
+    val short_error :
+      ?offsets:bool -> [`Point | `Byte] -> string -> Region.t -> string
+
+    (* Parsers *)
+
+    val parse :
+      (Lexer.instance ->
+       (Lexing.lexbuf -> Lexer.token) ->
+       Buffer.t -> ParserLog.state -> ('a, string) result) ->
+      ('a, string) result
+
+    val parse_contract :
+      Lexer.instance ->
+      (Lexing.lexbuf -> Lexer.token) ->
+      Buffer.t -> ParserLog.state ->
+      (AST.t, string) Stdlib.result
+
+    val parse_expr :
+      Lexer.instance ->
+      (Lexing.lexbuf -> Lexer.token) ->
+      Buffer.t -> ParserLog.state -> (AST.expr, string) Stdlib.result
+
+  end

src/passes/2-simplify/dune

@@ -12,8 +12,5 @@
   (preprocess
     (pps
       ppx_let
-      bisect_ppx --conditional
-    )
-  )
-  (flags (:standard -w +1..62-4-9-44-40-42-48-30@39@33 -open Simple_utils ))
-)
+      bisect_ppx --conditional))
+  (flags (:standard -w +1..62-4-9-44-40-42-48-30@39@33 -open Simple_utils)))

src/passes/2-simplify/pascaligo.ml

@@ -4,13 +4,14 @@ open Ast_simplified
 module Raw = Parser.Pascaligo.AST
 module SMap = Map.String
 module SSet = Set.Make (String)
+module ParserLog = Parser_pascaligo.ParserLog
 
 open Combinators
 
 let nseq_to_list (hd, tl) = hd :: tl
 let npseq_to_list (hd, tl) = hd :: (List.map snd tl)
 let pseq_to_list = function
-  | None -> []
+  None -> []
 | Some lst -> npseq_to_list lst
 let get_value : 'a Raw.reg -> 'a = fun x -> x.value
 let is_compiler_generated name = String.contains (Var.to_name name) '#'
@@ -132,7 +133,7 @@ module Errors = struct
        fun () -> Format.asprintf "%a" Location.pp_lift @@ pattern_loc) ;
       (** TODO: The labelled arguments should be flowing from the CLI. *)
       ("pattern",
-       fun () -> Parser.Pascaligo.ParserLog.pattern_to_string
+       fun () -> ParserLog.pattern_to_string
                 ~offsets:true ~mode:`Point p)
     ] in
     error ~data title message
@@ -168,7 +169,7 @@ module Errors = struct
     (** TODO: The labelled arguments should be flowing from the CLI. *)
     let data = [
       ("instruction",
-       fun () -> Parser.Pascaligo.ParserLog.instruction_to_string
+       fun () -> ParserLog.instruction_to_string
                 ~offsets:true ~mode:`Point t)
     ] in
     error ~data title message
@@ -562,10 +563,11 @@ and simpl_tuple_expression ?loc (lst:Raw.expr list) : expression result =
   | [] -> return @@ e_literal Literal_unit
   | [hd] -> simpl_expression hd
   | lst ->
-      let%bind lst = bind_list @@ List.map simpl_expression lst in
-      return @@ e_tuple ?loc lst
+      let%bind lst = bind_list @@ List.map simpl_expression lst
+      in return @@ e_tuple ?loc lst
 
-and simpl_data_declaration : Raw.data_decl -> _ result = fun t ->
+and simpl_data_declaration : Raw.data_decl -> _ result =
+  fun t ->
   match t with
   | LocalVar x ->
       let (x , loc) = r_split x in
@@ -578,15 +580,26 @@ and simpl_data_declaration : Raw.data_decl -> _ result = fun t ->
       let name = x.name.value in
       let%bind t = simpl_type_expression x.const_type in
       let%bind expression = simpl_expression x.init in
-      let inline = List.exists (fun (f: Raw.attribute) -> f.value = "\"inline\"") x.attributes.value in
-      return_let_in ~loc (Var.of_name name , Some t) inline expression
+      let inline =
+        match x.attributes with
+          None -> false
+        | Some {value; _} ->
+           npseq_to_list value.ne_elements
+           |> List.exists (fun Region.{value; _} -> value = "\"inline\"")
+      in return_let_in ~loc (Var.of_name name, Some t) inline expression
   | LocalFun f  ->
       let (f , loc) = r_split f in
       let%bind (binder, expr) = simpl_fun_decl ~loc f in
-      let inline = List.exists (fun (f: Raw.attribute) -> f.value = "\"inline\"") f.attributes.value in      
-      return_let_in ~loc binder inline expr
+      let inline =
+        match f.attributes with
+          None -> false
+        | Some {value; _} ->
+           npseq_to_list value.ne_elements
+           |> List.exists (fun Region.{value; _} -> value = "\"inline\"")
+      in return_let_in ~loc binder inline expr
 
-and simpl_param : Raw.param_decl -> (expression_variable * type_expression) result =
+and simpl_param :
+      Raw.param_decl -> (expression_variable * type_expression) result =
   fun t ->
   match t with
   | ParamConst c ->
@@ -601,11 +614,18 @@ and simpl_param : Raw.param_decl -> (expression_variable * type_expression) resu
       ok (type_name , type_expression)
 
 and simpl_fun_decl :
-  loc:_ -> Raw.fun_decl -> ((expression_variable * type_expression option) * expression) result =
+      loc:_ -> Raw.fun_decl ->
+      ((expression_variable * type_expression option) * expression) result =
   fun ~loc x ->
   let open! Raw in
-  let {fun_name;param;ret_type;block_with;return; attributes} : fun_decl = x in
-  let inline = List.exists (fun (a: Raw.attribute) -> a.value = "\"inline\"") attributes.value in
+  let {fun_name; param; ret_type; block_with;
+       return; attributes} : fun_decl = x in
+  let inline =
+    match attributes with
+      None -> false
+    | Some {value; _} ->
+       npseq_to_list value.ne_elements
+       |> List.exists (fun Region.{value; _} -> value = "\"inline\"") in
   let statements =
     match block_with with
     | Some (block,_) -> npseq_to_list block.value.statements
@@ -615,9 +635,7 @@ and simpl_fun_decl :
      a, [] -> (
        let%bind input = simpl_param a in
        let (binder , input_type) = input in
-       let%bind instructions = bind_list
-         @@ List.map simpl_statement
-         @@ statements in
+       let%bind instructions = simpl_statement_list statements in
        let%bind result = simpl_expression return in
        let%bind output_type = simpl_type_expression ret_type in
        let body = instructions in
@@ -647,9 +665,7 @@ and simpl_fun_decl :
            ass
          in
          bind_list @@ List.mapi aux params in
-       let%bind instructions = bind_list
-         @@ List.map simpl_statement
-         @@ statements in
+       let%bind instructions = simpl_statement_list statements in
        let%bind result = simpl_expression return in
        let%bind output_type = simpl_type_expression ret_type in
        let body = tpl_declarations @ instructions in
@@ -673,9 +689,7 @@ and simpl_fun_expression :
      a, [] -> (
        let%bind input = simpl_param a in
        let (binder , input_type) = input in
-       let%bind instructions = bind_list
-         @@ List.map simpl_statement
-         @@ statements in
+       let%bind instructions = simpl_statement_list statements in
        let%bind result = simpl_expression return in
        let%bind output_type = simpl_type_expression ret_type in
        let body = instructions in
@@ -705,9 +719,7 @@ and simpl_fun_expression :
            ass
          in
          bind_list @@ List.mapi aux params in
-       let%bind instructions = bind_list
-         @@ List.map simpl_statement
-         @@ statements in
+       let%bind instructions = simpl_statement_list statements in
        let%bind result = simpl_expression return in
        let%bind output_type = simpl_type_expression ret_type in
        let body = tpl_declarations @ instructions in
@@ -721,44 +733,39 @@ and simpl_fun_expression :
      )
   )
 
-and simpl_declaration : Raw.declaration -> declaration Location.wrap result =
-  fun t ->
-  let open! Raw in
-  match t with
-  | TypeDecl x ->
-      let decl, loc = r_split x in
-      let {name;type_expr} : Raw.type_decl = decl in
-      let%bind type_expression = simpl_type_expression type_expr in
-      ok @@ Location.wrap ~loc (Declaration_type
-                                 (Var.of_name name.value, type_expression))
-
-  | ConstDecl x ->
-      let simpl_const_decl = fun {name;const_type; init; attributes} ->        
-        let%bind expression = simpl_expression init in
-        let%bind t = simpl_type_expression const_type in
-        let type_annotation = Some t in
-        let inline = List.exists (fun (a: Raw.attribute) -> a.value = "\"inline\"") attributes.value in
-        ok @@ Declaration_constant
-              (Var.of_name name.value, type_annotation, inline, expression)
-      in bind_map_location simpl_const_decl (Location.lift_region x)
-  | FunDecl x ->
-      let decl, loc = r_split x in
-      let%bind ((name, ty_opt), expr) = simpl_fun_decl ~loc decl in
-      let inline = List.exists (fun (a: Raw.attribute) -> a.value = "\"inline\"") x.value.attributes.value in      
-      ok @@ Location.wrap ~loc (Declaration_constant (name, ty_opt, inline, expr))
-
-and simpl_statement : Raw.statement -> (_ -> expression result) result =
-  fun s ->
-  match s with
-  | Instr i -> simpl_instruction i
-  | Data d -> simpl_data_declaration d
+and simpl_statement_list statements =
+  let open Raw in
+  let rec hook acc = function
+    [] -> acc
+  | [Attr _] ->
+      (* Detached attributes are erased. TODO: Warning. *)
+      acc
+  | Attr _ :: (Attr _ :: _ as statements) ->
+      (* Detached attributes are erased. TODO: Warning. *)
+      hook acc statements
+  | Attr decl :: Data (LocalConst {value; region}) :: statements ->
+      let new_const =
+        Data (LocalConst {value = {value with attributes = Some decl}; region})
+      in hook acc (new_const :: statements)
+  | Attr decl :: Data (LocalFun {value; region}) :: statements ->
+      let new_fun =
+        Data (LocalFun {value = {value with attributes = Some decl}; region})
+      in hook acc (new_fun :: statements)
+  | Attr _ :: statements ->
+      (* Detached attributes are erased. TODO: Warning. *)
+      hook acc statements
+  | Instr i :: statements ->
+      hook (simpl_instruction i :: acc) statements
+  | Data d :: statements ->
+      hook (simpl_data_declaration d :: acc) statements
+  in bind_list @@ hook [] (List.rev statements)
 
 and simpl_single_instruction : Raw.instruction -> (_ -> expression result) result =
   fun t ->
   match t with
   | ProcCall x -> (
-    let ((f, args) , loc) = r_split x in
-    let (args , args_loc) = r_split args in
+    let (f, args) , loc = r_split x in
+    let args, args_loc = r_split args in
     let args' = npseq_to_list args.inside in
     match f with
     | EVar name -> (
@@ -1057,10 +1064,10 @@ and simpl_cases : type a . (Raw.pattern * a) list -> (a, unit) matching result =
         let aux (x , y) =
           let error =
             let title () = "Pattern" in
-            (** TODO: The labelled arguments should be flowing from the CLI. *)
+            (* TODO: The labelled arguments should be flowing from the CLI. *)
             let content () =
               Printf.sprintf "Pattern : %s"
-                (Parser.Pascaligo.ParserLog.pattern_to_string
+                (ParserLog.pattern_to_string
                    ~offsets:true ~mode:`Point x) in
             error title content in
           let%bind x' =
@@ -1071,23 +1078,22 @@ and simpl_cases : type a . (Raw.pattern * a) list -> (a, unit) matching result =
       ok @@ ez_match_variant constrs
 
 and simpl_instruction : Raw.instruction -> (_ -> expression result) result =
-  fun t ->
-  trace (simplifying_instruction t) @@ simpl_single_instruction t
+  fun t -> trace (simplifying_instruction t) @@ simpl_single_instruction t
 
 and simpl_statements : Raw.statements -> (_ -> expression result) result =
-  fun ss ->
-  let lst = npseq_to_list ss in
-  let%bind fs = bind_map_list simpl_statement lst in
+  fun statements ->
+    let lst = npseq_to_list statements in
+    let%bind fs = simpl_statement_list lst in
     let aux : _ -> (expression option -> expression result) -> _ =
       fun prec cur ->
-      let%bind res = cur prec in
-      ok @@ Some res in
+        let%bind res = cur prec
+        in ok @@ Some res in
     ok @@ fun (expr' : _ option) ->
            let%bind ret = bind_fold_right_list aux expr' fs in
            ok @@ Option.unopt_exn ret
 
-and simpl_block : Raw.block -> (_ -> expression result) result = fun t ->
-  simpl_statements t.statements
+and simpl_block : Raw.block -> (_ -> expression result) result =
+  fun t -> simpl_statements t.statements
 
 and simpl_for_int : Raw.for_int -> (_ -> expression result) result = fun fi ->
   (* cond part *)
@@ -1263,11 +1269,13 @@ and simpl_for_collect : Raw.for_collect -> (_ -> expression result) result = fun
   (* STEP 5 *)
   let rec add_return (expr : expression) = match expr.expression with
     | E_sequence (a,b) -> e_sequence a (add_return b)
-    | _  -> e_sequence expr (e_variable (Var.of_name "#COMPILER#acc")) in (* TODO fresh *)
+    | _  -> (* TODO fresh *)
+       e_sequence expr (e_variable (Var.of_name "#COMPILER#acc")) in
   let for_body = add_return for_body in
   (* STEP 6 *)
   let for_body =
-    let ( arg_access: Types.access_path -> expression ) = e_accessor (e_variable (Var.of_name "arguments")) in (* TODO fresh *)
+    let ( arg_access: Types.access_path -> expression ) =
+      e_accessor (e_variable (Var.of_name "arguments")) in (* TODO fresh *)
     ( match fc.collection with
       | Map _ ->
         let acc          = arg_access [Access_tuple 0 ] in
@@ -1290,7 +1298,8 @@ and simpl_for_collect : Raw.for_collect -> (_ -> expression result) result = fun
   let fold = e_constant op_name [lambda; collect ; init_record] in
   (* STEP 8 *)
   let assign_back (prev : expression option) (captured_varname : string) : expression option =
-    let access = e_accessor (e_variable (Var.of_name "#COMPILER#folded_record")) (* TODO fresh *)
+    let access = (* TODO fresh *)
+      e_accessor (e_variable (Var.of_name "#COMPILER#folded_record"))
       [Access_record captured_varname] in
     let assign = e_assign captured_varname [] access in
     match prev with
@@ -1303,6 +1312,74 @@ and simpl_for_collect : Raw.for_collect -> (_ -> expression result) result = fun
     | None -> e_skip ()
     | Some seq -> e_let_in (Var.of_name "#COMPILER#folded_record", None) false fold seq in (* TODO fresh *)
   return_statement @@ final_sequence
+(*
+and simpl_declaration : Raw.declaration -> declaration Location.wrap result =
+ *)
 
-let simpl_program : Raw.ast -> program result = fun t ->
-  bind_list @@ List.map simpl_declaration @@ nseq_to_list t.decl
+and simpl_declaration_list declarations :
+      Ast_simplified.declaration Location.wrap list result =
+  let open Raw in
+  let rec hook acc = function
+    [] -> acc
+  | [AttrDecl _] ->
+       (* Detached attributes are erased. TODO: Warning. *)
+       acc
+  | AttrDecl _ :: (AttrDecl _ :: _ as declarations) ->
+      (* Detached attributes are erased. TODO: Warning. *)
+      hook acc declarations
+  | AttrDecl decl :: ConstDecl {value; region} :: declarations ->
+      let new_const =
+        ConstDecl {value = {value with attributes = Some decl}; region}
+      in hook acc (new_const :: declarations)
+  | AttrDecl decl :: FunDecl {value; region} :: declarations ->
+      let new_fun =
+        FunDecl {value = {value with attributes = Some decl}; region}
+      in hook acc (new_fun :: declarations)
+  | AttrDecl _ :: declarations ->
+      (* Detached attributes are erased. TODO: Warning. *)
+      hook acc declarations
+  | TypeDecl decl :: declarations ->
+      let decl, loc = r_split decl in
+      let {name; type_expr} : Raw.type_decl = decl in
+      let%bind type_expression = simpl_type_expression type_expr in
+      let new_decl =
+        Declaration_type (Var.of_name name.value, type_expression) in
+      let res = Location.wrap ~loc new_decl in
+      hook (bind_list_cons res acc) declarations
+  | ConstDecl decl :: declarations ->
+      let simpl_const_decl =
+        fun {name;const_type; init; attributes} ->
+          let%bind expression = simpl_expression init in
+          let%bind t = simpl_type_expression const_type in
+          let type_annotation = Some t in
+          let inline =
+            match attributes with
+              None -> false
+            | Some {value; _} ->
+                npseq_to_list value.ne_elements
+               |> List.exists (fun Region.{value; _} -> value = "\"inline\"") in
+          let new_decl =
+            Declaration_constant
+              (Var.of_name name.value, type_annotation, inline, expression)
+          in ok new_decl in
+      let%bind res =
+        bind_map_location simpl_const_decl (Location.lift_region decl)
+      in hook (bind_list_cons res acc) declarations
+  | FunDecl fun_decl :: declarations ->
+      let decl, loc = r_split fun_decl in
+      let%bind ((name, ty_opt), expr) = simpl_fun_decl ~loc decl in
+      let inline =
+        match fun_decl.value.attributes with
+          None -> false
+        | Some {value; _} ->
+            npseq_to_list value.ne_elements
+            |> List.exists (fun Region.{value; _} -> value = "\"inline\"") in
+      let new_decl =
+        Declaration_constant (name, ty_opt, inline, expr) in
+      let res = Location.wrap ~loc new_decl in
+      hook (bind_list_cons res acc) declarations
+  in
+  hook (ok @@ []) (List.rev declarations)
+
+let simpl_program : Raw.ast -> program result =
+  fun t -> simpl_declaration_list @@ nseq_to_list t.decl

src/stages/ast_simplified/combinators.ml

@@ -92,11 +92,13 @@ let e_chain_id ?loc s : expression = location_wrap ?loc @@ E_literal (Literal_ch
 let e'_bytes b : expression' result =
   let%bind bytes = generic_try (simple_error "bad hex to bytes") (fun () -> Hex.to_bytes (`Hex b)) in
   ok @@ E_literal (Literal_bytes bytes)
-let e_bytes ?loc b : expression result =
+let e_bytes_hex ?loc b : expression result =
   let%bind e' = e'_bytes b in
   ok @@ location_wrap ?loc e'
-let e_bytes_ofbytes ?loc (b: bytes) : expression =
+let e_bytes_raw ?loc (b: bytes) : expression =
   location_wrap ?loc @@ E_literal (Literal_bytes b)
+let e_bytes_string ?loc (s: string) : expression =
+  location_wrap ?loc @@ E_literal (Literal_bytes (Hex.to_bytes (Hex.of_string s)))
 let e_big_map ?loc lst : expression = location_wrap ?loc @@ E_big_map lst
 let e_record ?loc map : expression = location_wrap ?loc @@ E_record map
 let e_tuple ?loc lst : expression = location_wrap ?loc @@ E_tuple lst

src/stages/ast_simplified/combinators.mli

@@ -60,8 +60,9 @@ val e_key_hash : ?loc:Location.t -> string -> expression
 val e_chain_id : ?loc:Location.t -> string -> expression 
 val e_mutez : ?loc:Location.t -> int -> expression
 val e'_bytes : string -> expression' result
-val e_bytes : ?loc:Location.t -> string -> expression result
-val e_bytes_ofbytes : ?loc:Location.t -> bytes -> expression
+val e_bytes_hex : ?loc:Location.t -> string -> expression result
+val e_bytes_raw : ?loc:Location.t -> bytes -> expression
+val e_bytes_string : ?loc:Location.t -> string -> expression
 val e_big_map : ?loc:Location.t -> ( expr * expr ) list -> expression
 (*
 val e_record  : ?loc:Location.t -> ( expr * expr ) list -> expression

src/test/contracts/attributes.ligo

@@ -1,17 +1,19 @@
-const x: int = 1; attributes ["inline"];
+const x : int = 1; attributes ["inline"]
 
 function foo (const a : int) : int is
-  block {
-    const test: int = 2 + a; attributes ["inline"];
-  } with test;
+  begin
+    const test : int = 2 + a;
+    attributes ["inline"];
+  end with test;
 attributes ["inline"];
 
-const y: int = 1; attributes ["inline"; "other"];
+const y : int = 1; attributes ["inline"; "other"]
 
 function bar (const b : int) : int is
-  block {
-    function test (const z : int) : int is begin
+  begin
+    function test (const z : int) : int is
+      begin
         const r : int = 2 + b + z
       end with r;
-    attributes ["inline"; "foo"; "bar"];
-  } with test(b);
+    attributes ["inline"; "foo"; "bar"]
+  end with test(b)

src/test/contracts/attributes.mligo

@@ -1,13 +1,10 @@
 let x = 1 [@@inline]
 
-let foo (a: int): int = ( 
-  let test = 2 + a [@@inline] in
-  test
-) [@@inline]
+let foo (a: int): int =
+  (let test = 2 + a [@@inline] in test) [@@inline]
 
 let y = 1 [@@inline][@@other]
 
-let bar (b: int): int = (
-  let test = fun (z: int) -> 2 + b + z [@@inline][@@foo][@@bar] in
-  test b
-)
+let bar (b: int): int =
+  let test = fun (z: int) -> 2 + b + z [@@inline][@@foo][@@bar]
+  in test b

src/test/contracts/bytes_unpack.mligo

@@ -0,0 +1,11 @@
+let id_string (p: string) : string option =
+  let packed: bytes = Bytes.pack p in
+  ((Bytes.unpack packed): string option)
+
+let id_int (p: int) : int option =
+  let packed: bytes = Bytes.pack p in
+  ((Bytes.unpack packed): int option)
+
+let id_address (p: address) : address option =
+  let packed: bytes = Bytes.pack p in
+  ((Bytes.unpack packed): address option)

src/test/contracts/bytes_unpack.religo

@@ -0,0 +1,14 @@
+let id_string = (p: string) : option(string) => {
+  let packed : bytes = Bytes.pack(p);
+  ((Bytes.unpack(packed)): option(string));
+};
+
+let id_int = (p: int) : option(int) => {
+  let packed: bytes = Bytes.pack(p);
+  ((Bytes.unpack(packed)): option(int));
+};
+
+let id_address = (p: address) : option(address) => {
+  let packed: bytes = Bytes.pack(p);
+  ((Bytes.unpack(packed)): option(address));
+};

src/test/contracts/check_signature.ligo

@@ -0,0 +1,2 @@
+function check_signature (const pk: key; const signed: signature; const msg: bytes) : bool is
+  crypto_check(pk, signed, msg)

src/test/contracts/check_signature.mligo

@@ -0,0 +1,2 @@
+let check_signature (pk, signed, msg: key * signature * bytes) : bool =
+  Crypto.check pk signed msg

src/test/contracts/check_signature.religo

@@ -0,0 +1,4 @@
+let check_signature = (param: (key, signature, bytes)) : bool => {
+  let pk, signed, msg = param;
+  Crypto.check(pk, signed, msg);
+};

src/test/contracts/evaluation_tests.ligo

@@ -0,0 +1,11 @@
+type myrec is record
+  foo : nat;
+  bar : string;
+end;
+
+const a : myrec = record
+  foo = 0n;
+  bar = "bar";
+end;
+
+const b : int = 2 ;

src/test/contracts/key_hash.mligo

@@ -0,0 +1,5 @@
+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)

src/test/contracts/key_hash.religo

@@ -0,0 +1,10 @@
+let check_hash_key = (kh1_k2: (key_hash, key)) : (bool, key_hash) => {
+  let kh1, k2 = kh1_k2;
+  let kh2 : key_hash = Crypto.hash_key(k2);
+  if (kh1 == kh2) {
+    (true, kh2);
+  }
+  else {
+    (false, kh2);
+  }
+};

src/test/contracts/website2.mligo

@@ -8,16 +8,16 @@ type action =
 | Increment of int
 | Decrement of int
 
-let add (a: int) (b: int) : int = a + b
-let sub (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
 
 (* real entrypoint that re-routes the flow based on the action provided *)
 
 let main (p,s: action * storage) =
  let storage =
    match p with
-   | Increment n -> add s n
-   | Decrement n -> sub s n
+   | Increment n -> add (s, n)
+   | Decrement n -> sub (s, n)
  in ([] : operation list), storage
 
 (* IF YOU CHANGE THIS, CHANGE THE EXAMPLE ON THE FRONT PAGE OF THE WEBSITE *)

src/test/contracts/website2.religo

@@ -8,20 +8,18 @@ type action =
   | Increment(int)
   | Decrement(int);
 
-let add = (a: int, b: int): int => a + b;
-let sub = (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;
 
 /* real entrypoint that re-routes the flow based on the action provided */
 
-let main2 = (p: action, storage) => {
+let main = ((p,storage): (action, storage)) => {
   let storage =
     switch (p) {
-    | Increment(n) => add(storage, n)
-    | Decrement(n) => sub(storage, n)
+    | Increment(n) => add((storage, n))
+    | Decrement(n) => sub((storage, n))
     };
   ([]: list(operation), storage);
 };
 
-let main = (x: (action, storage)) => main2(x[0],x[1]);
-
 (* IF YOU CHANGE THIS, CHANGE THE EXAMPLE ON THE FRONT PAGE OF THE WEBSITE *)

src/test/dune

@@ -25,8 +25,8 @@
   (action (run ./parser_negative_tests.exe))
   (deps
     ../passes/1-parser/pascaligo/all.ligo
-    ../passes/1-parser/cameligo/all.ligo
-    ../passes/1-parser/reasonligo/all.ligo
+    ../passes/1-parser/cameligo/all.mligo
+    ../passes/1-parser/reasonligo/all.religo
   ))
 
 (alias

src/test/integration_tests.ml

@@ -410,13 +410,13 @@ let string_arithmetic_religo () : unit result =
 
 let bytes_arithmetic () : unit result =
   let%bind program = type_file "./contracts/bytes_arithmetic.ligo" in
-  let%bind foo = e_bytes "0f00" in
-  let%bind foototo = e_bytes "0f007070" in
-  let%bind toto = e_bytes "7070" in
-  let%bind empty = e_bytes "" in
-  let%bind tata = e_bytes "7a7a7a7a" in
-  let%bind at = e_bytes "7a7a" in
-  let%bind ba = e_bytes "ba" in
+  let%bind foo = e_bytes_hex "0f00" in
+  let%bind foototo = e_bytes_hex "0f007070" in
+  let%bind toto = e_bytes_hex "7070" in
+  let%bind empty = e_bytes_hex "" in
+  let%bind tata = e_bytes_hex "7a7a7a7a" in
+  let%bind at = e_bytes_hex "7a7a" in
+  let%bind ba = e_bytes_hex "ba" in
   let%bind () = expect_eq program "concat_op" foo foototo in
   let%bind () = expect_eq program "concat_op" empty toto in
   let%bind () = expect_eq program "slice_op" tata at in
@@ -430,13 +430,13 @@ let bytes_arithmetic () : unit result =
 
 let bytes_arithmetic_mligo () : unit result =
   let%bind program = mtype_file "./contracts/bytes_arithmetic.mligo" in
-  let%bind foo = e_bytes "0f00" in
-  let%bind foototo = e_bytes "0f007070" in
-  let%bind toto = e_bytes "7070" in
-  let%bind empty = e_bytes "" in
-  let%bind tata = e_bytes "7a7a7a7a" in
-  let%bind at = e_bytes "7a7a" in
-  let%bind ba = e_bytes "ba" in
+  let%bind foo = e_bytes_hex "0f00" in
+  let%bind foototo = e_bytes_hex "0f007070" in
+  let%bind toto = e_bytes_hex "7070" in
+  let%bind empty = e_bytes_hex "" in
+  let%bind tata = e_bytes_hex "7a7a7a7a" in
+  let%bind at = e_bytes_hex "7a7a" in
+  let%bind ba = e_bytes_hex "ba" in
   let%bind () = expect_eq program "concat_op" foo foototo in
   let%bind () = expect_eq program "concat_op" empty toto in
   let%bind () = expect_eq program "slice_op" tata at in
@@ -450,13 +450,13 @@ let bytes_arithmetic_mligo () : unit result =
 
 let bytes_arithmetic_religo () : unit result =
   let%bind program = retype_file "./contracts/bytes_arithmetic.religo" in
-  let%bind foo = e_bytes "0f00" in
-  let%bind foototo = e_bytes "0f007070" in
-  let%bind toto = e_bytes "7070" in
-  let%bind empty = e_bytes "" in
-  let%bind tata = e_bytes "7a7a7a7a" in
-  let%bind at = e_bytes "7a7a" in
-  let%bind ba = e_bytes "ba" in
+  let%bind foo = e_bytes_hex "0f00" in
+  let%bind foototo = e_bytes_hex "0f007070" in
+  let%bind toto = e_bytes_hex "7070" in
+  let%bind empty = e_bytes_hex "" in
+  let%bind tata = e_bytes_hex "7a7a7a7a" in
+  let%bind at = e_bytes_hex "7a7a" in
+  let%bind ba = e_bytes_hex "ba" in
   let%bind () = expect_eq program "concat_op" foo foototo in
   let%bind () = expect_eq program "concat_op" empty toto in
   let%bind () = expect_eq program "slice_op" tata at in
@@ -1901,6 +1901,67 @@ let key_hash () : unit result =
   let%bind () = expect_eq program "check_hash_key" make_input make_expected in
   ok ()
 
+let key_hash_mligo () : unit result =
+  let open Tezos_crypto in
+  let (raw_pkh,raw_pk,_) = Signature.generate_key () in
+  let pkh_str = Signature.Public_key_hash.to_b58check raw_pkh in
+  let pk_str = Signature.Public_key.to_b58check raw_pk in
+  let%bind program = mtype_file "./contracts/key_hash.mligo" in
+  let make_input = e_pair (e_key_hash pkh_str) (e_key pk_str) in
+  let make_expected = e_pair (e_bool true) (e_key_hash pkh_str) in
+  let%bind () = expect_eq program "check_hash_key" make_input make_expected in
+  ok ()
+
+let key_hash_religo () : unit result =
+  let open Tezos_crypto in
+  let (raw_pkh,raw_pk,_) = Signature.generate_key () in
+  let pkh_str = Signature.Public_key_hash.to_b58check raw_pkh in
+  let pk_str = Signature.Public_key.to_b58check raw_pk in
+  let%bind program = retype_file "./contracts/key_hash.religo" in
+  let make_input = e_pair (e_key_hash pkh_str) (e_key pk_str) in
+  let make_expected = e_pair (e_bool true) (e_key_hash pkh_str) in
+  let%bind () = expect_eq program "check_hash_key" make_input make_expected in
+  ok ()
+
+let check_signature () : unit result =
+  let open Tezos_crypto in
+  let (_, raw_pk, sk) = Signature.generate_key () in
+  let pk_str = Signature.Public_key.to_b58check raw_pk in
+  let signed = Signature.sign sk (Bytes.of_string "hello world") in
+  let%bind program = type_file "./contracts/check_signature.ligo" in
+  let make_input = e_tuple [e_key pk_str ;
+                            e_signature (Signature.to_b58check signed) ;
+                            e_bytes_string "hello world"] in
+  let make_expected = e_bool true in
+  let%bind () = expect_eq program "check_signature" make_input make_expected in
+  ok ()
+
+let check_signature_mligo () : unit result =
+  let open Tezos_crypto in
+  let (_, raw_pk, sk) = Signature.generate_key () in
+  let pk_str = Signature.Public_key.to_b58check raw_pk in
+  let signed = Signature.sign sk (Bytes.of_string "hello world") in
+  let%bind program = mtype_file "./contracts/check_signature.mligo" in
+  let make_input = e_tuple [e_key pk_str ;
+                            e_signature (Signature.to_b58check signed) ;
+                            e_bytes_string "hello world"] in
+  let make_expected = e_bool true in
+  let%bind () = expect_eq program "check_signature" make_input make_expected in
+  ok ()
+
+let check_signature_religo () : unit result =
+  let open Tezos_crypto in
+  let (_, raw_pk, sk) = Signature.generate_key () in
+  let pk_str = Signature.Public_key.to_b58check raw_pk in
+  let signed = Signature.sign sk (Bytes.of_string "hello world") in
+  let%bind program = retype_file "./contracts/check_signature.religo" in
+  let make_input = e_tuple [e_key pk_str ;
+                            e_signature (Signature.to_b58check signed) ;
+                            e_bytes_string "hello world"] in
+  let make_expected = e_bool true in
+  let%bind () = expect_eq program "check_signature" make_input make_expected in
+  ok ()
+
 let curry () : unit result =
   let%bind program = mtype_file "./contracts/curry.mligo" in
   let%bind () =
@@ -1975,6 +2036,26 @@ let bytes_unpack () : unit result =
   let%bind () = expect_eq program "id_address" (e_address addr) (e_some (e_address addr)) in
   ok ()
 
+let bytes_unpack_mligo () : unit result =
+  let%bind program = mtype_file "./contracts/bytes_unpack.mligo" in
+  let%bind () = expect_eq program "id_string" (e_string "teststring") (e_some (e_string "teststring")) in
+  let%bind () = expect_eq program "id_int" (e_int 42) (e_some (e_int 42)) in
+  let open Proto_alpha_utils.Memory_proto_alpha in
+  let addr = Protocol.Alpha_context.Contract.to_b58check @@
+      (List.nth dummy_environment.identities 0).implicit_contract in
+  let%bind () = expect_eq program "id_address" (e_address addr) (e_some (e_address addr)) in
+  ok ()
+
+let bytes_unpack_religo () : unit result =
+  let%bind program = retype_file "./contracts/bytes_unpack.religo" in
+  let%bind () = expect_eq program "id_string" (e_string "teststring") (e_some (e_string "teststring")) in
+  let%bind () = expect_eq program "id_int" (e_int 42) (e_some (e_int 42)) in
+  let open Proto_alpha_utils.Memory_proto_alpha in
+  let addr = Protocol.Alpha_context.Contract.to_b58check @@
+      (List.nth dummy_environment.identities 0).implicit_contract in
+  let%bind () = expect_eq program "id_address" (e_address addr) (e_some (e_address addr)) in
+  ok ()
+
 let empty_case () : unit result =
   let%bind program = type_file "./contracts/empty_case.ligo" in
   let%bind () =
@@ -2019,7 +2100,14 @@ let empty_case_religo () : unit result =
 
 let main = test_suite "Integration (End to End)" [
     test "bytes unpack" bytes_unpack ;
+    test "bytes unpack (mligo)" bytes_unpack_mligo ;
+    test "bytes unpack (religo)" bytes_unpack_religo ;
     test "key hash" key_hash ;
+    test "key hash (mligo)" key_hash_mligo ;
+    test "key hash (religo)" key_hash_religo ;
+    test "check signature" check_signature ;
+    test "check signature (mligo)" check_signature_mligo ;
+    test "check signature (religo)" check_signature_religo ;
     test "chain id" chain_id ;
     test "type alias" type_alias ;
     test "function" function_ ;