Bug fixing in the lexers and the parser. Started AST pretty-printer.

LexToken, AST: Tiny refactoring.

Bug: Added the making of the AST node PBytes.

Parser: The rule "pattern" was not properly stratified (the
constructor "PCons" was always produced, even when no consing was
done (now a fall-through to "core_pattern").

Bug: When sharing the lexers between Ligodity and Pascaligo, a
regression was introduced with the lexing of symbols. Indeed,
symbols specific to Ligodity (like "<>") and
Pascaligo (like "=/=") were scanned, but the
function "LexToken.mk_sym" for each only accepted their own,
yielding to an assertion to be invalidated. Fix: I created an
error "sym_err" now to gracefully handle that situation and
provide a hint to the programmer (to wit, to check the LIGO
syntax in use).

WIP: Started to write pretty-printing functions for the nodes of
the AST.

CLI: The option "--verbose=ast" now calls that function instead
of printing the tokens from the AST. When the pretty-printer is
finished, the option for printing the tokens will likely
be "--verbose=ast-tokens".

src/passes/1-parser/ligodity/LexToken.mli

@@ -107,7 +107,7 @@ type t =
 | Type  of Region.t
 | With  of Region.t
 
-  (* Liquidity specific *)
+  (* Liquidity-specific *)
 
 | LetEntry of Region.t
 | MatchNat of Region.t
@@ -137,23 +137,20 @@ val to_region : token -> Region.t
 
 (* Injections *)
 
-type int_err =
+type   int_err = Non_canonical_zero
-  Non_canonical_zero
-
 type ident_err = Reserved_name
-
+type   nat_err = Invalid_natural
-type invalid_natural = 
-  | Invalid_natural
                | Non_canonical_zero_nat
+type   sym_err = Invalid_symbol
 
-val mk_string : lexeme -> Region.t -> token
-val mk_bytes  : lexeme -> Region.t -> token
 val mk_int    : lexeme -> Region.t -> (token,   int_err) result
-val mk_nat    : lexeme -> Region.t -> (token,   invalid_natural) result
+val mk_nat    : lexeme -> Region.t -> (token,   nat_err) result
 val mk_mtz    : lexeme -> Region.t -> (token,   int_err) result
 val mk_ident  : lexeme -> Region.t -> (token, ident_err) result
+val mk_sym    : lexeme -> Region.t -> (token,   sym_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_sym    : lexeme -> Region.t -> token
 val eof       : Region.t -> token
 
 (* Predicates *)

src/passes/1-parser/ligodity/LexToken.mll

@@ -379,11 +379,10 @@ let mk_int lexeme region =
   then Error Non_canonical_zero
   else Ok (Int Region.{region; value = lexeme, z})
 
-type invalid_natural = 
+type nat_err =
-  | Invalid_natural
+  Invalid_natural
 | Non_canonical_zero_nat
 
-
 let mk_nat lexeme region =
   match (String.index_opt lexeme 'p') with
   | None -> Error Invalid_natural
@@ -408,35 +407,41 @@ let mk_mtz lexeme region =
 
 let eof region = EOF region
 
+type sym_err = Invalid_symbol
+
 let mk_sym lexeme region =
   match lexeme with
-    "->"   ->   ARROW     region
+  (* Lexemes in common with all concrete syntaxes *)
-  | "::"   ->   CONS      region
+    ";"   -> Ok (SEMI     region)
-  | "^"   ->    CAT       region
+  | ","   -> Ok (COMMA    region)
-  | "-"   ->    MINUS     region
+  | "("   -> Ok (LPAR     region)
-  | "+"   ->    PLUS      region
+  | ")"   -> Ok (RPAR     region)
-  | "/"   ->    SLASH     region
+  | "["   -> Ok (LBRACKET region)
-  | "*"   ->    TIMES     region
+  | "]"   -> Ok (RBRACKET region)
-  | "["   ->    LBRACKET  region
+  | "{"   -> Ok (LBRACE   region)
-  | "]"   ->    RBRACKET  region
+  | "}"   -> Ok (RBRACE   region)
-  | "{"   ->    LBRACE    region
+  | "="   -> Ok (EQUAL    region)
-  | "}"  ->     RBRACE    region
+  | ":"   -> Ok (COLON    region)
-  | ","  ->     COMMA     region
+  | "|"   -> Ok (VBAR     region)
-  | ";"   ->    SEMI      region
+  | "->"  -> Ok (ARROW    region)
-  | "|"   ->    VBAR      region
+  | "."   -> Ok (DOT      region)
-  | ":"   ->    COLON     region
+  | "_"   -> Ok (WILD     region)
-  | "."  ->     DOT       region
+  | "^"   -> Ok (CAT      region)
-  | "_"   ->    WILD      region
+  | "+"   -> Ok (PLUS     region)
-  | "="  ->     EQ        region
+  | "-"   -> Ok (MINUS    region)
-  | "<>" ->     NE        region
+  | "*"   -> Ok (TIMES    region)
-  | "<"   ->    LT        region
+  | "/"   -> Ok (SLASH    region)
-  | ">"   ->    GT        region
+  | "<"   -> Ok (LT       region)
-  | "=<"   ->   LE        region
+  | "<="  -> Ok (LEQ      region)
-  | ">="   ->   GE        region
+  | ">"   -> Ok (GT       region)
-  | "||"   ->   BOOL_OR   region
+  | ">="  -> Ok (GEQ      region)
-  | "&&"   ->   BOOL_AND  region
+
-  | "("    ->   LPAR      region
+
-  | ")"    ->   RPAR      region
+  | "<>"  -> Ok (NE        region)
+  | "::"  -> Ok (CONS      region)
+  | "||"  -> Ok (BOOL_OR   region)
+  | "&&"  -> Ok (BOOL_AND  region)
+
   |  a  ->   failwith ("Not understood token: " ^ a)
 
 (* Identifiers *)

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

@@ -188,7 +188,7 @@ and type_decl = {
 and type_expr =
   TProd   of cartesian
 | TSum    of (variant reg, vbar) nsepseq reg
-| TRecord of record_type
+| TRecord of field_decl reg injection reg
 | TApp    of (type_name * type_tuple) reg
 | TFun    of (type_expr * arrow * type_expr) reg
 | TPar    of type_expr par reg
@@ -201,8 +201,6 @@ and variant = {
   args   : (kwd_of * cartesian) option
 }
 
-and record_type = field_decl reg injection reg
-
 and field_decl = {
   field_name : field_name;
   colon      : colon;

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

@@ -172,7 +172,7 @@ and type_decl = {
 and type_expr =
   TProd   of cartesian
 | TSum    of (variant reg, vbar) nsepseq reg
-| TRecord of record_type
+| TRecord of field_decl reg injection reg
 | TApp    of (type_name * type_tuple) reg
 | TFun    of (type_expr * arrow * type_expr) reg
 | TPar    of type_expr par reg
@@ -185,8 +185,6 @@ and variant = {
   args   : (kwd_of * cartesian) option
 }
 
-and record_type = field_decl reg injection reg
-
 and field_decl = {
   field_name : field_name;
   colon      : colon;

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

@@ -137,23 +137,20 @@ val to_region : token -> Region.t
 
 (* Injections *)
 
-type int_err =
+type   int_err = Non_canonical_zero
-  Non_canonical_zero
-
 type ident_err = Reserved_name
-
+type   nat_err = Invalid_natural
-type invalid_natural =
-  | Invalid_natural
                | Non_canonical_zero_nat
+type   sym_err = Invalid_symbol
 
-val mk_string : lexeme -> Region.t -> token
-val mk_bytes  : lexeme -> Region.t -> token
 val mk_int    : lexeme -> Region.t -> (token,   int_err) result
-val mk_nat    : lexeme -> Region.t -> (token,   invalid_natural) result
+val mk_nat    : lexeme -> Region.t -> (token,   nat_err) result
 val mk_mtz    : lexeme -> Region.t -> (token,   int_err) result
 val mk_ident  : lexeme -> Region.t -> (token, ident_err) result
+val mk_sym    : lexeme -> Region.t -> (token,   sym_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_sym    : lexeme -> Region.t -> token
 val eof       : Region.t -> token
 
 (* Predicates *)

src/passes/1-parser/pascaligo/LexToken.mll

@@ -480,8 +480,8 @@ let mk_int lexeme region =
   then Error Non_canonical_zero
   else Ok (Int Region.{region; value = lexeme, z})
 
-type invalid_natural =
+type nat_err =
-  | Invalid_natural
+  Invalid_natural
 | Non_canonical_zero_nat
 
 let mk_nat lexeme region =
@@ -508,35 +508,42 @@ let mk_mtz lexeme region =
 
 let eof region = EOF region
 
+type sym_err = Invalid_symbol
+
 let mk_sym lexeme region =
   match lexeme with
-    ";"   -> SEMI     region
+  (* Lexemes in common with all concrete syntaxes *)
-  | ","   -> COMMA    region
+    ";"   -> Ok (SEMI     region)
-  | "("   -> LPAR     region
+  | ","   -> Ok (COMMA    region)
-  | ")"   -> RPAR     region
+  | "("   -> Ok (LPAR     region)
-  | "{"   -> LBRACE   region
+  | ")"   -> Ok (RPAR     region)
-  | "}"   -> RBRACE   region
+  | "["   -> Ok (LBRACKET region)
-  | "["   -> LBRACKET region
+  | "]"   -> Ok (RBRACKET region)
-  | "]"   -> RBRACKET region
+  | "{"   -> Ok (LBRACE   region)
-  | "#"   -> CONS     region
+  | "}"   -> Ok (RBRACE   region)
-  | "|"   -> VBAR     region
+  | "="   -> Ok (EQUAL    region)
-  | "->"  -> ARROW    region
+  | ":"   -> Ok (COLON    region)
-  | ":="  -> ASS      region
+  | "|"   -> Ok (VBAR     region)
-  | "="   -> EQUAL    region
+  | "->"  -> Ok (ARROW    region)
-  | ":"   -> COLON    region
+  | "."   -> Ok (DOT      region)
-  | "<"   -> LT       region
+  | "_"   -> Ok (WILD     region)
-  | "<="  -> LEQ      region
+  | "^"   -> Ok (CAT      region)
-  | ">"   -> GT       region
+  | "+"   -> Ok (PLUS     region)
-  | ">="  -> GEQ      region
+  | "-"   -> Ok (MINUS    region)
-  | "=/=" -> NEQ      region
+  | "*"   -> Ok (TIMES    region)
-  | "+"   -> PLUS     region
+  | "/"   -> Ok (SLASH    region)
-  | "-"   -> MINUS    region
+  | "<"   -> Ok (LT       region)
-  | "/"   -> SLASH    region
+  | "<="  -> Ok (LEQ      region)
-  | "*"   -> TIMES    region
+  | ">"   -> Ok (GT       region)
-  | "."   -> DOT      region
+  | ">="  -> Ok (GEQ      region)
-  | "_"   -> WILD     region
+
-  | "^"   -> CAT      region
+  (* Lexemes specific to PascaLIGO *)
-  |     _ -> assert false
+  | "=/=" -> Ok (NEQ      region)
+  | "#"   -> Ok (CONS     region)
+  | ":="  -> Ok (ASS      region)
+
+  (* Invalid lexemes *)
+  |     _ -> Error Invalid_symbol
 
 (* Identifiers *)
 

src/passes/1-parser/pascaligo/Parser.mly

@@ -935,14 +935,17 @@ list_expr:
 (* Patterns *)
 
 pattern:
-  nsepseq(core_pattern,CONS) {
+  core_pattern CONS nsepseq(core_pattern,CONS) {
-    let region = nsepseq_to_region pattern_to_region $1
+    let value = Utils.nsepseq_cons $1 $2 $3 in
-    in PCons {region; value=$1}}
+    let region = nsepseq_to_region pattern_to_region value
+    in PCons {region; value}}
+| core_pattern { $1 }
 
 core_pattern:
   var                      {    PVar $1 }
 | WILD                     {   PWild $1 }
 | Int                      {    PInt $1 }
+| Bytes                    {  PBytes $1 }
 | String                   { PString $1 }
 | C_Unit                   {   PUnit $1 }
 | C_False                  {  PFalse $1 }

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

@@ -740,3 +740,517 @@ let tokens_to_string      = to_string print_tokens
 let path_to_string        = to_string print_path
 let pattern_to_string     = to_string print_pattern
 let instruction_to_string = to_string print_instruction
+
+(* Pretty-printing the AST *)
+
+let mk_pad len rank pc =
+  pc ^ (if rank = len-1 then "`-- " else "|-- "),
+  pc ^ (if rank = len-1 then "    " else "|   ")
+
+let rec pp_ast buffer ~pad:(pd,pc) {decl; _} =
+  let node = sprintf "%s<ast>\n" pd in
+  let () = Buffer.add_string buffer node in
+  let apply len rank =
+    let pad = mk_pad len rank pc in
+    pp_declaration buffer ~pad in
+  let decls = Utils.nseq_to_list decl
+  in List.iteri (List.length decls |> apply) decls
+
+and pp_ident buffer ~pad:(pd,_) name =
+  let node = sprintf "%s%s\n" pd name
+  in Buffer.add_string buffer node
+
+and pp_string buffer = pp_ident buffer
+
+and pp_declaration buffer ~pad:(pd,pc) = function
+  TypeDecl {value; _} ->
+    let node = sprintf "%sTypeDecl\n" pd in
+    Buffer.add_string buffer node;
+    pp_ident buffer ~pad:(mk_pad 2 0 pc) value.name.value;
+    pp_type_expr buffer ~pad:(mk_pad 2 1 pc) value.type_expr
+| ConstDecl {value; _} ->
+    let node = sprintf "%sConstDecl\n" pd in
+    Buffer.add_string buffer node;
+    pp_const_decl buffer ~pad:(mk_pad 1 0 pc) value
+| LambdaDecl lamb ->
+    let node = sprintf "%sLambdaDecl\n" pd in
+    Buffer.add_string buffer node;
+    pp_lambda_decl buffer ~pad:(mk_pad 1 0 pc) lamb
+
+and pp_const_decl buffer ~pad:(_,pc) decl =
+  pp_ident buffer ~pad:(mk_pad 3 0 pc) decl.name.value;
+  pp_type_expr buffer ~pad:(mk_pad 3 1 pc) decl.const_type;
+  pp_expr buffer ~pad:(mk_pad 3 2 pc) decl.init
+
+and pp_type_expr buffer ~pad:(pd,pc as pad) = function
+  TProd cartesian ->
+    let node = sprintf "%sTProd\n" pd in
+    Buffer.add_string buffer node;
+    pp_cartesian buffer ~pad cartesian
+| TAlias {value; _} ->
+    let node = sprintf "%sTAlias\n" pd in
+    Buffer.add_string buffer node;
+    pp_ident buffer ~pad:(mk_pad 1 0 pc) value
+| TPar {value; _} ->
+    let node = sprintf "%sTPar\n" pd in
+    Buffer.add_string buffer node;
+    pp_type_expr buffer ~pad:(mk_pad 1 0 pc) value.inside
+| TApp {value=name,tuple; _} ->
+    let node = sprintf "%sTApp\n" pd in
+    Buffer.add_string buffer node;
+    pp_ident buffer ~pad:(mk_pad 1 0 pc) name.value;
+    pp_type_tuple buffer ~pad:(mk_pad 2 1 pc) tuple
+| TFun {value; _} ->
+    let node = sprintf "%sTFun\n" pd in
+    let () = Buffer.add_string buffer node in
+    let apply len rank =
+      let pad = mk_pad len rank pc in
+      pp_type_expr buffer ~pad in
+    let domain, _, range = value in
+    List.iteri (apply 2) [domain; range]
+| TSum {value; _} ->
+    let node = sprintf "%sTSum\n" pd in
+    let () = Buffer.add_string buffer node in
+    let apply len rank variant =
+      let pad = mk_pad len rank pc in
+      pp_variant buffer ~pad variant.value in
+    let variants = Utils.nsepseq_to_list value in
+    List.iteri (List.length variants |> apply) variants
+| TRecord {value; _} ->
+    let node = sprintf "%sTRecord\n" pd in
+    let () = Buffer.add_string buffer node in
+    let apply len rank field_decl =
+      pp_field_decl buffer ~pad:(mk_pad len rank pc)
+                    field_decl.value in
+    let fields = Utils.sepseq_to_list value.elements in
+    List.iteri (List.length fields |> apply) fields
+
+and pp_cartesian buffer ~pad:(_,pc) {value; _} =
+  let apply len rank =
+    pp_type_expr buffer ~pad:(mk_pad len rank pc) in
+  let components = Utils.nsepseq_to_list value
+  in List.iteri (List.length components |> apply) components
+
+and pp_variant buffer ~pad:(pd,_ as pad) {constr; args} =
+  let node = sprintf "%s%s\n" pd constr.value in
+  Buffer.add_string buffer node;
+  match args with
+          None -> ()
+  | Some (_,c) -> pp_cartesian buffer ~pad c
+
+and pp_field_decl buffer ~pad:(pd,pc) decl =
+  let node = sprintf "%s%s\n" pd decl.field_name.value in
+  Buffer.add_string buffer node;
+  pp_type_expr buffer ~pad:(mk_pad 1 0 pc) decl.field_type
+
+and pp_type_tuple buffer ~pad:(_,pc) {value; _} =
+  let components = Utils.nsepseq_to_list value.inside in
+  let apply len rank =
+    pp_type_expr buffer ~pad:(mk_pad len rank pc)
+  in List.iteri (List.length components |> apply) components
+
+and pp_lambda_decl buffer ~pad = function
+  FunDecl {value; _} ->
+    let node = sprintf "%sFunDecl\n" (fst pad) in
+    Buffer.add_string buffer node;
+    pp_fun_decl buffer ~pad value
+| ProcDecl {value; _} ->
+    let node = sprintf "%sProcDecl\n" (fst pad) in
+    Buffer.add_string buffer node;
+    pp_proc_decl buffer ~pad value
+
+and pp_fun_decl buffer ~pad:(_,pc) decl =
+  let () =
+    let pad = mk_pad 6 0 pc in
+    pp_ident buffer ~pad decl.name.value in
+  let () =
+    let pd, _ as pad = mk_pad 6 1 pc in
+    let node = sprintf "%s<parameters>\n" pd in
+    Buffer.add_string buffer node;
+    pp_parameters buffer ~pad decl.param in
+  let () =
+    let pd, pc = mk_pad 6 2 pc in
+    let node = sprintf "%s<return type>\n" pd in
+    Buffer.add_string buffer node;
+    pp_type_expr buffer ~pad:(mk_pad 1 0 pc) decl.ret_type in
+  let () =
+    let pd, _ as pad = mk_pad 6 3 pc in
+    let node = sprintf "%s<local declarations>\n" pd in
+    Buffer.add_string buffer node;
+    pp_local_decls buffer ~pad decl.local_decls in
+  let () =
+    let pd, _ as pad = mk_pad 6 4 pc in
+    let node = sprintf "%s<block>\n" pd in
+    let statements = decl.block.value.statements in
+    Buffer.add_string buffer node;
+    pp_statements buffer ~pad statements in
+  let () =
+    let pd, pc = mk_pad 6 5 pc in
+    let node = sprintf "%s<return>\n" pd in
+    Buffer.add_string buffer node;
+    pp_expr buffer ~pad:(mk_pad 1 0 pc) decl.return
+  in ()
+
+and pp_parameters buffer ~pad:(_,pc) {value; _} =
+  let params = Utils.nsepseq_to_list value.inside in
+  let arity  = List.length params in
+  let apply len rank =
+    pp_param_decl buffer ~pad:(mk_pad len rank pc)
+  in List.iteri (apply arity) params
+
+and pp_param_decl buffer ~pad:(pd,pc) = function
+  ParamConst {value; _} ->
+    let node = sprintf "%sParamConst\n" pd in
+    Buffer.add_string buffer node;
+    pp_ident buffer ~pad:(mk_pad 2 0 pc) value.var.value;
+    pp_type_expr buffer ~pad:(mk_pad 2 1 pc) value.param_type
+| ParamVar {value; _} ->
+    let node = sprintf "%sParamVar\n" pd in
+    Buffer.add_string buffer node;
+    pp_ident buffer ~pad:(mk_pad 2 0 pc) value.var.value;
+    pp_type_expr buffer ~pad:(mk_pad 2 1 pc) value.param_type
+
+and pp_statements buffer ~pad:(_,pc) statements =
+  let statements = Utils.nsepseq_to_list statements in
+  let length     = List.length statements in
+  let apply len rank =
+    pp_statement buffer ~pad:(mk_pad len rank pc)
+  in List.iteri (apply length) statements
+
+and pp_statement buffer ~pad:(pd,pc as pad) = function
+  Instr instr ->
+    let node = sprintf "%sInstr\n" pd in
+    Buffer.add_string buffer node;
+    pp_instruction buffer ~pad:(mk_pad 1 0 pc) instr
+| Data data_decl ->
+    let node = sprintf "%sData\n" pd in
+    Buffer.add_string buffer node;
+    pp_data_decl buffer ~pad data_decl
+
+and pp_instruction buffer ~pad:(pd,pc as pad) = function
+  Single single_instr ->
+    let node = sprintf "%sSingle\n" pd in
+    Buffer.add_string buffer node;
+    pp_single_instr buffer ~pad:(mk_pad 1 0 pc) single_instr
+| Block {value; _} ->
+    let node = sprintf "%sBlock\n" pd in
+    Buffer.add_string buffer node;
+    pp_statements buffer ~pad value.statements
+
+and pp_single_instr buffer ~pad:(pd,pc as pad) = function
+  Cond {value; _} ->
+    let node = sprintf "%sCond\n" pd in
+    Buffer.add_string buffer node;
+    pp_conditional buffer ~pad value
+| CaseInstr {value; _} ->
+    let node = sprintf "%sCaseInstr\n" pd in
+    Buffer.add_string buffer node;
+    pp_case pp_instruction buffer ~pad value
+| Assign {value; _} ->
+    let node = sprintf "%sAssign\n" pd in
+    Buffer.add_string buffer node;
+    pp_assignment buffer ~pad value
+| Loop loop ->
+    let node = sprintf "%sLoop\n" pd in
+    Buffer.add_string buffer node;
+    pp_loop buffer ~pad:(mk_pad 1 0 pc) loop
+| ProcCall call ->
+    let node = sprintf "%sProcCall\n" pd in
+    Buffer.add_string buffer node;
+    pp_fun_call buffer ~pad:(mk_pad 1 0 pc) call
+| Skip _ ->
+    let node = sprintf "%sSkip\n" pd in
+    Buffer.add_string buffer node
+| RecordPatch {value; _} ->
+    let node = sprintf "%sRecordPatch\n" pd in
+    Buffer.add_string buffer node;
+    pp_record_patch buffer ~pad:(mk_pad 1 0 pc) value
+| MapPatch {value; _} ->
+    let node = sprintf "%sMapPatch\n" pd in
+    Buffer.add_string buffer node;
+    pp_map_patch buffer ~pad:(mk_pad 1 0 pc) value
+| SetPatch {value; _} ->
+    let node = sprintf "%SetPatch\n" pd in
+    Buffer.add_string buffer node;
+    pp_set_patch buffer ~pad:(mk_pad 1 0 pc) value
+| MapRemove {value; _} ->
+    let node = sprintf "%sMapRemove\n" pd in
+    Buffer.add_string buffer node;
+    pp_map_remove buffer ~pad:(mk_pad 1 0 pc) value
+| SetRemove {value; _} ->
+    let node = sprintf "%sSetRemove\n" pd in
+    Buffer.add_string buffer node;
+    pp_set_remove buffer ~pad:(mk_pad 1 0 pc) value
+
+and pp_conditional buffer ~pad:(_,pc) cond =
+  let () =
+    let pd, pc = mk_pad 3 0 pc in
+    let node = sprintf "%s<condition>\n" pd in
+    Buffer.add_string buffer node;
+    pp_expr buffer ~pad:(mk_pad 1 0 pc) cond.test in
+  let () =
+    let pd, pc = mk_pad 3 1 pc in
+    let node = sprintf "%s<true>\n" pd in
+    Buffer.add_string buffer node;
+    pp_if_clause buffer ~pad:(mk_pad 1 0 pc) cond.ifso in
+  let () =
+    let pd, pc = mk_pad 3 2 pc in
+    let node = sprintf "%s<false>\n" pd in
+    Buffer.add_string buffer node;
+    pp_if_clause buffer ~pad:(mk_pad 2 1 pc) cond.ifnot
+  in ()
+
+and pp_if_clause buffer ~pad:(pd,pc) = function
+  ClauseInstr instr ->
+    let node = sprintf "%sClauseInstr\n" pd in
+    Buffer.add_string buffer node;
+    pp_instruction buffer ~pad:(mk_pad 1 0 pc) instr
+| ClauseBlock {value; _} ->
+    let node = sprintf "%sClauseBlock\n" pd in
+    let statements, _ = value.inside in
+    Buffer.add_string buffer node;
+    pp_statements buffer ~pad:(mk_pad 1 0 pc) statements
+
+and pp_case printer buffer ~pad:(_,pc) case =
+  let clauses = Utils.nsepseq_to_list case.cases.value in
+  let length  = List.length clauses in
+  let apply len rank =
+    pp_case_clause printer buffer ~pad:(mk_pad len rank pc)
+  in pp_expr buffer ~pad:(mk_pad length 0 pc) case.expr;
+  List.iteri (apply length) clauses
+
+and pp_case_clause printer buffer ~pad:(pd,pc) {value; _} =
+  let node = sprintf "%s<clause>\n" pd in
+  Buffer.add_string buffer node;
+  pp_pattern buffer ~pad:(mk_pad 2 0 pc) value.pattern;
+  printer buffer ~pad:(mk_pad 2 1 pc) value.rhs
+
+and pp_pattern buffer ~pad:(pd,pc as pad) = function
+  PNone _ ->
+    let node = sprintf "%sPNone\n" pd in
+    Buffer.add_string buffer node
+| PSome {value=_,{value=par; _}; _} ->
+    let node = sprintf "%sPSome\n" pd in
+    Buffer.add_string buffer node;
+    pp_pattern buffer ~pad:(mk_pad 1 0 pc) par.inside
+| PWild _ ->
+    let node = sprintf "%sPWild\n" pd
+    in Buffer.add_string buffer node
+| PConstr {value; _} ->
+    let node = sprintf "%sPConstr\n" pd in
+    Buffer.add_string buffer node;
+    pp_constr buffer ~pad:(mk_pad 1 0 pc) value
+| PCons {value; _} ->
+  let node     = sprintf "%sPCons\n" pd in
+  let patterns = Utils.nsepseq_to_list value in
+  let length   = List.length patterns in
+  let apply len rank =
+    pp_pattern buffer ~pad:(mk_pad len rank pc) in
+  Buffer.add_string buffer node;
+  List.iteri (apply length) patterns
+| PVar {value; _} ->
+    let node = sprintf "%sPVar\n" pd in
+    Buffer.add_string buffer node;
+    pp_ident buffer ~pad:(mk_pad 1 0 pc) value
+| PInt {value; _} ->
+    let node = sprintf "%sPInt\n" pd in
+    Buffer.add_string buffer node;
+    pp_int buffer ~pad value
+| PBytes {value; _} ->
+    let node = sprintf "%sPBytes\n" pd in
+    Buffer.add_string buffer node;
+    pp_bytes buffer ~pad value
+| PString {value; _} ->
+    let node = sprintf "%sPString\n" pd in
+    Buffer.add_string buffer node;
+    pp_ident buffer ~pad:(mk_pad 1 0 pc) value
+| PUnit _ ->
+    let node = sprintf "%sPUnit\n" pd in
+    Buffer.add_string buffer node
+| PFalse _ ->
+    let node = sprintf "%sPFalse\n" pd in
+    Buffer.add_string buffer node
+| PTrue _ ->
+    let node = sprintf "%sPTrue\n" pd in
+    Buffer.add_string buffer node
+| PList plist ->
+    let node = sprintf "%sPList\n" pd in
+    Buffer.add_string buffer node;
+    pp_plist buffer ~pad:(mk_pad 1 0 pc) plist
+| PTuple {value; _} ->
+    let node = sprintf "%sPTuple\n" pd in
+    Buffer.add_string buffer node;
+    pp_tuple_pattern buffer ~pad:(mk_pad 1 0 pc) value
+
+and pp_bytes buffer ~pad:(_,pc) (lexeme, hex) =
+  pp_string buffer ~pad:(mk_pad 2 0 pc) lexeme;
+  pp_string buffer ~pad:(mk_pad 2 1 pc) (Hex.to_string hex)
+
+and pp_int buffer ~pad:(_,pc) (lexeme, z) =
+  pp_string buffer ~pad:(mk_pad 2 0 pc) lexeme;
+  pp_string buffer ~pad:(mk_pad 2 1 pc) (Z.to_string z)
+
+and pp_constr buffer ~pad = function
+  {value; _}, None ->
+    pp_ident buffer ~pad value
+| {value=id; _}, Some {value=ptuple; _} ->
+    pp_ident buffer ~pad id;
+    pp_tuple_pattern buffer ~pad ptuple
+
+and pp_plist buffer ~pad:(pd,pc) = function
+  Sugar {value; _} ->
+    let node = sprintf "%sSugar\n" pd in
+    Buffer.add_string buffer node;
+    pp_injection pp_pattern buffer ~pad:(mk_pad 1 0 pc) value
+| PNil _ ->
+    let node = sprintf "%sPNil\n" pd in
+    Buffer.add_string buffer node
+| Raw {value; _} ->
+    let node = sprintf "%sRaw\n" pd in
+    Buffer.add_string buffer node;
+    pp_raw buffer ~pad:(mk_pad 1 0 pc) value.inside
+
+and pp_raw buffer ~pad:(_,pc) (head, _, tail) =
+  pp_pattern buffer ~pad:(mk_pad 2 0 pc) head;
+  pp_pattern buffer ~pad:(mk_pad 2 1 pc) tail
+
+and pp_injection printer buffer ~pad:(_,pc) inj =
+  let elements = Utils.sepseq_to_list inj.elements in
+  let length   = List.length elements in
+  let apply len rank =
+    printer buffer ~pad:(mk_pad len rank pc)
+  in List.iteri (apply length) elements
+
+and pp_tuple_pattern buffer ~pad:(_,pc) tuple =
+  let patterns = Utils.nsepseq_to_list tuple.inside in
+  let length   = List.length patterns in
+  let apply len rank =
+    pp_pattern buffer ~pad:(mk_pad len rank pc)
+  in List.iteri (apply length) patterns
+
+and pp_assignment buffer ~pad:(_,pc) asgn =
+  pp_lhs buffer ~pad:(mk_pad 2 0 pc) asgn.lhs;
+  pp_rhs buffer ~pad:(mk_pad 2 1 pc) asgn.rhs
+
+and pp_rhs buffer ~pad:(pd,pc) rhs =
+  let node = sprintf "%s<rhs>\n" pd in
+  Buffer.add_string buffer node;
+  pp_expr buffer ~pad:(mk_pad 1 0 pc) rhs
+
+and pp_lhs buffer ~pad:(pd,pc) lhs =
+  let node = sprintf "%s<lhs>\n" pd in
+  Buffer.add_string buffer node;
+  let pd, pc as pad = mk_pad 1 0 pc in
+  match lhs with
+    Path path ->
+      let node = sprintf "%sPath\n" pd in
+      Buffer.add_string buffer node;
+      pp_path buffer ~pad:(mk_pad 1 0 pc) path
+  | MapPath {value; _} ->
+      let node = sprintf "%sMapPath\n" pd in
+      Buffer.add_string buffer node;
+      pp_map_lookup buffer ~pad value
+
+and pp_path buffer ~pad:(pd,pc as pad) = function
+  Name {value; _} ->
+    let node = sprintf "%sName\n" pd in
+    Buffer.add_string buffer node;
+    pp_ident buffer ~pad:(mk_pad 1 0 pc) value
+| Path {value; _} ->
+    let node = sprintf "%sPath\n" pd in
+    Buffer.add_string buffer node;
+    pp_projection buffer ~pad value
+
+and pp_projection buffer ~pad:(_,pc) proj =
+  let selections = Utils.nsepseq_to_list proj.field_path in
+  let len = List.length selections in
+  let apply len rank =
+    pp_selection buffer ~pad:(mk_pad len rank pc) in
+  pp_ident buffer ~pad:(mk_pad (1+len) 0 pc) proj.struct_name.value;
+  List.iteri (apply len) selections
+
+and pp_selection buffer ~pad:(pd,pc as pad) = function
+  FieldName {value; _} ->
+    let node = sprintf "%sFieldName\n" pd in
+    Buffer.add_string buffer node;
+    pp_ident buffer ~pad:(mk_pad 1 0 pc) value
+| Component {value; _} ->
+    let node = sprintf "%sComponent\n" pd in
+    Buffer.add_string buffer node;
+    pp_int buffer ~pad value
+
+and pp_map_lookup buffer ~pad:(_,pc) lookup =
+  pp_path buffer ~pad:(mk_pad 2 0 pc) lookup.path;
+  pp_expr buffer ~pad:(mk_pad 2 1 pc) lookup.index.value.inside
+
+and pp_loop buffer ~pad:(pd,pc) loop =
+  let node = sprintf "%sPP_LOOP\n" pd in
+  Buffer.add_string buffer node
+
+and pp_fun_call buffer ~pad:(pd,pc) call =
+  let node = sprintf "%sPP_FUN_CALL\n" pd in
+  Buffer.add_string buffer node
+
+and pp_record_patch buffer ~pad:(pd,pc) patch =
+  let node = sprintf "%sPP_RECORD_PATCH\n" pd in
+  Buffer.add_string buffer node
+
+and pp_map_patch buffer ~pad:(pd,pc) patch =
+  let node = sprintf "%sPP_MAP_PATCH\n" pd in
+  Buffer.add_string buffer node
+
+and pp_set_patch buffer ~pad:(pd,pc) patch =
+  let node = sprintf "%sPP_SET_PATCH\n" pd in
+  Buffer.add_string buffer node
+
+and pp_map_remove buffer ~pad:(pd,pc) rem =
+  let node = sprintf "%sPP_MAP_REMOVE\n" pd in
+  Buffer.add_string buffer node
+
+and pp_set_remove buffer ~pad:(pd,pc) rem =
+  let node = sprintf "%sPP_SET_REMOVE\n" pd in
+  Buffer.add_string buffer node
+
+and pp_local_decls buffer ~pad:(_,pc) decls =
+  let apply len rank =
+    pp_local_decl buffer ~pad:(mk_pad len rank pc)
+  in List.iteri (List.length decls |> apply) decls
+
+and pp_local_decl buffer ~pad:(pd,pc) = function
+  LocalFun {value; _} ->
+    let node = sprintf "%sLocalFun\n" pd in
+    Buffer.add_string buffer node;
+    pp_fun_decl buffer ~pad:(mk_pad 1 0 pc) value
+| LocalProc {value; _} ->
+    let node = sprintf "%sLocalProc\n" pd in
+    Buffer.add_string buffer node;
+    pp_proc_decl buffer ~pad:(mk_pad 1 0 pc) value
+| LocalData data ->
+    let node = sprintf "%sLocalData\n" pd in
+    Buffer.add_string buffer node;
+    pp_data_decl buffer ~pad:(mk_pad 1 0 pc) data
+
+and pp_data_decl buffer ~pad = function
+  LocalConst {value; _} ->
+    let node = sprintf "%sLocalConst\n" (fst pad) in
+    Buffer.add_string buffer node;
+    pp_const_decl buffer ~pad value
+| LocalVar {value; _} ->
+    let node = sprintf "%sLocalVar\n" (fst pad) in
+    Buffer.add_string buffer node;
+    pp_var_decl buffer ~pad value
+
+and pp_var_decl buffer ~pad:(_,pc) decl =
+  pp_ident buffer ~pad:(mk_pad 3 0 pc) decl.name.value;
+  pp_type_expr buffer ~pad:(mk_pad 3 1 pc) decl.var_type;
+  pp_expr buffer ~pad:(mk_pad 3 2 pc) decl.init
+
+and pp_proc_decl buffer ~pad:(pd,pc) decl =
+  let node = sprintf "%sPP_PROC_DECL\n" pd in
+  Buffer.add_string buffer node
+
+and pp_expr buffer ~pad:(pd,pc) decl =
+  let node = sprintf "%sPP_EXPR\n" pd in
+  Buffer.add_string buffer node
+
+let pp_ast buffer = pp_ast buffer ~pad:("","")

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

@@ -12,3 +12,5 @@ val tokens_to_string      : AST.t -> string
 val path_to_string        : AST.path -> string
 val pattern_to_string     : AST.pattern -> string
 val instruction_to_string : AST.instruction -> string
+
+val pp_ast : Buffer.t -> AST.t -> unit

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

@@ -107,7 +107,8 @@ let () =
          begin
            ParserLog.offsets := options.offsets;
            ParserLog.mode    := options.mode;
-           ParserLog.print_tokens buffer ast;
+           (*           ParserLog.print_tokens buffer ast;*)
+           ParserLog.pp_ast buffer ast;
            Buffer.output_buffer stdout buffer
          end
   with

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

@@ -62,20 +62,20 @@ module type TOKEN =
 
     type   int_err = Non_canonical_zero
     type ident_err = Reserved_name
-    type invalid_natural = 
+    type   nat_err = Invalid_natural
-      | Invalid_natural
                    | Non_canonical_zero_nat
+    type   sym_err = Invalid_symbol
 
     (* Injections *)
 
-    val mk_string : lexeme -> Region.t -> token
-    val mk_bytes  : lexeme -> Region.t -> token
     val mk_int    : lexeme -> Region.t -> (token,   int_err) result
-    val mk_nat    : lexeme -> Region.t -> (token,   invalid_natural) result
+    val mk_nat    : lexeme -> Region.t -> (token,   nat_err) result
     val mk_mtz    : lexeme -> Region.t -> (token,   int_err) result
     val mk_ident  : lexeme -> Region.t -> (token, ident_err) result
+    val mk_sym    : lexeme -> Region.t -> (token,   sym_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_sym    : lexeme -> Region.t -> token
     val eof       : Region.t -> token
 
     (* Predicates *)

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

@@ -103,20 +103,20 @@ module type TOKEN =
 
     type   int_err = Non_canonical_zero
     type ident_err = Reserved_name
-    type invalid_natural =
+    type   nat_err = Invalid_natural
-      | Invalid_natural
                    | Non_canonical_zero_nat
+    type   sym_err = Invalid_symbol
 
     (* Injections *)
 
-    val mk_string : lexeme -> Region.t -> token
-    val mk_bytes  : lexeme -> Region.t -> token
     val mk_int    : lexeme -> Region.t -> (token,   int_err) result
-    val mk_nat    : lexeme -> Region.t -> (token,   invalid_natural) result
+    val mk_nat    : lexeme -> Region.t -> (token,   nat_err) result
     val mk_mtz    : lexeme -> Region.t -> (token,   int_err) result
     val mk_ident  : lexeme -> Region.t -> (token, ident_err) result
+    val mk_sym    : lexeme -> Region.t -> (token,   sym_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_sym    : lexeme -> Region.t -> token
     val eof       : Region.t -> token
 
     (* Predicates *)
@@ -343,6 +343,7 @@ module Make (Token: TOKEN) : (S with module Token = Token) =
     type Error.t += Broken_string
     type Error.t += Invalid_character_in_string
     type Error.t += Reserved_name
+    type Error.t += Invalid_symbol
     type Error.t += Invalid_natural
 
     let error_to_string = function
@@ -386,6 +387,9 @@ module Make (Token: TOKEN) : (S with module Token = Token) =
     | Reserved_name ->
         "Reserved named.\n\
          Hint: Change the name.\n"
+    | Invalid_symbol ->
+        "Invalid symbol.\n\
+         Hint: Check the LIGO syntax you use.\n"
     | Invalid_natural ->
         "Invalid natural."
     | _ -> assert false
@@ -487,8 +491,10 @@ module Make (Token: TOKEN) : (S with module Token = Token) =
       in Token.mk_constr lexeme region, state
 
     let mk_sym state buffer =
-      let region, lexeme, state = sync state buffer
+      let region, lexeme, state = sync state buffer in
-      in Token.mk_sym lexeme region, state
+      match Token.mk_sym lexeme region with
+        Ok token -> token, state
+      | Error Token.Invalid_symbol -> fail region Invalid_symbol
 
     let mk_eof state buffer =
       let region, _, state = sync state buffer
@@ -518,11 +524,16 @@ let byte_seq   = byte | byte (byte | '_')* byte
 let bytes      = "0x" (byte_seq? as seq)
 let esc        = "\\n" | "\\\"" | "\\\\" | "\\b"
                | "\\r" | "\\t" | "\\x" byte
-let symbol     = ';' | ',' | '(' | ')'| '[' | ']' | '{' | '}'
+let pascaligo_sym = "=/=" | '#' | ":="
-               | '#' | '|' | "->" | ":=" | '=' | ':'
+let cameligo_sym = "<>" | "::" | "||" | "&&"
-               | '<' | "<=" | '>' | ">=" | "=/=" | "<>"
+
-               | '+' | '-' | '*' | '/' | '.' | '_' | '^'
+let symbol =
-               | "::" | "||" | "&&"
+  ';' | ',' | '(' | ')'| '[' | ']' | '{' | '}'
+| '=' | ':' | '|' | "->" | '.' | '_' | '^'
+| '+' | '-' | '*' | '/'
+| '<' | "<=" | '>' | ">="
+| pascaligo_sym | cameligo_sym
+
 let string = [^'"' '\\' '\n']*  (* For strings of #include *)
 
 (* RULES *)