CatalaLang/catala
1
1
Fork 0
mirror of https://github.com/CatalaLang/catala.git synced 2024-11-08 07:51:43 +03:00
Code Issues Projects Releases Wiki Activity

Rename utils to catala_utils

Browse Source
This commit is contained in:
Louis Gesbert 2022-11-21 10:46:17 +01:00
parent b329afbbdb
commit 660e5775de
96 changed files with 173 additions and 157 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
build_system/clerk_driver.ml
View File

@ -16,7 +16,7 @@
the License. *)
open Cmdliner
open Utils
open Catala_utils
open Ninja_utils
module Nj = Ninja_utils

2
build_system/dune
View File

@ -9,7 +9,7 @@
(public_name clerk.driver)
(libraries
catala.runtime_ocaml
catala.utils
catala.catala_utils
ninja_utils
cmdliner
re

6
compiler/utils/utils.mld → compiler/catala_utils/catala_utils.mld
View File

@ -7,12 +7,12 @@ In {{: desugared.html} the desugared representation} or in the
global identifiers. These identifiers use OCaml's type system to statically
distinguish e.g. a scope identifier from a struct identifier.
The {!module: Utils.Uid} module provides a generative functor whose output is
The {!module: Uid} module provides a generative functor whose output is
a fresh sort of global identifiers.
Related modules:
{!modules: Utils.Uid}
{!modules: Uid}
{1 Source code positions}
@ -22,7 +22,7 @@ code. These annotations are critical to produce readable error messages.
Related modules:
{!modules: Utils.Pos}
{!modules: Pos}
{1 Error messages}

0
compiler/utils/cli.ml → compiler/catala_utils/cli.ml
View File

0
compiler/utils/cli.mli → compiler/catala_utils/cli.mli
View File

6
compiler/utils/dune → compiler/catala_utils/dune
View File

@ -1,8 +1,8 @@
(library
(name utils)
(public_name catala.utils)
(name catala_utils)
(public_name catala.catala_utils)
(libraries cmdliner ubase ANSITerminal re bindlib catala.runtime_ocaml))
(documentation
(package catala)
(mld_files utils))
(mld_files catala_utils))

0
compiler/utils/errors.ml → compiler/catala_utils/errors.ml
View File

0
compiler/utils/errors.mli → compiler/catala_utils/errors.mli
View File

0
compiler/utils/file.ml → compiler/catala_utils/file.ml
View File

0
compiler/utils/file.mli → compiler/catala_utils/file.mli
View File

0
compiler/utils/marked.ml → compiler/catala_utils/marked.ml
View File

0
compiler/utils/marked.mli → compiler/catala_utils/marked.mli
View File

0
compiler/utils/pos.ml → compiler/catala_utils/pos.ml
View File

0
compiler/utils/pos.mli → compiler/catala_utils/pos.mli
View File

0
compiler/utils/string_common.ml → compiler/catala_utils/string_common.ml
View File

0
compiler/utils/string_common.mli → compiler/catala_utils/string_common.mli
View File

6
compiler/utils/uid.ml → compiler/catala_utils/uid.ml
View File

@ -18,7 +18,7 @@ module type Info = sig
type info
val to_string : info -> string
val format_info : Format.formatter -> info -> unit
val format : Format.formatter -> info -> unit
val equal : info -> info -> bool
val compare : info -> info -> int
end
@ -59,7 +59,7 @@ module Make (X : Info) () : Id with type info = X.info = struct
let get_info (uid : t) : X.info = uid.info
let format_t (fmt : Format.formatter) (x : t) : unit =
X.format_info fmt x.info
X.format fmt x.info
let hash (x : t) : int = x.id
@ -71,7 +71,7 @@ module MarkedString = struct
type info = string Marked.pos
let to_string (s, _) = s
let format_info fmt i = Format.pp_print_string fmt (to_string i)
let format fmt i = Format.pp_print_string fmt (to_string i)
let equal i1 i2 = String.equal (Marked.unmark i1) (Marked.unmark i2)
let compare i1 i2 = String.compare (Marked.unmark i1) (Marked.unmark i2)
end

2
compiler/utils/uid.mli → compiler/catala_utils/uid.mli
View File

@ -21,7 +21,7 @@ module type Info = sig
type info
val to_string : info -> string
val format_info : Format.formatter -> info -> unit
val format : Format.formatter -> info -> unit
val equal : info -> info -> bool
(** Equality disregards position *)

4
compiler/catala_web_interpreter.ml
View File

