Merge pull request #221 from AltGr/options-record

Command-line: use a record for the options

compiler/catala_web_interpreter.ml

@@ -11,9 +11,18 @@ let _ =
            (trace : bool) =
          driver
            (Contents (Js.to_string contents))
-           false false false false "Interpret"
-           (Some (Js.to_string language))
-           None trace false false
-           (Some (Js.to_string scope))
-           None
+           {
+             Utils.Cli.debug = false;
+             unstyled = false;
+             wrap_weaved_output = false;
+             avoid_exceptions = false;
+             backend = "Interpret";
+             language = Some (Js.to_string language);
+             max_prec_digits = None;
+             trace = false;
+             disable_counterexamples = false;
+             optimize = false;
+             ex_scope = Some (Js.to_string scope);
+             output_file = None;
+           }
     end)

compiler/driver.ml

@@ -29,38 +29,20 @@ let extensions =
 
 (** Entry function for the executable. Returns a negative number in case of
     error. Usage:
-    [driver source_file debug dcalc unstyled wrap_weaved_output backend language max_prec_digits trace optimize scope_to_execute output_file]*)
-let driver
-    (source_file : Pos.input_file)
-    (debug : bool)
-    (unstyled : bool)
-    (wrap_weaved_output : bool)
-    (avoid_exceptions : bool)
-    (backend : string)
-    (language : string option)
-    (max_prec_digits : int option)
-    (trace : bool)
-    (disable_counterexamples : bool)
-    (optimize : bool)
-    (ex_scope : string option)
-    (output_file : string option) : int =
+    [driver source_file options]*)
+let driver source_file (options : Cli.options) : int =
   try
-    Cli.debug_flag := debug;
-    Cli.style_flag := not unstyled;
-    Cli.trace_flag := trace;
-    Cli.optimize_flag := optimize;
-    Cli.disable_counterexamples := disable_counterexamples;
-    Cli.avoid_exceptions_flag := avoid_exceptions;
+    Cli.set_option_globals options;
     Cli.debug_print "Reading files...";
     let filename = ref "" in
     (match source_file with
-    | FileName f -> filename := f
+    | Pos.FileName f -> filename := f
     | Contents c -> Cli.contents := c);
