Merge pull request #1324 from stan-dev/feature/canonicalize-strip-com…

…ments

Allow canonicalizer to omit printing comments

src/frontend/Canonicalize.ml

@@ -3,16 +3,25 @@ open Ast
 open Deprecation_analysis
 
 type canonicalizer_settings =
-  {deprecations: bool; parentheses: bool; braces: bool; inline_includes: bool}
+  { deprecations: bool
+  ; parentheses: bool
+  ; braces: bool
+  ; inline_includes: bool
+  ; strip_comments: bool }
 
-let all =
-  {deprecations= true; parentheses= true; inline_includes= true; braces= true}
+let legacy =
+  { deprecations= true
+  ; parentheses= true
+  ; inline_includes= true
+  ; braces= true
+  ; strip_comments= false }
 
 let none =
   { deprecations= false
   ; parentheses= false
   ; inline_includes= false
-  ; braces= false }
+  ; braces= false
+  ; strip_comments= false }
 
 let rec repair_syntax_stmt user_dists {stmt; smeta} =
   match stmt with

src/frontend/Canonicalize.mli

@@ -8,9 +8,15 @@ open Ast
     to stanc, but it consumed by the pretty-printer, {i not} this module.
 *)
 type canonicalizer_settings =
-  {deprecations: bool; parentheses: bool; braces: bool; inline_includes: bool}
+  { deprecations: bool
+  ; parentheses: bool
+  ; braces: bool
+  ; inline_includes: bool
+  ; strip_comments: bool }
+
+val legacy : canonicalizer_settings
+(** Equivalent to what [--print-canonical] did before these settings were available *)
 
-val all : canonicalizer_settings
 val none : canonicalizer_settings
 
 val repair_syntax : untyped_program -> canonicalizer_settings -> untyped_program

src/frontend/Pretty_printing.ml

@@ -13,8 +13,8 @@ let comments : comment_type list ref = ref []
 
 let skipped = ref []
 
-let set_comments ?(inline_includes = false) ls =
-  let filtered =
+let set_comments ?(inline_includes = false) ?(strip_comments = false) ls =
+  let includes_filtered =
     if inline_includes then
       List.filter ~f:(function Include _ -> false | _ -> true) ls
     else
@@ -28,7 +28,13 @@ let set_comments ?(inline_includes = false) ls =
               false
           | _ -> true )
         ls in
-  comments := filtered
+  let stripped =
+    if strip_comments then
+      List.filter
+        ~f:(function LineComment _ | BlockComment _ -> false | _ -> true)
+        includes_filtered
+    else includes_filtered in
+  comments := stripped
 
 let get_comments end_loc =
   let rec go ls =
@@ -513,7 +519,7 @@ let rec pp_block_list ppf = function
         pp_block_list ppf tl )
   | [] -> pp_spacing None None ppf (remaining_comments ())
 
-let pp_program ~bare_functions ~line_length ~inline_includes ppf
+let pp_program ~bare_functions ~line_length ~inline_includes ~strip_comments ppf
     { functionblock= bf
     ; datablock= bd
     ; transformeddatablock= btd
@@ -523,7 +529,7 @@ let pp_program ~bare_functions ~line_length ~inline_includes ppf
     ; generatedquantitiesblock= bgq
     ; comments } =
   Format.pp_set_margin ppf line_length ;
-  set_comments ~inline_includes comments ;
+  set_comments ~inline_includes ~strip_comments comments ;
   print_included := inline_includes ;
   Format.pp_open_vbox ppf 0 ;
   if bare_functions then pp_bare_block ppf @@ Option.value_exn bf
@@ -539,18 +545,19 @@ let pp_program ~bare_functions ~line_length ~inline_includes ppf
 
 let check_correctness ?(bare_functions = false) prog pretty =
   let result_ast =