@ -1,3 +1,5 @@
open Catala_utils
open Driver
open Js_of_ocaml
@ -12,7 +14,7 @@ let _ =
driver
(Contents (Js.to_string contents))
{
Utils.Cli.debug = false;
Cli.debug = false;
color = Never;
wrap_weaved_output = false;
avoid_exceptions = false;

2
compiler/dcalc/dune
View File

@ -4,7 +4,7 @@
(libraries
bindlib
unionFind
utils
catala_utils
re
ubase
catala.runtime_ocaml

8
compiler/dcalc/from_scopelang.ml
View File

@ -14,7 +14,7 @@
License for the specific language governing permissions and limitations under
the License. *)
open Utils
open Catala_utils
open Shared_ast
type scope_var_ctx = {
@ -102,7 +102,7 @@ let merge_defaults caller callee =
let tag_with_log_entry
(e : 'm Ast.expr boxed)
(l : log_entry)
(markings : Utils.Uid.MarkedString.info list) : 'm Ast.expr boxed =
(markings : Uid.MarkedString.info list) : 'm Ast.expr boxed =
let m = mark_tany (Marked.get_mark e) (Expr.pos e) in
Expr.eapp (Expr.eop (Unop (Log (l, markings))) m) [e] m
@ -375,7 +375,7 @@ let rec translate_expr (ctx : 'm ctx) (e : 'm Scopelang.Ast.expr) :
let translate_rule
(ctx : 'm ctx)
(rule : 'm Scopelang.Ast.rule)
((sigma_name, pos_sigma) : Utils.Uid.MarkedString.info) :
((sigma_name, pos_sigma) : Uid.MarkedString.info) :
('m Ast.expr scope_body_expr Bindlib.box ->
'm Ast.expr scope_body_expr Bindlib.box)
* 'm ctx =
@ -645,7 +645,7 @@ let translate_rule
let translate_rules
(ctx : 'm ctx)
(rules : 'm Scopelang.Ast.rule list)
((sigma_name, pos_sigma) : Utils.Uid.MarkedString.info)
((sigma_name, pos_sigma) : Uid.MarkedString.info)
(mark : 'm mark)
(scope_sig : 'm scope_sig_ctx) :
'm Ast.expr scope_body_expr Bindlib.box * 'm ctx =

2
compiler/dcalc/interpreter.ml
View File

@ -16,7 +16,7 @@
(** Reference interpreter for the default calculus *)
open Utils
open Catala_utils
open Shared_ast
module Runtime = Runtime_ocaml.Runtime

2
compiler/dcalc/interpreter.mli
View File

@ -16,7 +16,7 @@
(** Reference interpreter for the default calculus *)
open Utils
open Catala_utils
open Shared_ast
val evaluate_expr : decl_ctx -> 'm Ast.expr -> 'm Ast.expr

2
compiler/dcalc/optimizations.ml
View File

@ -14,7 +14,7 @@
WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the
License for the specific language governing permissions and limitations under
the License. *)
open Utils
open Catala_utils
open Shared_ast
open Ast

2
compiler/desugared/ast.ml
View File

@ -16,7 +16,7 @@
(** Abstract syntax tree of the desugared representation *)
open Utils
open Catala_utils
open Shared_ast
(** {1 Names, Maps and Keys} *)

2
compiler/desugared/ast.mli
View File

@ -16,7 +16,7 @@
(** Abstract syntax tree of the desugared representation *)
open Utils
open Catala_utils
open Shared_ast
(** Inside a scope, a definition can refer either to a scope def, or a subscope

2
compiler/desugared/dependency.ml
View File

@ -17,7 +17,7 @@
(** Scope dependencies computations using {{:http://ocamlgraph.lri.fr/}
OCamlgraph} *)
open Utils
open Catala_utils
open Shared_ast
(** {1 Scope variables dependency graph} *)

2
compiler/desugared/dependency.mli
View File

@ -17,7 +17,7 @@
(** Scope dependencies computations using {{:http://ocamlgraph.lri.fr/}
OCamlgraph} *)
open Utils
open Catala_utils
open Shared_ast
(** {1 Scope variables dependency graph} *)

2
compiler/desugared/dune
View File

@ -1,7 +1,7 @@
(library
(name desugared)
(public_name catala.desugared)
(libraries ocamlgraph utils shared_ast surface))
(libraries ocamlgraph catala_utils shared_ast surface))
(documentation
(package catala)

2
compiler/desugared/from_surface.ml
View File

@ -15,7 +15,7 @@
License for the specific language governing permissions and limitations under
the License. *)
open Utils
open Catala_utils
module SurfacePrint = Surface.Print
open Shared_ast
module Runtime = Runtime_ocaml.Runtime

14
compiler/desugared/name_resolution.ml
View File

@ -18,7 +18,7 @@
(** Builds a context that allows for mapping each name to a precise uid, taking
lexical scopes into account *)
open Utils
open Catala_utils
open Shared_ast
(** {1 Name resolution context} *)
@ -105,7 +105,7 @@ let raise_unsupported_feature (msg : string) (pos : Pos.t) =
let raise_unknown_identifier (msg : string) (ident : ident Marked.pos) =
Errors.raise_spanned_error (Marked.get_mark ident)
"\"%s\": unknown identifier %s"
(Utils.Cli.with_style [ANSITerminal.yellow] "%s" (Marked.unmark ident))
(Cli.with_style [ANSITerminal.yellow] "%s" (Marked.unmark ident))
msg
(** Gets the type associated to an uid *)
@ -254,7 +254,7 @@ let process_subscope_decl
Errors.raise_multispanned_error
[Some "first use", Marked.get_mark info; Some "second use", s_pos]
"Subscope name \"%a\" already used"
(Utils.Cli.format_with_style [ANSITerminal.yellow])
(Cli.format_with_style [ANSITerminal.yellow])
subscope
| None ->
let sub_scope_uid = SubScopeName.fresh (name, name_pos) in
@ -310,7 +310,7 @@ let rec process_base_typ
| None ->
Errors.raise_spanned_error typ_pos
"Unknown type \"%a\", not a struct or enum previously declared"
(Utils.Cli.format_with_style [ANSITerminal.yellow])
(Cli.format_with_style [ANSITerminal.yellow])
ident))
(** Process a type (function or not) *)
@ -342,7 +342,7 @@ let process_data_decl
Errors.raise_multispanned_error
[Some "First use:", Marked.get_mark info; Some "Second use:", pos]
"Variable name \"%a\" already used"
(Utils.Cli.format_with_style [ANSITerminal.yellow])
(Cli.format_with_style [ANSITerminal.yellow])
name
| None ->
let uid = ScopeVar.fresh (name, pos) in
@ -576,7 +576,7 @@ let process_name_item (ctxt : context) (item : Surface.Ast.code_item Marked.pos)
Some "Second definition:", pos;
]
"%s name \"%a\" already defined" msg
(Utils.Cli.format_with_style [ANSITerminal.yellow])
(Cli.format_with_style [ANSITerminal.yellow])
name
in
match Marked.unmark item with
@ -854,7 +854,7 @@ let process_scope_use (ctxt : context) (suse : Surface.Ast.scope_use) : context
Errors.raise_spanned_error
(Marked.get_mark suse.Surface.Ast.scope_use_name)
"\"%a\": this scope has not been declared anywhere, is it a typo?"
(Utils.Cli.format_with_style [ANSITerminal.yellow])
(Cli.format_with_style [ANSITerminal.yellow])
(Marked.unmark suse.Surface.Ast.scope_use_name)
in
List.fold_left

2
compiler/desugared/name_resolution.mli
View File

@ -18,7 +18,7 @@
(** Builds a context that allows for mapping each name to a precise uid, taking
lexical scopes into account *)
open Utils
open Catala_utils
open Shared_ast
(** {1 Name resolution context} *)

5
compiler/driver.ml
View File

@ -15,10 +15,7 @@
License for the specific language governing permissions and limitations under
the License. *)
module Cli = Utils.Cli
module File = Utils.File
module Errors = Utils.Errors
module Pos = Utils.Pos
open Catala_utils
(** Associates a {!type: Cli.backend_lang} with its string represtation. *)
let languages = ["en", Cli.En; "fr", Cli.Fr; "pl", Cli.Pl]

4
compiler/driver.mli
View File

@ -15,9 +15,11 @@
License for the specific language governing permissions and limitations under
the License. *)
open Catala_utils
module Plugin = Plugin.PluginAPI
val driver : Utils.Pos.input_file -> Utils.Cli.options -> int
val driver : Pos.input_file -> Cli.options -> int
(** Entry function for the executable. Returns a negative number in case of
error. *)

2
compiler/dune
View File

@ -3,7 +3,7 @@
(public_name catala.driver)
(libraries
dynlink
utils
catala_utils
surface
desugared
literate

2
compiler/index.mld
View File

@ -103,7 +103,7 @@ Two more modules contain additional features for the compiler:
{ul
{li {{: literate.html} Literate programming}}
{li {{: utils.html} Compiler utilities}}
{li {{: catala_utils.html} Compiler utilities}}
}
The Catala runtimes documentation is available here:

2
compiler/lcalc/ast.ml
View File

@ -14,7 +14,7 @@
License for the specific language governing permissions and limitations under
the License. *)
open Utils
open Catala_utils
include Shared_ast
type lit = lcalc glit

3
compiler/lcalc/ast.mli
View File

@ -14,6 +14,7 @@
License for the specific language governing permissions and limitations under
the License. *)
open Catala_utils
open Shared_ast
(** Abstract syntax tree for the lambda calculus *)
@ -40,7 +41,7 @@ val make_matchopt_with_abs_arms :
'm expr boxed -> 'm expr boxed -> 'm expr boxed -> 'm expr boxed
val make_matchopt :
Utils.Pos.t ->
Pos.t ->
'm expr Var.t ->
typ ->
'm expr boxed ->

2
compiler/lcalc/closure_conversion.ml
View File

@ -14,7 +14,7 @@
License for the specific language governing permissions and limitations under
the License. *)
open Utils
open Catala_utils
open Shared_ast
open Ast
module D = Dcalc.Ast

4
compiler/lcalc/compile_with_exceptions.ml
View File

@ -14,7 +14,7 @@
License for the specific language governing permissions and limitations under
the License. *)
open Utils
open Catala_utils
open Shared_ast
module D = Dcalc.Ast
module A = Ast
@ -43,7 +43,7 @@ let rec translate_default
Expr.make_app
(Expr.make_var
(Var.translate A.handle_default)
(Expr.with_ty mark_default (Utils.Marked.mark pos TAny)))
(Expr.with_ty mark_default (Marked.mark pos TAny)))
[
Expr.earray exceptions mark_default;
thunk_expr (translate_expr ctx just);

2
compiler/lcalc/compile_without_exceptions.ml
View File

@ -14,7 +14,7 @@
License for the specific language governing permissions and limitations under
the License. *)
open Utils
open Catala_utils
module D = Dcalc.Ast
module A = Ast

2
compiler/lcalc/optimizations.ml
View File

@ -13,7 +13,7 @@
WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the
License for the specific language governing permissions and limitations under
the License. *)
open Utils
open Catala_utils
open Shared_ast
open Ast
module D = Dcalc.Ast

4
compiler/lcalc/to_ocaml.ml
View File

@ -14,7 +14,7 @@
License for the specific language governing permissions and limitations under
the License. *)
open Utils
open Catala_utils
open Shared_ast
open Ast
open String_common
@ -91,7 +91,7 @@ let format_uid_list (fmt : Format.formatter) (uids : Uid.MarkedString.info list)
(Format.pp_print_list
~pp_sep:(fun fmt () -> Format.fprintf fmt ";@ ")
(fun fmt info ->
Format.fprintf fmt "\"%a\"" Utils.Uid.MarkedString.format_info info))
Format.fprintf fmt "\"%a\"" Uid.MarkedString.format info))
uids
let format_string_list (fmt : Format.formatter) (uids : string list) : unit =