-    (match max_prec_digits with
+    (match options.max_prec_digits with
     | None -> ()
     | Some i -> Cli.max_prec_digits := i);
     let l =
-      match language with
+      match options.language with
       | Some l -> l
       | None -> (
           (* Try to infer the language from the intput file extension. *)
@@ -79,6 +61,7 @@ let driver
           "The selected language (%s) is not supported by Catala" l
     in
     Cli.locale_lang := language;
+    let backend = options.backend in
     let backend =
       let backend = String.lowercase_ascii backend in
       if backend = "makefile" then Cli.Makefile
@@ -112,7 +95,7 @@ let driver
                 "The Makefile backend does not work if the input is not a file"
         in
         let output_file =
-          match output_file with
+          match options.output_file with
           | Some f -> f
           | None -> Filename.remove_extension source_file ^ ".d"
         in
@@ -142,7 +125,7 @@ let driver
           | Cli.Html -> "HTML"
           | _ -> assert false (* should not happen *));
         let output_file =
-          match output_file with
+          match options.output_file with
           | Some f -> f
           | None -> (
               Filename.remove_extension source_file
@@ -163,7 +146,7 @@ let driver
         in
         Cli.debug_print "Writing to %s" output_file;
         let fmt = Format.formatter_of_out_channel oc in
-        if wrap_weaved_output then
+        if options.wrap_weaved_output then
           match backend with
           | Cli.Latex ->
               Literate.Latex.wrap_latex prgm.Surface.Ast.program_source_files
@@ -179,7 +162,7 @@ let driver
         Cli.debug_print "Name resolution...";
         let ctxt = Surface.Name_resolution.form_context prgm in
         let scope_uid =
-          match (ex_scope, backend) with
+          match (options.ex_scope, backend) with
           | None, Cli.Interpret ->
               Errors.raise_error "No scope was provided for execution."
           | None, _ ->
@@ -201,13 +184,13 @@ let driver
         let prgm = Desugared.Desugared_to_scope.translate_program prgm in
         if backend = Cli.Scopelang then begin
           let fmt, at_end =
-            match output_file with
+            match options.output_file with
             | Some f ->
                 let oc = open_out f in
                 (Format.formatter_of_out_channel oc, fun _ -> close_out oc)
             | None -> (Format.std_formatter, fun _ -> ())
           in
-          if Option.is_some ex_scope then
+          if Option.is_some options.ex_scope then
             Format.fprintf fmt "%a\n" Scopelang.Print.format_scope
               ( scope_uid,
                 Scopelang.Ast.ScopeMap.find scope_uid prgm.program_scopes )
@@ -220,7 +203,7 @@ let driver
           Scopelang.Scope_to_dcalc.translate_program prgm
         in
         let prgm =
-          if optimize then begin
+          if options.optimize then begin
             Cli.debug_print "Optimizing default calculus...";
             Dcalc.Optimizations.optimize_program prgm
           end
@@ -231,15 +214,15 @@ let driver
         in
         if backend = Cli.Dcalc then begin
           let fmt, at_end =
-            match output_file with
+            match options.output_file with
             | Some f ->
                 let oc = open_out f in
                 (Format.formatter_of_out_channel oc, fun _ -> close_out oc)
             | None -> (Format.std_formatter, fun _ -> ())
           in
-          if Option.is_some ex_scope then
+          if Option.is_some options.ex_scope then
             Format.fprintf fmt "%a\n"
-              (Dcalc.Print.format_scope ~debug prgm.decl_ctx)
+              (Dcalc.Print.format_scope ~debug:options.debug prgm.decl_ctx)
               (let _, _, s =
                  List.find (fun (name, _, _) -> name = scope_uid) prgm.scopes
                in
@@ -299,12 +282,12 @@ let driver
         | Cli.OCaml | Cli.Python | Cli.Lcalc | Cli.Scalc ->
             Cli.debug_print "Compiling program into lambda calculus...";
             let prgm =
-              if avoid_exceptions then
+              if options.avoid_exceptions then
                 Lcalc.Compile_without_exceptions.translate_program prgm
               else Lcalc.Compile_with_exceptions.translate_program prgm
             in
             let prgm =
-              if optimize then begin
+              if options.optimize then begin
                 Cli.debug_print "Optimizing lambda calculus...";
                 Lcalc.Optimizations.optimize_program prgm
               end
@@ -312,15 +295,15 @@ let driver
             in
             if backend = Cli.Lcalc then begin
               let fmt, at_end =
-                match output_file with
+                match options.output_file with
                 | Some f ->
                     let oc = open_out f in
                     (Format.formatter_of_out_channel oc, fun _ -> close_out oc)
                 | None -> (Format.std_formatter, fun _ -> ())
               in
-              if Option.is_some ex_scope then
+              if Option.is_some options.ex_scope then
                 Format.fprintf fmt "%a\n"
-                  (Lcalc.Print.format_scope ~debug prgm.decl_ctx)
+                  (Lcalc.Print.format_scope ~debug:options.debug prgm.decl_ctx)
                   (let body =
                      List.find
                        (fun body -> body.Lcalc.Ast.scope_body_name = scope_uid)
@@ -345,7 +328,7 @@ let driver
                     "This backend does not work if the input is not a file"
             in
             let new_output_file (extension : string) : string =
-              match output_file with
+              match options.output_file with
               | Some f -> f
               | None -> Filename.remove_extension source_file ^ extension
             in
@@ -362,16 +345,17 @@ let driver
                 let prgm = Scalc.Compile_from_lambda.translate_program prgm in
                 if backend = Cli.Scalc then begin
                   let fmt, at_end =
-                    match output_file with
+                    match options.output_file with
                     | Some f ->
                         let oc = open_out f in
                         ( Format.formatter_of_out_channel oc,
                           fun _ -> close_out oc )
                     | None -> (Format.std_formatter, fun _ -> ())
                   in
-                  if Option.is_some ex_scope then
+                  if Option.is_some options.ex_scope then
                     Format.fprintf fmt "%a\n"
-                      (Scalc.Print.format_scope ~debug prgm.decl_ctx)
+                      (Scalc.Print.format_scope ~debug:options.debug
+                         prgm.decl_ctx)
                       (let body =
                          List.find
                            (fun body ->

compiler/driver.mli

@@ -0,0 +1,23 @@
+(* This file is part of the Catala compiler, a specification language for tax
+   and social benefits computation rules. Copyright (C) 2020 Inria,
+   contributors: Denis Merigoux <denis.merigoux@inria.fr>, Emile Rolley
+   <emile.rolley@tuta.io>
+
+   Licensed under the Apache License, Version 2.0 (the "License"); you may not
+   use this file except in compliance with the License. You may obtain a copy of
+   the License at
+
+   http://www.apache.org/licenses/LICENSE-2.0
+
+   Unless required by applicable law or agreed to in writing, software
+   distributed under the License is distributed on an "AS IS" BASIS, WITHOUT
+   WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the
+   License for the specific language governing permissions and limitations under
+   the License. *)
+
+val driver : Utils.Pos.input_file -> Utils.Cli.options -> int
+(** Entry function for the executable. Returns a negative number in case of
+    error. *)
+
+val main : unit -> unit
+(** Main program entry point, including command-line parsing and return code *)

compiler/utils/cli.ml

@@ -143,12 +143,65 @@ let output =
            compiler. Defaults to $(i,FILE).$(i,EXT) where $(i,EXT) depends on \
            the chosen backend.")
 
-let catala_t f =
+type options = {
+  debug : bool;
+  unstyled : bool;
+  wrap_weaved_output : bool;
+  avoid_exceptions : bool;
+  backend : string;
+  language : string option;
+  max_prec_digits : int option;
+  trace : bool;
+  disable_counterexamples : bool;
+  optimize : bool;
+  ex_scope : string option;
+  output_file : string option;
+}
+
+let options =
+  let make
+      debug
+      unstyled
+      wrap_weaved_output
+      avoid_exceptions
+      backend
+      language
+      max_prec_digits
+      trace
+      disable_counterexamples
+      optimize
+      ex_scope
+      output_file : options =
+    {
+      debug;
+      unstyled;
+      wrap_weaved_output;
+      avoid_exceptions;
+      backend;
+      language;
+      max_prec_digits;
+      trace;
+      disable_counterexamples;
+      optimize;
+      ex_scope;
+      output_file;
+    }
+  in
   Term.(
-    const f $ file $ debug $ unstyled $ wrap_weaved_output $ avoid_exceptions
+    const make $ debug $ unstyled $ wrap_weaved_output $ avoid_exceptions
     $ backend $ language $ max_prec_digits_opt $ trace_opt
     $ disable_counterexamples_opt $ optimize $ ex_scope $ output)
 
+let catala_t f = Term.(const f $ file $ options)
+
+let set_option_globals options : unit =
+  debug_flag := options.debug;
+  style_flag := not options.unstyled;
+  trace_flag := options.trace;
+  optimize_flag := options.optimize;
+  disable_counterexamples := options.disable_counterexamples;
+  avoid_exceptions_flag := options.avoid_exceptions
+
 let version = "0.5.0"
 
 let info =

compiler/utils/cli.mli

@@ -70,25 +70,28 @@ val max_prec_digits_opt : int option Cmdliner.Term.t
 val ex_scope : string option Cmdliner.Term.t
 val output : string option Cmdliner.Term.t
 
-val catala_t :
-  (string ->
-  bool ->
-  bool ->
-  bool ->
-  bool ->
-  string ->
-  string option ->
-  int option ->
-  bool ->
-  bool ->
-  bool ->
-  string option ->
-  string option ->
-  'a) ->
-  'a Cmdliner.Term.t
-(** Main entry point:
-    [catala_t file debug unstyled wrap_weaved_output avoid_exceptions backend language max_prec_digits_opt trace_opt disable_counterexamples optimize ex_scope output] *)
+type options = {
+  debug : bool;
+  unstyled : bool;
+  wrap_weaved_output : bool;
+  avoid_exceptions : bool;
+  backend : string;
+  language : string option;
+  max_prec_digits : int option;
+  trace : bool;
+  disable_counterexamples : bool;
+  optimize : bool;
+  ex_scope : string option;
+  output_file : string option;
+}
+(** {2 Command-line application} *)
 
+val options : options Cmdliner.Term.t
+
+val catala_t : (string -> options -> 'a) -> 'a Cmdliner.Term.t
+(** Main entry point: [catala_t file options] *)
+
+val set_option_globals : options -> unit
 val version : string
 val info : Cmdliner.Term.info