-    try
-      let res, (_ : Warnings.t list) =
-        if bare_functions then
-          Parse.parse_string Parser.Incremental.functions_only pretty
-        else Parse.parse_string Parser.Incremental.program pretty in
-      Option.value_exn (Result.ok res)
-    with _ ->
-      Common.FatalError.fatal_error_msg
-        [%message
-          "Pretty-printed program failed to parse"
-            (prog : Ast.untyped_program)
-            pretty] in
+    let res, (_ : Warnings.t list) =
+      if bare_functions then
+        Parse.parse_string Parser.Incremental.functions_only pretty
+      else Parse.parse_string Parser.Incremental.program pretty in
+    match res with
+    | Ok prog -> prog
+    | Error e ->
+        let error = Errors.to_string e in
+        Common.FatalError.fatal_error_msg
+          [%message
+            "Pretty-printed program failed to parse" error
+              (prog : Ast.untyped_program)
+              pretty] in
   if compare_untyped_program prog result_ast <> 0 then
     Common.FatalError.fatal_error_msg
       [%message
@@ -562,13 +569,16 @@ let pp_typed_expression ppf e =
   pp_expression ppf (untyped_expression_of_typed_expression e)
 
 let pretty_print_program ?(bare_functions = false) ?(line_length = 78)
-    ?(inline_includes = false) p =
+    ?(inline_includes = false) ?(strip_comments = false) p =
   let result =
-    str "%a" (pp_program ~bare_functions ~line_length ~inline_includes) p in
+    str "%a"
+      (pp_program ~bare_functions ~line_length ~inline_includes ~strip_comments)
+      p in
   check_correctness ~bare_functions p result ;
   result
 
 let pretty_print_typed_program ?(bare_functions = false) ?(line_length = 78)
-    ?(inline_includes = false) p =
+    ?(inline_includes = false) ?(strip_comments = false) p =
   pretty_print_program ~bare_functions ~line_length ~inline_includes
+    ~strip_comments
     (untyped_program_of_typed_program p)

src/frontend/Pretty_printing.mli

@@ -5,12 +5,14 @@ val pretty_print_program :
      ?bare_functions:bool
   -> ?line_length:int
   -> ?inline_includes:bool
+  -> ?strip_comments:bool
   -> Ast.untyped_program
   -> string
 
 val pretty_print_typed_program :
      ?bare_functions:bool
   -> ?line_length:int
   -> ?inline_includes:bool
+  -> ?strip_comments:bool
   -> Ast.typed_program
   -> string

src/stanc/stanc.ml

@@ -50,13 +50,14 @@ let parse_canonical_options (settings : Canonicalize.canonicalizer_settings)
   | "parentheses" -> {settings with parentheses= true}
   | "braces" -> {settings with braces= true}
   | "includes" -> {settings with inline_includes= true}
+  | "strip-comments" -> {settings with strip_comments= true}
   | s ->
       raise
       @@ Arg.Bad
            ( "Unrecognized canonicalizer option '" ^ s
            ^ "'. \n\
               Should be one of 'deprecations', 'parentheses', 'braces', \
-              'includes'" )
+              'includes', 'strip-comments'" )
 
 (** Some example command-line options here *)
 let options =
@@ -144,7 +145,8 @@ let options =
                 (String.split s ~on:',') in
             canonicalize_settings := settings )
       , " Enable specific canonicalizations in a comma seperated list. Options \
-         are 'deprecations', 'parentheses', 'braces', 'includes'." )
+         are 'deprecations', 'parentheses', 'braces', 'includes', \
+         'strip-comments'." )
     ; ( "--max-line-length"
       , Arg.Set_int pretty_print_line_length
       , " Set the maximum line length for the formatter. Defaults to 78 \
@@ -153,9 +155,9 @@ let options =
       , Arg.Unit
           (fun () ->
             pretty_print_program := true ;
-            canonicalize_settings := Canonicalize.all )
+            canonicalize_settings := Canonicalize.legacy )
       , " Prints the canonicalized program. Equivalent to --auto-format \
-         --canonicalize [all options]" )
+         --canonicalize deprecations,includes,parentheses,braces" )
     ; ( "--version"
       , Arg.Unit
           (fun _ ->
@@ -302,7 +304,8 @@ let use_file filename =
     print_or_write
       (Pretty_printing.pretty_print_typed_program
          ~bare_functions:!bare_functions ~line_length:!pretty_print_line_length
-         ~inline_includes:!canonicalize_settings.inline_includes canonical_ast ) ;
+         ~inline_includes:!canonicalize_settings.inline_includes canonical_ast
+         ~strip_comments:!canonicalize_settings.strip_comments ) ;
   if !print_info_json then (
     print_endline (Info.info canonical_ast) ;
     exit 0 ) ;

src/stancjs/stancjs.ml

@@ -35,7 +35,7 @@ let stan2cpp model_name model_string is_flag_set flag_val =
         if is_flag_set "info" then
           r.return (Result.Ok (Info.info typed_ast), warnings, []) ;
         let canonicalizer_settings =
-          if is_flag_set "print-canonical" then Canonicalize.all
+          if is_flag_set "print-canonical" then Canonicalize.legacy
           else
             match flag_val "canonicalize" with
             | None -> Canonicalize.none
@@ -46,6 +46,7 @@ let stan2cpp model_name model_string is_flag_set flag_val =
                       Canonicalize.{settings with deprecations= true}
                   | "parentheses" -> {settings with parentheses= true}
                   | "braces" -> {settings with braces= true}
+                  | "strip-comments" -> {settings with strip_comments= true}
                   (* this probably never applies to stancjs, but for completion: *)
                   | "includes" -> {settings with inline_includes= true}
                   | _ -> settings in
@@ -68,6 +69,7 @@ let stan2cpp model_name model_string is_flag_set flag_val =
                    ~bare_functions:(is_flag_set "functions-only")
                    ~line_length
                    ~inline_includes:canonicalizer_settings.inline_includes
+                   ~strip_comments:canonicalizer_settings.strip_comments
                    (Canonicalize.canonicalize_program typed_ast
                       canonicalizer_settings ) )
             , warnings