2
compiler/literate/dune
View File

@ -1,7 +1,7 @@
(library
(name literate)
(public_name catala.literate)
(libraries re utils surface ubase))
(libraries re catala_utils surface ubase))
(documentation
(package catala)

4
compiler/literate/html.ml
View File

@ -18,7 +18,7 @@
(** This modules weaves the source code and the legislative text together into a
document that law professionals can understand. *)
open Utils
open Catala_utils
open Literate_common
module A = Surface.Ast
module P = Printf
@ -91,7 +91,7 @@ let wrap_html
</ul>\n"
css_as_string (literal_title language)
(literal_generated_by language)
Utils.Cli.version
Cli.version
(pre_html (literal_disclaimer_and_link language))
(literal_source_files language)
(String.concat "\n"

2
compiler/literate/html.mli
View File

@ -17,7 +17,7 @@
(** This modules weaves the source code and the legislative text together into a
document that law professionals can understand. *)
open Utils
open Catala_utils
(** {1 Helpers} *)

4
compiler/literate/latex.ml
View File

@ -18,7 +18,7 @@
(** This modules weaves the source code and the legislative text together into a
document that law professionals can understand. *)
open Utils
open Catala_utils
open Literate_common
module A = Surface.Ast
module R = Re.Pcre
@ -158,7 +158,7 @@ codes={\catcode`\$=3\catcode`\^=7}
https://gouvfr.atlassian.net/wiki/spaces/DB/pages/223019527/Typographie+-+Typography *)
(literal_title language)
(literal_generated_by language)
Utils.Cli.version
Cli.version
(pre_latexify (literal_disclaimer_and_link language))
(literal_source_files language)
(String.concat

2
compiler/literate/latex.mli
View File

@ -17,7 +17,7 @@
(** This modules weaves the source code and the legislative text together into a
document that law professionals can understand. *)
open Utils
open Catala_utils
(** {1 Helpers} *)

2
compiler/literate/literate_common.ml
View File

@ -14,7 +14,7 @@
License for the specific language governing permissions and limitations under
the License. *)
open Utils
open Catala_utils
open Cli
let literal_title = function

14
compiler/literate/literate_common.mli
View File

@ -14,32 +14,32 @@
License for the specific language governing permissions and limitations under
the License. *)
open Utils
open Catala_utils
val literal_title : Cli.backend_lang -> string
(** Return the title traduction according the given
{!type:Utils.Cli.backend_lang}. *)
{!type:Cli.backend_lang}. *)
val literal_generated_by : Cli.backend_lang -> string
(** Return the 'generated by' traduction according the given
{!type:Utils.Cli.backend_lang}. *)
{!type:Cli.backend_lang}. *)
val literal_source_files : Cli.backend_lang -> string
(** Return the 'source files weaved' traduction according the given
{!type:Utils.Cli.backend_lang}. *)
{!type:Cli.backend_lang}. *)
val literal_disclaimer_and_link : Cli.backend_lang -> string
(** Return the traduction of a paragraph giving a basic disclaimer about Catala
and a link to the website according the given {!type:
Utils.Cli.backend_lang}. *)
Cli.backend_lang}. *)
val literal_last_modification : Cli.backend_lang -> string
(** Return the 'last modification' traduction according the given
{!type:Utils.Cli.backend_lang}. *)
{!type:Cli.backend_lang}. *)
val get_language_extension : Cli.backend_lang -> string
(** Return the file extension corresponding to the given
{!type:Utils.Cli.backend_lang}. *)
{!type:Cli.backend_lang}. *)
val run_pandoc : string -> [ `Html | `Latex ] -> string
(** Runs the [pandoc] on a string to pretty-print markdown features into the

8
compiler/plugin.ml
View File

@ -14,8 +14,10 @@
License for the specific language governing permissions and limitations under
the License. *)
open Catala_utils
type 'ast plugin_apply_fun_typ =
source_file:Utils.Pos.input_file ->
source_file:Pos.input_file ->
output_file:string option ->
scope:string option ->
'ast ->
@ -51,9 +53,9 @@ let find name = Hashtbl.find backend_plugins (String.lowercase_ascii name)
let load_file f =
try
Dynlink.loadfile f;
Utils.Cli.debug_print "Plugin %S loaded" f
Cli.debug_print "Plugin %S loaded" f
with e ->
Utils.Errors.format_warning "Could not load plugin %S: %s" f
Errors.format_warning "Could not load plugin %S: %s" f
(Printexc.to_string e)
let load_dir d =

