* Renamed [TStringLiteral] as [TString].

* LexToken.mll for CameLIGO: Fixed printing of "Str"
    into "String".
  * Added CLI option --pretty to call the pretty-printer from
    ParserMain.
  * Use the package Terminal_size to try to determine the width
    of the terminal where the source is pretty-printed.

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

@@ -137,11 +137,14 @@ and ast = t
 and attributes = attribute list
 
 and declaration =
-  Let      of (kwd_let * kwd_rec option * let_binding * attributes) reg
+  Let      of let_decl
 | TypeDecl of type_decl reg
 
 (* Non-recursive values *)
 
+and let_decl =
+  (kwd_let * kwd_rec option * let_binding * attributes) reg
+
 and let_binding = {
   binders  : pattern nseq;
   lhs_type : (colon * type_expr) option;
@@ -166,7 +169,7 @@ and type_expr =
 | TFun    of (type_expr * arrow * type_expr) reg
 | TPar    of type_expr par reg
 | TVar    of variable
-| TStringLiteral of Lexer.lexeme reg
+| TString of Lexer.lexeme reg
 
 and cartesian = (type_expr, times) nsepseq reg
 
@@ -408,7 +411,7 @@ let type_expr_to_region = function
 | TApp {region; _}
 | TFun {region; _}
 | TPar {region; _}
-| TStringLiteral {region; _}
+| TString {region; _}
 | TVar {region; _} -> region
 
 let list_pattern_to_region = function

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

@@ -111,7 +111,7 @@ let proj_token = function
   (* Literals *)
 
   String Region.{region; value} ->
-    region, sprintf "Str %s" value
+    region, sprintf "String %s" value
 | Bytes Region.{region; value = s,b} ->
     region,
     sprintf "Bytes (\"%s\", \"0x%s\")" s (Hex.show b)
@@ -424,21 +424,20 @@ type nat_err =
 | Non_canonical_zero_nat
 
 let mk_nat lexeme region =
-  match (String.index_opt lexeme 'n') with
+  match String.index_opt lexeme 'n' with
       None -> Error Invalid_natural
   | Some _ -> let z =
-               Str.(global_replace (regexp "_") "" lexeme) |>
+                Str.(global_replace (regexp "_") "" lexeme) |>
-                 Str.(global_replace (regexp "n") "") |>
+                  Str.(global_replace (regexp "n") "") |>
-                 Z.of_string in
+                  Z.of_string in
              if   Z.equal z Z.zero && lexeme <> "0n"
              then Error Non_canonical_zero_nat
              else Ok (Nat Region.{region; value = lexeme,z})
 
 let mk_mutez lexeme region =
-  let z =
+  let z = Str.(global_replace (regexp "_") "" lexeme) |>
-    Str.(global_replace (regexp "_") "" lexeme) |>
+            Str.(global_replace (regexp "mutez") "") |>
-    Str.(global_replace (regexp "mutez") "") |>
+            Z.of_string in
-    Z.of_string in
   if   Z.equal z Z.zero && lexeme <> "0mutez"
   then Error Non_canonical_zero
   else Ok (Mutez Region.{region; value = lexeme, z})

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

@@ -149,7 +149,7 @@ cartesian:
 core_type:
   type_name      { TVar $1 }
 | par(type_expr) { TPar $1 }
-| "<string>"     { TStringLiteral $1 }
+| "<string>"     { TString $1 }
 | module_name "." type_name {
     let module_name = $1.value in
     let type_name   = $3.value in
@@ -456,15 +456,14 @@ case_clause(right_expr):
 
 let_expr(right_expr):
   "let" ioption("rec") let_binding seq(Attr) "in" right_expr  {
-    let kwd_let    = $1
+    let stop   = expr_to_region $6 in
-    and kwd_rec    = $2
+    let region = cover $1 stop
-    and binding    = $3
+    and value  = {kwd_let    = $1;
-    and attributes = $4
+                  kwd_rec    = $2;
-    and kwd_in     = $5
+                  binding    = $3;
-    and body       = $6 in
+                  attributes = $4;
-    let stop       = expr_to_region body in
+                  kwd_in     = $5;
-    let region     = cover kwd_let stop
+                  body       = $6}
-    and value      = {kwd_let; kwd_rec; binding; kwd_in; body; attributes}
     in ELetIn {region; value} }
 
 fun_expr(right_expr):
@@ -475,8 +474,7 @@ fun_expr(right_expr):
                   binders    = $2;
                   lhs_type   = None;
                   arrow      = $3;
-                  body       = $4
+                  body       = $4}
-                 }
     in EFun {region; value} }
 
 disj_expr_level:
@@ -651,7 +649,8 @@ update_record:
 
 field_path_assignment :
   nsepseq(field_name,".") "=" expr {
-    let region = cover (nsepseq_to_region (fun x -> x.region) $1) (expr_to_region $3) in
+    let start  = nsepseq_to_region (fun x -> x.region) $1 in
+    let region = cover start (expr_to_region $3) in
     let value  = {field_path = $1;
                   assignment = $2;
                   field_expr = $3}
@@ -675,7 +674,7 @@ sequence:
       match $2 with
         None -> None, None
       | Some (ne_elements, terminator) ->
-         Some ne_elements, terminator in
+          Some ne_elements, terminator in
     let value = {compound; elements; terminator}
     in {region; value} }
 

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

@@ -130,11 +130,10 @@ let rec print_tokens state {decl;eof} =
   print_token state eof "EOF"
 
 and print_attributes state attributes =
-  List.iter (
+  let apply {value = attribute; region} =
-    fun ({value = attribute; region}) ->
+    let attribute_formatted = sprintf "[@@%s]" attribute in
-      let attribute_formatted = sprintf "[@@%s]" attribute in
+    print_token state region attribute_formatted
-      print_token state region attribute_formatted
+  in List.iter apply attributes
-   ) attributes
 
 and print_statement state = function
   Let {value=kwd_let, kwd_rec, let_binding, attributes; _} ->
@@ -156,7 +155,7 @@ and print_type_expr state = function
 | TPar par        -> print_type_par state par
 | TVar var        -> print_var state var
 | TFun t          -> print_fun_type state t
-| TStringLiteral s -> print_string state s
+| TString s       -> print_string state s
 
 and print_fun_type state {value; _} =
   let domain, arrow, range = value in