test/integration/cli-args/canonicalize/canonicalize.t

@@ -1,7 +1,7 @@
 Test that a nonsense argument is caught
   $ stanc --canonicalize dummy
   stanc: Unrecognized canonicalizer option 'dummy'. 
-  Should be one of 'deprecations', 'parentheses', 'braces', 'includes'.
+  Should be one of 'deprecations', 'parentheses', 'braces', 'includes', 'strip-comments'.
   Usage: %%NAME%% [option] ... <model_file.stan[functions]>
     --debug-lex                     For debugging purposes: print the lexer actions
     --debug-parse                   For debugging purposes: print the parser actions
@@ -23,9 +23,9 @@ Test that a nonsense argument is caught
     --warn-uninitialized            Emit warnings about uninitialized variables to stderr. Currently an experimental feature.
     --warn-pedantic                 Emit warnings about common mistakes in Stan programs.
     --auto-format                   Pretty prints a formatted version of the Stan program.
-    --canonicalize                  Enable specific canonicalizations in a comma seperated list. Options are 'deprecations', 'parentheses', 'braces', 'includes'.
+    --canonicalize                  Enable specific canonicalizations in a comma seperated list. Options are 'deprecations', 'parentheses', 'braces', 'includes', 'strip-comments'.
     --max-line-length               Set the maximum line length for the formatter. Defaults to 78 characters.
-    --print-canonical               Prints the canonicalized program. Equivalent to --auto-format --canonicalize [all options]
+    --print-canonical               Prints the canonicalized program. Equivalent to --auto-format --canonicalize deprecations,includes,parentheses,braces
     --version                       Display stanc version number
     --name                          Take a string to set the model name (default = "$model_filename_model")
     --O0                            (Default) Do not apply optimizations to the Stan code.
@@ -70,9 +70,9 @@ Test capitalization - this should fail due to the lack of model_name, not the ca
     --warn-uninitialized            Emit warnings about uninitialized variables to stderr. Currently an experimental feature.
     --warn-pedantic                 Emit warnings about common mistakes in Stan programs.
     --auto-format                   Pretty prints a formatted version of the Stan program.
-    --canonicalize                  Enable specific canonicalizations in a comma seperated list. Options are 'deprecations', 'parentheses', 'braces', 'includes'.
+    --canonicalize                  Enable specific canonicalizations in a comma seperated list. Options are 'deprecations', 'parentheses', 'braces', 'includes', 'strip-comments'.
     --max-line-length               Set the maximum line length for the formatter. Defaults to 78 characters.
-    --print-canonical               Prints the canonicalized program. Equivalent to --auto-format --canonicalize [all options]
+    --print-canonical               Prints the canonicalized program. Equivalent to --auto-format --canonicalize deprecations,includes,parentheses,braces
     --version                       Display stanc version number
     --name                          Take a string to set the model name (default = "$model_filename_model")
     --O0                            (Default) Do not apply optimizations to the Stan code.

test/integration/cli-args/canonicalize/dune

@@ -37,6 +37,20 @@
     "%{bin:stanc} --auto-format --canonicalize braces,parentheses"
     %{stanfiles}))))
 
+(rule
+ (targets strip-comments.output)
+ (deps
+  (package stanc)
+  (:stanfiles
+   (glob_files *.stan*)))
+ (action
+  (with-outputs-to
+   %{targets}
+   (run
+    %{bin:run_bin_on_args}
+    "%{bin:stanc} --auto-format --canonicalize strip-comments,braces,parentheses,deprecations"
+    %{stanfiles}))))
+
 (rule
  (alias runtest)
  (action
@@ -51,3 +65,8 @@
  (alias runtest)
  (action
   (diff everything-but.expected everything-but.output)))
+
+(rule
+ (alias runtest)
+ (action
+  (diff strip-comments.expected strip-comments.output)))