4
compiler/plugin.mli
View File

@ -16,8 +16,10 @@
(** {2 catala-facing API} *)
open Catala_utils
type 'ast plugin_apply_fun_typ =
source_file:Utils.Pos.input_file ->
source_file:Pos.input_file ->
output_file:string option ->
scope:string option ->
'ast ->

2
compiler/plugins/api_web.ml
View File

@ -18,7 +18,7 @@
(** Catala plugin for generating web APIs. It generates OCaml code before the
the associated [js_of_ocaml] wrapper. *)
open Utils
open Catala_utils
open Shared_ast
open String_common
open Lcalc

2
compiler/plugins/json_schema.ml
View File

@ -20,7 +20,7 @@
let name = "json_schema"
let extension = "_schema.json"
open Utils
open Catala_utils
open String_common
open Shared_ast
open Lcalc.Ast

4
compiler/plugins/python.ml
View File

@ -20,13 +20,15 @@
The code for the Python backend already has first-class support, so there
would be no reason to use this plugin instead *)
open Catala_utils
let name = "python-plugin"
let extension = ".py"
let apply ~source_file ~output_file ~scope prgm type_ordering =
ignore source_file;
ignore scope;
Utils.File.with_formatter_of_opt_file output_file
File.with_formatter_of_opt_file output_file
@@ fun fmt -> Scalc.To_python.format_program fmt prgm type_ordering
let () = Driver.Plugin.register_scalc ~name ~extension apply

2
compiler/scalc/ast.ml
View File

@ -14,7 +14,7 @@
License for the specific language governing permissions and limitations under
the License. *)
open Utils
open Catala_utils
open Shared_ast
module D = Dcalc.Ast
module L = Lcalc.Ast

2
compiler/scalc/compile_from_lambda.ml
View File

@ -14,7 +14,7 @@
License for the specific language governing permissions and limitations under
the License. *)
open Utils
open Catala_utils
open Shared_ast
module A = Ast
module L = Lcalc.Ast

2
compiler/scalc/print.ml
View File

@ -14,7 +14,7 @@
License for the specific language governing permissions and limitations under
the License. *)
open Utils
open Catala_utils
open Shared_ast
open Ast

4
compiler/scalc/to_python.ml
View File