@@ -1119,14 +1118,14 @@ and pp_type_expr state = function
       pp_type_expr (state#pad len rank) in
     let domain, _, range = value in
     List.iteri (apply 2) [domain; range]
- | TPar {value={inside;_}; region} ->
+| TPar {value={inside;_}; region} ->
     pp_loc_node  state "TPar" region;
     pp_type_expr (state#pad 1 0) inside
- | TVar v ->
+| TVar v ->
     pp_node  state "TVar";
     pp_ident (state#pad 1 0) v
- | TStringLiteral s ->
+| TString s ->
-    pp_node   state "String";
+    pp_node   state "TString";
     pp_string (state#pad 1 0) s
 
 and pp_type_tuple state {value; _} =

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

@@ -22,7 +22,8 @@ module SubIO =
       ext     : string;
       mode    : [`Byte | `Point];
       cmd     : EvalOpt.command;
-      mono    : bool
+      mono    : bool;
+      pretty  : bool
     >
 
     let options : options =
@@ -36,6 +37,7 @@ module SubIO =
         method mode    = IO.options#mode
         method cmd     = IO.options#cmd
         method mono    = IO.options#mono
+        method pretty  = IO.options#pretty
       end
 
     let make =
@@ -48,6 +50,7 @@ module SubIO =
                    ~mode:options#mode
                    ~cmd:options#cmd
                    ~mono:options#mono
+                   ~pretty:options#pretty
   end
 
 module Parser =
@@ -72,9 +75,23 @@ module Unit =
 (* Main *)
 
 let wrap = function
-  Stdlib.Ok _ -> flush_all ()
+  Stdlib.Ok ast ->
+    if IO.options#pretty then
+      begin
+        let doc = Pretty.make ast in
+        let width =
+          match Terminal_size.get_columns () with
+            None -> 60
+          | Some c -> c in
+        PPrint.ToChannel.pretty 1.0 width stdout doc;
+        print_newline ()
+      end;
+    flush_all ()
 | Error msg ->
-    (flush_all (); Printf.eprintf "\027[31m%s\027[0m%!" msg.Region.value)
+    begin
+      flush_all ();
+      Printf.eprintf "\027[31m%s\027[0m%!" msg.Region.value
+    end
 
 let () =
   match IO.options#input with

src/passes/1-parser/cameligo/Tests/pp.mligo

@@ -1,20 +1,21 @@
-type q = {a: int; b: {c: string}}
 type r = int list
-type s = (int, address) map
 type t = int
-type u = {a: int; b: t * char}
+type s = (int,address) map
+type w = timestamp * nat -> (string, address) map -> t
 type v = int * (string * address)
-type w = timestamp * nat -> (string, address) map
+type u = {a: int; b: t * char}
+type q = {a: int; b: {c: string}}
 type x = A | B of t * int | C of int -> (string -> int)
-
+type y = "foo"
-let x = 4
+let x (_, (y: char)) = 4
-let y : t = (if true then -3 + f x x else 0) - 1
+let y {x=(_,y); z=3} = x
-let f (x: int) y = (x : int)
 let z : (t) = y
 let w =
   match f 3 with
     None -> []
   | Some (1::[2;3]) -> [4;5]::[]
+let y : t = (if true then -3 + f x x else 0) - 1
+let f (x: int) y = (x : int)
 let n : nat = 0n
 let a = A
 let b = B a

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

@@ -29,11 +29,12 @@ type options = <
   mode    : [`Byte | `Point];
   cmd     : command;
   mono    : bool;
-  expr    : bool
+  expr    : bool;
+  pretty  : bool
 >
 
 let make ~input ~libs ~verbose ~offsets ?block
-         ?line ~ext ~mode ~cmd ~mono ~expr : options =
+         ?line ~ext ~mode ~cmd ~mono ~expr ~pretty : options =
   object
     method input   = input
     method libs    = libs
@@ -46,6 +47,7 @@ let make ~input ~libs ~verbose ~offsets ?block
     method cmd     = cmd
     method mono    = mono
     method expr    = expr
+    method pretty  = pretty
   end
 
 (* Auxiliary functions *)
@@ -77,6 +79,7 @@ let help extension () =
   print "      --bytes            Bytes for source locations";
   print "      --mono             Use Menhir monolithic API";
   print "      --expr             Parse an expression";
+  print "      --pretty           Pretty-print the input";
   print "      --verbose=<stages> cli, preproc, ast-tokens, ast (colon-separated)";
   print "      --version          Commit hash on stdout";
   print "  -h, --help             This help";
@@ -100,6 +103,7 @@ and libs     = ref []
 and verb_str = ref ""
 and mono     = ref false
 and expr     = ref false
+and pretty   = ref false
 
 let split_at_colon = Str.(split (regexp ":"))
 
@@ -121,6 +125,7 @@ let specs extension =
     noshort, "bytes",   set bytes true, None;
     noshort, "mono",    set mono true, None;
     noshort, "expr",    set expr true, None;
+    noshort, "pretty",  set pretty true, None;
     noshort, "verbose", None, Some add_verbose;
     'h',     "help",    Some (help extension), None;
     noshort, "version", Some version, None
@@ -156,6 +161,7 @@ let print_opt () =
   printf "bytes    = %b\n" !bytes;
   printf "mono     = %b\n" !mono;
   printf "expr     = %b\n" !expr;
+  printf "pretty   = %b\n" !pretty;
   printf "verbose  = %s\n" !verb_str;
   printf "input    = %s\n" (string_of quote !input);
   printf "libs     = %s\n" (string_of_path !libs)
@@ -185,6 +191,7 @@ let check ?block ?line ~ext =
   and mono    = !mono
   and expr    = !expr
   and verbose = !verbose
+  and pretty  = !pretty
   and libs    = !libs in
 
   let () =
@@ -199,6 +206,7 @@ let check ?block ?line ~ext =
         printf "mode     = %s\n" (if mode = `Byte then "`Byte" else "`Point");
         printf "mono     = %b\n" mono;
         printf "expr     = %b\n" expr;
+        printf "pretty   = %b\n" pretty;
         printf "verbose  = %s\n" !verb_str;
         printf "input    = %s\n" (string_of quote input);
         printf "libs     = %s\n" (string_of_path libs)
@@ -214,7 +222,7 @@ let check ?block ?line ~ext =
     | _ -> abort "Choose one of -q, -c, -u, -t."
 
   in make ~input ~libs ~verbose ~offsets ~mode
-          ~cmd ~mono ~expr ?block ?line ~ext
+          ~cmd ~mono ~expr ?block ?line ~ext ~pretty
 
 (* Parsing the command-line options *)
 

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

@@ -47,7 +47,10 @@ type command = Quiet | Copy | Units | Tokens
       {li If the field [expr] is [true], then the parser for
           expressions is used, otherwise a full-fledged contract is
           expected.}
-} *)
+
+       {li If the field [pretty] is [true], then the source is
+           pretty-printed on the standard out.}
+    } *)
 
 module SSet : Set.S with type elt = string and type t = Set.Make(String).t
 
@@ -67,7 +70,8 @@ type options = <
   mode    : [`Byte | `Point];
   cmd     : command;
   mono    : bool;
-  expr    : bool
+  expr    : bool;
+  pretty  : bool
 >
 
 val make :
@@ -82,6 +86,7 @@ val make :
   cmd:command ->
   mono:bool ->
   expr:bool ->
+  pretty:bool ->
   options
 
 (** Parsing the command-line options on stdin. *)

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

@@ -15,7 +15,8 @@ module type SubIO =
       ext     : string;
       mode    : [`Byte | `Point];
       cmd     : EvalOpt.command;
-      mono    : bool
+      mono    : bool;
+      pretty  : bool
     >
 
     val options : options

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

@@ -17,7 +17,8 @@ module type SubIO =
       ext     : string;
       mode    : [`Byte | `Point];
       cmd     : EvalOpt.command;
-      mono    : bool
+      mono    : bool;
+      pretty  : bool
     >
 
     val options : options