Exported pretty-printing function for CameLIGO and ReasonLIGO (transpiler).

src/passes/1-parser/cameligo.ml

@@ -5,6 +5,7 @@ module Scoping  = Parser_cameligo.Scoping
 module Region   = Simple_utils.Region
 module ParErr   = Parser_cameligo.ParErr
 module SSet     = Set.Make (String)
+module Pretty   = Parser_cameligo.Pretty
 
 (* Mock IOs TODO: Fill them with CLI options *)
 
@@ -149,3 +150,18 @@ let parse_expression source = apply (fun () -> Unit.expr_in_string source)
 (* Preprocessing a contract in a file *)
 
 let preprocess source = apply (fun () -> Unit.preprocess source)
+
+(* Pretty-print a file (after parsing it). *)
+
+let pretty_print source =
+  match parse_file source with
+    Stdlib.Error _ as e -> e
+  | Ok ast ->
+      let doc    = Pretty.make (fst ast) in
+      let buffer = Buffer.create 131 in
+      let width  =
+        match Terminal_size.get_columns () with
+          None -> 60
+        | Some c -> c in
+      let () = PPrint.ToBuffer.pretty 1.0 width buffer doc
+      in Trace.ok buffer

src/passes/1-parser/cameligo.mli

@@ -19,3 +19,6 @@ val parse_expression : string -> AST.expr Trace.result
 
 (** Preprocess a given CameLIGO file and preprocess it. *)
 val preprocess : string -> Buffer.t Trace.result
+
+(** Pretty-print a given CameLIGO file (after parsing it). *)
+val pretty_print : string -> Buffer.t Trace.result

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

@@ -86,7 +86,7 @@ nsepseq(item,sep):
 (* Non-empty comma-separated values (at least two values) *)
 
 tuple(item):
-  item "," nsepseq(item,",") { let h,t = $3 in $1,($2,h)::t }
+  item "," nsepseq(item,",") { let h,t = $3 in $1, ($2,h)::t }
 
 (* Possibly empty semicolon-separated values between brackets *)
 
@@ -236,10 +236,7 @@ type_annotation:
 irrefutable:
   sub_irrefutable { $1 }
 | tuple(sub_irrefutable) {
-    let hd, tl = $1 in
-    let start  = pattern_to_region hd in
-    let stop   = last fst tl in
-    let region = cover start stop
+    let region = nsepseq_to_region pattern_to_region $1
     in PTuple {region; value=$1} }
 
 sub_irrefutable:
@@ -276,9 +273,7 @@ pattern:
     PList (PCons {region; value=$1,$2,$3})
   }
 | tuple(sub_pattern) {
-    let start  = pattern_to_region (fst $1) in
-    let stop   = last fst (snd $1) in
-    let region = cover start stop
+    let region = nsepseq_to_region pattern_to_region $1
     in PTuple {region; value=$1} }
 
 sub_pattern:
@@ -332,10 +327,7 @@ constr_pattern:
 
 ptuple:
   tuple(tail) {
-    let hd, tl = $1 in
-    let start  = pattern_to_region hd in
-    let stop   = last fst tl in
-    let region = cover start stop
+    let region = nsepseq_to_region pattern_to_region $1
     in PTuple {region; value=$1} }
 
 unit:
@@ -371,9 +363,7 @@ base_expr(right_expr):
 
 tuple_expr:
   tuple(disj_expr_level) {
-    let start  = expr_to_region (fst $1) in
-    let stop   = last fst (snd $1) in
-    let region = cover start stop
+    let region = nsepseq_to_region expr_to_region $1
     in ETuple {region; value=$1} }
 
 conditional(right_expr):

src/passes/1-parser/cameligo/dune

@@ -15,8 +15,10 @@
   (name parser_cameligo)
   (public_name ligo.parser.cameligo)
   (modules
-     Scoping AST cameligo Parser ParserLog LexToken ParErr)
+     Scoping AST cameligo Parser ParserLog LexToken ParErr Pretty)
   (libraries
+     pprint
+     terminal_size
      menhirLib
      parser_shared
      str
@@ -26,8 +28,8 @@
     (pps bisect_ppx --conditional))
   (flags (:standard -open Parser_shared -open Simple_utils)))
 
-;; Build of the unlexer (for covering the
-;; error states of the LR automaton)
+;; Build of the unlexer (for covering the error states of the LR
+;; automaton)
 
 (executable
   (name Unlexer)

src/passes/1-parser/reasonligo.ml

@@ -181,3 +181,18 @@ let parse_expression source = apply (fun () -> Unit.expr_in_string source)
 (* Preprocessing a contract in a file *)
 
 let preprocess source = apply (fun () -> Unit.preprocess source)
+
+(* Pretty-print a file (after parsing it). *)
+
+let pretty_print source =
+  match parse_file source with
+    Stdlib.Error _ as e -> e
+  | Ok ast ->
+      let doc    = Pretty.make (fst ast) in
+      let buffer = Buffer.create 131 in
+      let width  =
+        match Terminal_size.get_columns () with
+          None -> 60
+        | Some c -> c in
+      let () = PPrint.ToBuffer.pretty 1.0 width buffer doc
+      in Trace.ok buffer

src/passes/1-parser/reasonligo.mli

@@ -19,3 +19,6 @@ val parse_expression : string -> AST.expr Trace.result
 
 (** Preprocess a given ReasonLIGO file and preprocess it. *)
 val preprocess : string -> Buffer.t Trace.result
+
+(** Pretty-print a given CameLIGO file (after parsing it). *)
+val pretty_print : string -> Buffer.t Trace.result

src/passes/1-parser/reasonligo/.links

@@ -27,5 +27,6 @@ Stubs/Parser_cameligo.ml
 ../cameligo/ParserLog.ml
 ../cameligo/Scoping.mli
 ../cameligo/Scoping.ml
+../cameligo/Pretty.ml
 
 $HOME/git/ligo/_build/default/src/passes/1-parser/reasonligo/ParErr.ml

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

@@ -139,7 +139,7 @@ nsepseq(item,sep):
 (* Non-empty comma-separated values (at least two values) *)
 
 tuple(item):
-  item "," nsepseq(item,",") { let h,t = $3 in $1,($2,h)::t }
+  item "," nsepseq(item,",") { let h,t = $3 in $1, ($2,h)::t }
 
 (* Possibly empty semicolon-separated values between brackets *)
 
@@ -295,10 +295,7 @@ let_binding:
 | tuple(sub_irrefutable) type_annotation? "=" expr {
     wild_error $4;
     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
-    let region  = cover start stop in
+    let region  = nsepseq_to_region pattern_to_region $1 in
     let binders = PTuple {value=$1; region}, [] in
     {binders; lhs_type=$2; eq=$3; let_rhs=$4} }
 
@@ -669,8 +666,9 @@ disj_expr_level:
   disj_expr
 | conj_expr_level { $1 }
 | par(tuple(disj_expr_level)) type_annotation_simple? {
-    let region = $1.region in
+    let region = nsepseq_to_region expr_to_region $1.value.inside in
     let tuple  = ETuple {value=$1.value.inside; region} in
+    let tuple  = EPar {$1 with value = {$1.value with inside=tuple}} in
     let region =
       match $2 with
         Some (_,s) -> cover $1.region (type_expr_to_region s)

src/passes/1-parser/reasonligo/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,7 +75,18 @@ 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)