@ -15,7 +15,7 @@
the License. *)
[@@@warning "-32-27"]
open Utils
open Catala_utils
open Shared_ast
open Ast
open String_common
@ -77,7 +77,7 @@ let format_uid_list (fmt : Format.formatter) (uids : Uid.MarkedString.info list)
(Format.pp_print_list
~pp_sep:(fun fmt () -> Format.fprintf fmt ",@ ")
(fun fmt info ->
Format.fprintf fmt "\"%a\"" Utils.Uid.MarkedString.format_info info))
Format.fprintf fmt "\"%a\"" Uid.MarkedString.format info))
uids
let format_string_list (fmt : Format.formatter) (uids : string list) : unit =

2
compiler/scopelang/ast.ml
View File

@ -14,7 +14,7 @@
License for the specific language governing permissions and limitations under
the License. *)
open Utils
open Catala_utils
open Shared_ast
type location = scopelang glocation

2
compiler/scopelang/ast.mli
View File

@ -16,7 +16,7 @@
(** Abstract syntax tree of the scope language *)
open Utils
open Catala_utils
open Shared_ast
(** {1 Identifiers} *)

2
compiler/scopelang/dependency.ml
View File

@ -17,7 +17,7 @@
(** Graph representation of the dependencies between scopes in the Catala
program. Vertices are functions, x -> y if x is used in the definition of y. *)
open Utils
open Catala_utils
open Shared_ast
module SVertex = ScopeName

2
compiler/scopelang/dependency.mli
View File

@ -17,7 +17,7 @@
(** Graph representation of the dependencies between scopes in the Catala
program. Vertices are functions, x -> y if x is used in the definition of y. *)
open Utils
open Catala_utils
open Shared_ast
(** {1 Scope dependencies} *)

2
compiler/scopelang/dune
View File

@ -1,7 +1,7 @@
(library
(name scopelang)
(public_name catala.scopelang)
(libraries utils ocamlgraph desugared)
(libraries catala_utils ocamlgraph desugared)
(flags
(:standard -short-paths)))

4
compiler/scopelang/from_desugared.ml
View File

@ -16,7 +16,7 @@
(** Translation from {!module: Desugared.Ast} to {!module: Scopelang.Ast} *)
open Utils
open Catala_utils
open Shared_ast
(** {1 Expression translation}*)
@ -33,7 +33,7 @@ type ctx = {
let tag_with_log_entry
(e : untyped Ast.expr boxed)
(l : log_entry)
(markings : Utils.Uid.MarkedString.info list) : untyped Ast.expr boxed =
(markings : Uid.MarkedString.info list) : untyped Ast.expr boxed =
Expr.eapp
(Expr.eop (Unop (Log (l, markings))) (Marked.get_mark e))
[e] (Marked.get_mark e)

2
compiler/scopelang/print.ml
View File

@ -14,7 +14,7 @@
License for the specific language governing permissions and limitations under
the License. *)
open Utils
open Catala_utils
open Shared_ast
open Ast

2
compiler/shared_ast/definitions.ml
View File

@ -20,7 +20,7 @@
(* Doesn't define values, so OK to have without an mli *)
open Utils
open Catala_utils
module Runtime = Runtime_ocaml.Runtime
module ScopeName = Uid.Gen ()
module StructName = Uid.Gen ()

2
compiler/shared_ast/dune
View File

@ -3,4 +3,4 @@
(public_name catala.shared_ast)
(flags
(:standard -short-paths))
(libraries bindlib unionFind utils catala.runtime_ocaml))
(libraries bindlib unionFind catala_utils catala.runtime_ocaml))

2
compiler/shared_ast/expr.ml
View File

@ -15,7 +15,7 @@
License for the specific language governing permissions and limitations under
the License. *)
open Utils
open Catala_utils
open Definitions
(** Functions handling the types of [shared_ast] *)

2
compiler/shared_ast/expr.mli
View File

@ -17,7 +17,7 @@
(** Functions handling the expressions of [shared_ast] *)
open Utils
open Catala_utils
open Definitions
(** {2 Boxed constructors} *)

32
compiler/shared_ast/print.ml
View File

@ -14,7 +14,7 @@
License for the specific language governing permissions and limitations under
the License. *)
open Utils
open Catala_utils
open String_common
open Definitions
@ -26,27 +26,27 @@ let uid_list (fmt : Format.formatter) (infos : Uid.MarkedString.info list) :
Format.pp_print_list
~pp_sep:(fun fmt () -> Format.pp_print_char fmt '.')
(fun fmt info ->
Utils.Cli.format_with_style
Cli.format_with_style
(if begins_with_uppercase (Marked.unmark info) then [ANSITerminal.red]
else [])
fmt
(Utils.Uid.MarkedString.to_string info))
(Uid.MarkedString.to_string info))
fmt infos
let keyword (fmt : Format.formatter) (s : string) : unit =
Utils.Cli.format_with_style [ANSITerminal.red] fmt s
Cli.format_with_style [ANSITerminal.red] fmt s
let base_type (fmt : Format.formatter) (s : string) : unit =
Utils.Cli.format_with_style [ANSITerminal.yellow] fmt s
Cli.format_with_style [ANSITerminal.yellow] fmt s
let punctuation (fmt : Format.formatter) (s : string) : unit =
Utils.Cli.format_with_style [ANSITerminal.cyan] fmt s
Cli.format_with_style [ANSITerminal.cyan] fmt s
let operator (fmt : Format.formatter) (s : string) : unit =
Utils.Cli.format_with_style [ANSITerminal.green] fmt s
Cli.format_with_style [ANSITerminal.green] fmt s
let lit_style (fmt : Format.formatter) (s : string) : unit =
Utils.Cli.format_with_style [ANSITerminal.yellow] fmt s
Cli.format_with_style [ANSITerminal.yellow] fmt s
let tlit (fmt : Format.formatter) (l : typ_lit) : unit =
base_type fmt
@ -68,7 +68,7 @@ let location (type a) (fmt : Format.formatter) (l : a glocation) : unit =
ScopeVar.format_t (Marked.unmark subvar)
let enum_constructor (fmt : Format.formatter) (c : EnumConstructor.t) : unit =
Utils.Cli.format_with_style [ANSITerminal.magenta] fmt
Cli.format_with_style [ANSITerminal.magenta] fmt
(Format.asprintf "%a" EnumConstructor.format_t c)
let rec typ (ctx : decl_ctx option) (fmt : Format.formatter) (ty : typ) : unit =
@ -127,9 +127,9 @@ let lit (type a) (fmt : Format.formatter) (l : a glit) : unit =
| LUnit -> lit_style fmt "()"
| LRat i ->
lit_style fmt
(Runtime.decimal_to_string ~max_prec_digits:!Utils.Cli.max_prec_digits i)
(Runtime.decimal_to_string ~max_prec_digits:!Cli.max_prec_digits i)
| LMoney e -> (
match !Utils.Cli.locale_lang with
match !Cli.locale_lang with
| En -> lit_style fmt (Format.asprintf "$%s" (Runtime.money_to_string e))
| Fr -> lit_style fmt (Format.asprintf "%s €" (Runtime.money_to_string e))
| Pl -> lit_style fmt (Format.asprintf "%s PLN" (Runtime.money_to_string e))
@ -172,11 +172,11 @@ let ternop (fmt : Format.formatter) (op : ternop) : unit =
let log_entry (fmt : Format.formatter) (entry : log_entry) : unit =
Format.fprintf fmt "@<2>%a"
(fun fmt -> function
| VarDef _ -> Utils.Cli.format_with_style [ANSITerminal.blue] fmt "≔ "
| BeginCall -> Utils.Cli.format_with_style [ANSITerminal.yellow] fmt "→ "
| EndCall -> Utils.Cli.format_with_style [ANSITerminal.yellow] fmt "← "
| VarDef _ -> Cli.format_with_style [ANSITerminal.blue] fmt "≔ "
| BeginCall -> Cli.format_with_style [ANSITerminal.yellow] fmt "→ "
| EndCall -> Cli.format_with_style [ANSITerminal.yellow] fmt "← "
| PosRecordIfTrueBool ->
Utils.Cli.format_with_style [ANSITerminal.green] fmt "☛ ")
Cli.format_with_style [ANSITerminal.green] fmt "☛ ")
entry
let unop (fmt : Format.formatter) (op : unop) : unit =
@ -187,7 +187,7 @@ let unop (fmt : Format.formatter) (op : unop) : unit =
Format.fprintf fmt "log@[<hov 2>[%a|%a]@]" log_entry entry
(Format.pp_print_list
~pp_sep:(fun fmt () -> Format.fprintf fmt ".")
(fun fmt info -> Utils.Uid.MarkedString.format_info fmt info))
(fun fmt info -> Uid.MarkedString.format fmt info))
infos
| Length -> Format.pp_print_string fmt "length"
| IntToRat -> Format.pp_print_string fmt "int_to_rat"

2
compiler/shared_ast/print.mli
View File

@ -16,7 +16,7 @@
(** Printing functions for the default calculus AST *)
open Utils
open Catala_utils
open Definitions
(** {1 Common syntax highlighting helpers}*)

4
compiler/shared_ast/scope.ml
View File

@ -15,7 +15,7 @@
License for the specific language governing permissions and limitations under
the License. *)
open Utils
open Catala_utils
open Definitions
let rec fold_left_lets ~f ~init scope_body_expr =
@ -106,7 +106,7 @@ let rec get_body_expr_mark = function
get_body_expr_mark e
| Result e ->
let m = Marked.get_mark e in
Expr.with_ty m (Utils.Marked.mark (Expr.mark_pos m) TAny)
Expr.with_ty m (Marked.mark (Expr.mark_pos m) TAny)
let get_body_mark scope_body =
let _, e = Bindlib.unbind scope_body.scope_body_expr in

2
compiler/shared_ast/scope.mli
View File

@ -17,7 +17,7 @@
(** Functions handling the scope structures of [shared_ast] *)
open Utils
open Catala_utils
open Definitions
(** {2 Traversal functions} *)

6
compiler/shared_ast/typing.ml
View File

@ -17,16 +17,16 @@
(** Typing for the default calculus. Because of the error terms, we perform type
inference using the classical W algorithm with union-find unification. *)
open Utils
open Catala_utils
module A = Definitions
module Any =
Utils.Uid.Make
Uid.Make
(struct
type info = unit
let to_string _ = "any"
let format_info fmt () = Format.fprintf fmt "any"
let format fmt () = Format.fprintf fmt "any"
let equal _ _ = true
let compare _ _ = 0
end)

2
compiler/surface/ast.ml
View File

@ -19,7 +19,7 @@
[@@@ocaml.warning "-7"]
open Utils
open Catala_utils
(** {1 Visitor classes for programs} *)
(** To allow for quick traversal and/or modification of this AST structure, we

2
compiler/surface/dune
View File

@ -2,7 +2,7 @@
(name surface)
(public_name catala.surface)
(libraries
utils
catala_utils
menhirLib
sedlex
re

2
compiler/surface/fill_positions.ml
View File

@ -14,7 +14,7 @@
License for the specific language governing permissions and limitations under
the License. *)
open Utils
open Catala_utils
let fill_pos_with_legislative_info (p : Ast.program) : Ast.program =
let visitor =

2
compiler/surface/lexer.cppo.ml
View File

@ -14,7 +14,7 @@
open Tokens
open Sedlexing
open Utils
open Catala_utils
module L = Lexer_common
module R = Re.Pcre

2
compiler/surface/lexer_common.ml
View File

@ -17,7 +17,7 @@
open Tokens
open Sedlexing
open Utils
open Catala_utils
module R = Re.Pcre
(* Calculates the precedence according a {!val: matched_regex} of the form :

2
compiler/surface/lexer_common.mli
View File

@ -31,7 +31,7 @@ val code_buffer : Buffer.t
val update_acc : Sedlexing.lexbuf -> unit
(** Updates {!val:code_buffer} with the current lexeme *)
val raise_lexer_error : Utils.Pos.t -> string -> 'a
val raise_lexer_error : Catala_utils.Pos.t -> string -> 'a
(** Error-generating helper *)
val token_list_language_agnostic : (string * Tokens.token) list

2
compiler/surface/parser.mly
View File

@ -18,7 +18,7 @@
*)
%{
open Utils
open Catala_utils
%}
%parameter<Localisation: sig

2
compiler/surface/parser_driver.ml
View File

@ -19,7 +19,7 @@
Parser_driver.parse_source_file} API. *)
open Sedlexing
open Utils
open Catala_utils
(** {1 Internal functions} *)

2
compiler/surface/parser_driver.mli
View File

@ -17,6 +17,6 @@
(** Wrapping module around parser and lexer that offers the
[Surface.Parser_driver.parse_source_file] API. *)
open Utils
open Catala_utils
val parse_top_level_file : Pos.input_file -> Cli.backend_lang -> Ast.program

2
compiler/verification/conditions.ml
View File

@ -15,7 +15,7 @@
License for the specific language governing permissions and limitations under
the License. *)
open Utils
open Catala_utils
open Shared_ast
open Dcalc
open Ast

2
compiler/verification/conditions.mli
View File

@ -17,7 +17,7 @@
(** Generates verification conditions from scope definitions *)
open Utils
open Catala_utils
open Shared_ast
type verification_condition_kind =

2
compiler/verification/dune
View File

@ -3,7 +3,7 @@
(public_name catala.verification)
(libraries
bindlib
utils
catala_utils
dcalc
catala.runtime_ocaml
dates_calc

2
compiler/verification/io.ml
View File

@ -15,7 +15,7 @@
License for the specific language governing permissions and limitations under
the License. *)
open Utils
open Catala_utils
open Shared_ast
module type Backend = sig

4
compiler/verification/solver.ml
View File

@ -14,6 +14,8 @@
License for the specific language governing permissions and limitations under
the License. *)
open Catala_utils
(** [solve_vc] is the main entry point of this module. It takes a list of
expressions [vcs] corresponding to verification conditions that must be
discharged by Z3, and attempts to solve them **)
@ -45,4 +47,4 @@ let solve_vc
true z3_vcs
in
if all_proven then
Utils.Cli.result_format "No errors found during the proof mode run."
Cli.result_format "No errors found during the proof mode run."

2
compiler/verification/z3backend.dummy.ml
View File

@ -18,7 +18,7 @@
without the expected backend. All functions print an error message and exit *)
let dummy () =
Utils.Cli.error_print
Cli.error_print
"This instance of Catala was compiled without Z3 support.";
exit 124

2
compiler/verification/z3backend.real.ml
View File

@ -14,7 +14,7 @@
License for the specific language governing permissions and limitations under
the License. *)
open Utils
open Catala_utils
open Shared_ast
open Dcalc
open Ast

17
french_law/catala_legifrance/api.ml
View File

@ -15,6 +15,7 @@
the License. *)
open Lwt
open Catala_utils
type access_token = string
@ -54,11 +55,11 @@ let get_token (client_id : string) (client_secret : string) : string =
|> Yojson.Basic.Util.member "access_token"
|> Yojson.Basic.Util.to_string
in
Utils.Cli.debug_format "The LegiFrance API access token is %s" token;
Cli.debug_format "The LegiFrance API access token is %s" token;
token
end
else begin
Utils.Cli.debug_format
Cli.debug_format
"The API access token request went wrong ; status is %s and the body is\n\
%s"
resp body;
@ -109,7 +110,7 @@ let run_request (request : (string * string t) t) : Yojson.Basic.t =
if resp = "200 OK" then
try body |> Yojson.Basic.from_string with
| Yojson.Basic.Util.Type_error (msg, obj) ->
Utils.Cli.error_print
Cli.error_print
"Error while parsing JSON answer from API: %s\n\
Specific JSON:\n\
%s\n\
@ -128,10 +129,10 @@ let run_request (request : (string * string t) t) : Yojson.Basic.t =
with Failure _ ->
if n > 0 then (
Unix.sleep 2;
Utils.Cli.debug_format "Retrying request...";
Cli.debug_format "Retrying request...";
try_n_times (n - 1))
else (
Utils.Cli.error_print
Cli.error_print
"The API request went wrong ; status is %s and the body is\n%s" resp
body;
exit (-1))
@ -153,7 +154,7 @@ let parse_id (id : string) : article_id =
else if Re.execp ceta_tex id then CETATEXT
else if Re.execp jorf_rex id then JORFARTI
else
Utils.Errors.raise_error
Errors.raise_error
"LégiFrance ID \"%s\" does not correspond to an ID format recognized \
by the LégiFrance API"
id
@ -161,7 +162,7 @@ let parse_id (id : string) : article_id =
{ id; typ }
let retrieve_article (access_token : string) (obj : article_id) : article =
Utils.Cli.debug_format "Accessing article %s" obj.id;
Cli.debug_format "Accessing article %s" obj.id;
{
content =
run_request
@ -179,7 +180,7 @@ let raise_article_parsing_error
(json : Yojson.Basic.t)
(msg : string)
(obj : Yojson.Basic.t) =
Utils.Cli.error_print
Cli.error_print
"Error while manipulating JSON answer from API: %s\n\
Specific JSON:\n\
%s\n\

36
french_law/catala_legifrance/catala_legifrance.ml
View File

@ -14,6 +14,8 @@
License for the specific language governing permissions and limitations under
the License. *)
open Catala_utils
(** Main logic for interacting with LégiFrance when traversing Catala source
files *)
@ -46,12 +48,12 @@ let check_article_expiration
Some new_version
else None
in
Utils.Cli.warning_print
Cli.warning_print
"%s %s has expired! Its expiration date is %s according to \
LégiFrance.%s"
(Utils.Marked.unmark law_heading.Surface.Ast.law_heading_name)
(Utils.Pos.to_string
(Utils.Marked.get_mark law_heading.Surface.Ast.law_heading_name))
(Marked.unmark law_heading.Surface.Ast.law_heading_name)
(Pos.to_string
(Marked.get_mark law_heading.Surface.Ast.law_heading_name))
(Date.print_tm legifrance_expiration_date)
(match new_version with
| None -> ""
@ -61,7 +63,7 @@ let check_article_expiration
else None
type law_article_text = {
article_title : string * Utils.Pos.t;
article_title : string * Pos.t;
text : string;
new_version : Api.article_id option;
current_version : Api.article_id option;
@ -110,7 +112,7 @@ let compare_to_versions
(law_article_text : law_article_text)
(access_token : Api.access_token) : unit =
let print_diff msg diff =
Utils.Cli.warning_print "%s\n%s" msg
Cli.warning_print "%s\n%s" msg
(String.concat "\n"
(List.map
(fun chunk ->
@ -138,7 +140,7 @@ let compare_to_versions
"There is a diff between the source code version of %s %s and the \
text stored on LégiFrance:\n"
(fst law_article_text.article_title)
(Utils.Pos.to_string (snd law_article_text.article_title)))
(Pos.to_string (snd law_article_text.article_title)))
diff)
| None -> ()
end;
@ -154,14 +156,14 @@ let compare_to_versions
"Here is the diff between the current version of %s %s and what it \
will become in the future:\n"
(fst law_article_text.article_title)
(Utils.Pos.to_string (snd law_article_text.article_title)))
(Pos.to_string (snd law_article_text.article_title)))
diff)
| None -> ()
(** Fill an [@@Include ...@@] tag inside the Catala source file with the
legislative contents retrieved from LégiFrance *)
let include_legislative_text
(id : string * Utils.Pos.t)
(id : string * Pos.t)
(access_token : Api.access_token) : string =
let excerpt = Api.retrieve_law_excerpt access_token (fst id) in
let title = "#" ^ Api.get_law_excerpt_title excerpt in
@ -179,12 +181,12 @@ let include_legislative_text
in
let to_insert = title ^ "\n\n" ^ String.concat "\n\n" articles in
let pos = snd id in
Utils.Cli.debug_format "Position: %s" (Utils.Pos.to_string_short pos);
let file = Utils.Pos.get_file pos in
let include_line = Utils.Pos.get_end_line pos in
Cli.debug_format "Position: %s" (Pos.to_string_short pos);
let file = Pos.get_file pos in
let include_line = Pos.get_end_line pos in
let ic = open_in file in
let new_file = file ^ ".new" in
Utils.Cli.warning_print
Cli.warning_print
"LégiFrance inclusion detected, writing new contents to %s" new_file;
let oc = open_out new_file in
(* Pos.t lines start at 1 *)
@ -258,7 +260,7 @@ let driver
(client_id : string)
(client_secret : string) =
try
if debug then Utils.Cli.debug_flag := true;
if debug then Cli.debug_flag := true;
let access_token = Api.get_token client_id client_secret in
(* LégiFrance is only supported for French texts *)
let program =
@ -276,9 +278,9 @@ let driver
item))
program.program_items;
0
with Utils.Errors.StructuredError (msg, pos) ->
with Errors.StructuredError (msg, pos) ->
let bt = Printexc.get_raw_backtrace () in
Utils.Cli.error_print "%s" (Utils.Errors.print_structured_error msg pos);
Cli.error_print "%s" (Errors.print_structured_error msg pos);
if Printexc.backtrace_status () then Printexc.print_raw_backtrace stderr bt;
-1
@ -286,4 +288,4 @@ let driver
let _ =
Stdlib.exit
@@ Cmdliner.Cmd.eval'
(Cmdliner.Cmd.v Cli.info (Cli.catala_legifrance_t driver))
(Cmdliner.Cmd.v Cli.info (Legifrance_cli.catala_legifrance_t driver))

4
french_law/catala_legifrance/date.ml
View File

@ -14,6 +14,8 @@
License for the specific language governing permissions and limitations under
the License. *)
open Catala_utils
(** Helper functions to interact with {!Unix.tm} dates *)
type date_format = DDMMYYYY | ISO
@ -53,7 +55,7 @@ let parse_expiration_date (date_format : date_format) (expiration_date : string)
Unix.tm_isdst = false;
})
with _ ->
Utils.Errors.raise_error "Error while parsing expiration date argument (%s)"
Errors.raise_error "Error while parsing expiration date argument (%s)"
expiration_date
(** Prints an [Unix.tm] under the ISO formatting [YYYY-MM-DD] *)

2
french_law/catala_legifrance/dune
View File

@ -3,7 +3,7 @@
(package catala_legifrance)
(libraries
catala.surface
catala.utils
catala.catala_utils
cmdliner
cohttp
lwt

3
french_law/catala_legifrance/cli.ml → french_law/catala_legifrance/legifrance_cli.ml
View File

@ -17,6 +17,7 @@
(** Command line arguments specification of [legifrance_catala] *)
open Cmdliner
open Catala_utils
let file =
Arg.(
@ -96,4 +97,4 @@ let info =
]
in
let exits = Cmd.Exit.defaults @ [Cmd.Exit.info ~doc:"on error" 1] in
Cmd.info "legifrance_catala" ~version:Utils.Cli.version ~doc ~exits ~man
Cmd.info "legifrance_catala" ~version:Cli.version ~doc ~exits ~man