mirror of
https://github.com/CatalaLang/catala.git
synced 2024-09-19 00:15:39 +03:00
Rename utils to catala_utils
This commit is contained in:
parent
b329afbbdb
commit
660e5775de
@ -16,7 +16,7 @@
|
|||||||
the License. *)
|
the License. *)
|
||||||
|
|
||||||
open Cmdliner
|
open Cmdliner
|
||||||
open Utils
|
open Catala_utils
|
||||||
open Ninja_utils
|
open Ninja_utils
|
||||||
module Nj = Ninja_utils
|
module Nj = Ninja_utils
|
||||||
|
|
||||||
|
@ -9,7 +9,7 @@
|
|||||||
(public_name clerk.driver)
|
(public_name clerk.driver)
|
||||||
(libraries
|
(libraries
|
||||||
catala.runtime_ocaml
|
catala.runtime_ocaml
|
||||||
catala.utils
|
catala.catala_utils
|
||||||
ninja_utils
|
ninja_utils
|
||||||
cmdliner
|
cmdliner
|
||||||
re
|
re
|
||||||
|
@ -7,12 +7,12 @@ In {{: desugared.html} the desugared representation} or in the
|
|||||||
global identifiers. These identifiers use OCaml's type system to statically
|
global identifiers. These identifiers use OCaml's type system to statically
|
||||||
distinguish e.g. a scope identifier from a struct identifier.
|
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.
|
a fresh sort of global identifiers.
|
||||||
|
|
||||||
Related modules:
|
Related modules:
|
||||||
|
|
||||||
{!modules: Utils.Uid}
|
{!modules: Uid}
|
||||||
|
|
||||||
{1 Source code positions}
|
{1 Source code positions}
|
||||||
|
|
||||||
@ -22,7 +22,7 @@ code. These annotations are critical to produce readable error messages.
|
|||||||
|
|
||||||
Related modules:
|
Related modules:
|
||||||
|
|
||||||
{!modules: Utils.Pos}
|
{!modules: Pos}
|
||||||
|
|
||||||
{1 Error messages}
|
{1 Error messages}
|
||||||
|
|
@ -1,8 +1,8 @@
|
|||||||
(library
|
(library
|
||||||
(name utils)
|
(name catala_utils)
|
||||||
(public_name catala.utils)
|
(public_name catala.catala_utils)
|
||||||
(libraries cmdliner ubase ANSITerminal re bindlib catala.runtime_ocaml))
|
(libraries cmdliner ubase ANSITerminal re bindlib catala.runtime_ocaml))
|
||||||
|
|
||||||
(documentation
|
(documentation
|
||||||
(package catala)
|
(package catala)
|
||||||
(mld_files utils))
|
(mld_files catala_utils))
|
@ -18,7 +18,7 @@ module type Info = sig
|
|||||||
type info
|
type info
|
||||||
|
|
||||||
val to_string : info -> string
|
val to_string : info -> string
|
||||||
val format_info : Format.formatter -> info -> unit
|
val format : Format.formatter -> info -> unit
|
||||||
val equal : info -> info -> bool
|
val equal : info -> info -> bool
|
||||||
val compare : info -> info -> int
|
val compare : info -> info -> int
|
||||||
end
|
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 get_info (uid : t) : X.info = uid.info
|
||||||
|
|
||||||
let format_t (fmt : Format.formatter) (x : t) : unit =
|
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
|
let hash (x : t) : int = x.id
|
||||||
|
|
||||||
@ -71,7 +71,7 @@ module MarkedString = struct
|
|||||||
type info = string Marked.pos
|
type info = string Marked.pos
|
||||||
|
|
||||||
let to_string (s, _) = s
|
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 equal i1 i2 = String.equal (Marked.unmark i1) (Marked.unmark i2)
|
||||||
let compare i1 i2 = String.compare (Marked.unmark i1) (Marked.unmark i2)
|
let compare i1 i2 = String.compare (Marked.unmark i1) (Marked.unmark i2)
|
||||||
end
|
end
|
@ -21,7 +21,7 @@ module type Info = sig
|
|||||||
type info
|
type info
|
||||||
|
|
||||||
val to_string : info -> string
|
val to_string : info -> string
|
||||||
val format_info : Format.formatter -> info -> unit
|
val format : Format.formatter -> info -> unit
|
||||||
|
|
||||||
val equal : info -> info -> bool
|
val equal : info -> info -> bool
|
||||||
(** Equality disregards position *)
|
(** Equality disregards position *)
|
@ -1,3 +1,5 @@
|
|||||||
|
open Catala_utils
|
||||||
|
|
||||||
open Driver
|
open Driver
|
||||||
open Js_of_ocaml
|
open Js_of_ocaml
|
||||||
|
|
||||||
@ -12,7 +14,7 @@ let _ =
|
|||||||
driver
|
driver
|
||||||
(Contents (Js.to_string contents))
|
(Contents (Js.to_string contents))
|
||||||
{
|
{
|
||||||
Utils.Cli.debug = false;
|
Cli.debug = false;
|
||||||
color = Never;
|
color = Never;
|
||||||
wrap_weaved_output = false;
|
wrap_weaved_output = false;
|
||||||
avoid_exceptions = false;
|
avoid_exceptions = false;
|
||||||
|
@ -4,7 +4,7 @@
|
|||||||
(libraries
|
(libraries
|
||||||
bindlib
|
bindlib
|
||||||
unionFind
|
unionFind
|
||||||
utils
|
catala_utils
|
||||||
re
|
re
|
||||||
ubase
|
ubase
|
||||||
catala.runtime_ocaml
|
catala.runtime_ocaml
|
||||||
|
@ -14,7 +14,7 @@
|
|||||||
License for the specific language governing permissions and limitations under
|
License for the specific language governing permissions and limitations under
|
||||||
the License. *)
|
the License. *)
|
||||||
|
|
||||||
open Utils
|
open Catala_utils
|
||||||
open Shared_ast
|
open Shared_ast
|
||||||
|
|
||||||
type scope_var_ctx = {
|
type scope_var_ctx = {
|
||||||
@ -102,7 +102,7 @@ let merge_defaults caller callee =
|
|||||||
let tag_with_log_entry
|
let tag_with_log_entry
|
||||||
(e : 'm Ast.expr boxed)
|
(e : 'm Ast.expr boxed)
|
||||||
(l : log_entry)
|
(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
|
let m = mark_tany (Marked.get_mark e) (Expr.pos e) in
|
||||||
Expr.eapp (Expr.eop (Unop (Log (l, markings))) m) [e] m
|
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
|
let translate_rule
|
||||||
(ctx : 'm ctx)
|
(ctx : 'm ctx)
|
||||||
(rule : 'm Scopelang.Ast.rule)
|
(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 Ast.expr scope_body_expr Bindlib.box)
|
'm Ast.expr scope_body_expr Bindlib.box)
|
||||||
* 'm ctx =
|
* 'm ctx =
|
||||||
@ -645,7 +645,7 @@ let translate_rule
|
|||||||
let translate_rules
|
let translate_rules
|
||||||
(ctx : 'm ctx)
|
(ctx : 'm ctx)
|
||||||
(rules : 'm Scopelang.Ast.rule list)
|
(rules : 'm Scopelang.Ast.rule list)
|
||||||
((sigma_name, pos_sigma) : Utils.Uid.MarkedString.info)
|
((sigma_name, pos_sigma) : Uid.MarkedString.info)
|
||||||
(mark : 'm mark)
|
(mark : 'm mark)
|
||||||
(scope_sig : 'm scope_sig_ctx) :
|
(scope_sig : 'm scope_sig_ctx) :
|
||||||
'm Ast.expr scope_body_expr Bindlib.box * 'm ctx =
|
'm Ast.expr scope_body_expr Bindlib.box * 'm ctx =
|
||||||
|
@ -16,7 +16,7 @@
|
|||||||
|
|
||||||
(** Reference interpreter for the default calculus *)
|
(** Reference interpreter for the default calculus *)
|
||||||
|
|
||||||
open Utils
|
open Catala_utils
|
||||||
open Shared_ast
|
open Shared_ast
|
||||||
module Runtime = Runtime_ocaml.Runtime
|
module Runtime = Runtime_ocaml.Runtime
|
||||||
|
|
||||||
|
@ -16,7 +16,7 @@
|
|||||||
|
|
||||||
(** Reference interpreter for the default calculus *)
|
(** Reference interpreter for the default calculus *)
|
||||||
|
|
||||||
open Utils
|
open Catala_utils
|
||||||
open Shared_ast
|
open Shared_ast
|
||||||
|
|
||||||
val evaluate_expr : decl_ctx -> 'm Ast.expr -> 'm Ast.expr
|
val evaluate_expr : decl_ctx -> 'm Ast.expr -> 'm Ast.expr
|
||||||
|
@ -14,7 +14,7 @@
|
|||||||
WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the
|
WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the
|
||||||
License for the specific language governing permissions and limitations under
|
License for the specific language governing permissions and limitations under
|
||||||
the License. *)
|
the License. *)
|
||||||
open Utils
|
open Catala_utils
|
||||||
open Shared_ast
|
open Shared_ast
|
||||||
open Ast
|
open Ast
|
||||||
|
|
||||||
|
@ -16,7 +16,7 @@
|
|||||||
|
|
||||||
(** Abstract syntax tree of the desugared representation *)
|
(** Abstract syntax tree of the desugared representation *)
|
||||||
|
|
||||||
open Utils
|
open Catala_utils
|
||||||
open Shared_ast
|
open Shared_ast
|
||||||
|
|
||||||
(** {1 Names, Maps and Keys} *)
|
(** {1 Names, Maps and Keys} *)
|
||||||
|
@ -16,7 +16,7 @@
|
|||||||
|
|
||||||
(** Abstract syntax tree of the desugared representation *)
|
(** Abstract syntax tree of the desugared representation *)
|
||||||
|
|
||||||
open Utils
|
open Catala_utils
|
||||||
open Shared_ast
|
open Shared_ast
|
||||||
|
|
||||||
(** Inside a scope, a definition can refer either to a scope def, or a subscope
|
(** Inside a scope, a definition can refer either to a scope def, or a subscope
|
||||||
|
@ -17,7 +17,7 @@
|
|||||||
(** Scope dependencies computations using {{:http://ocamlgraph.lri.fr/}
|
(** Scope dependencies computations using {{:http://ocamlgraph.lri.fr/}
|
||||||
OCamlgraph} *)
|
OCamlgraph} *)
|
||||||
|
|
||||||
open Utils
|
open Catala_utils
|
||||||
open Shared_ast
|
open Shared_ast
|
||||||
|
|
||||||
(** {1 Scope variables dependency graph} *)
|
(** {1 Scope variables dependency graph} *)
|
||||||
|
@ -17,7 +17,7 @@
|
|||||||
(** Scope dependencies computations using {{:http://ocamlgraph.lri.fr/}
|
(** Scope dependencies computations using {{:http://ocamlgraph.lri.fr/}
|
||||||
OCamlgraph} *)
|
OCamlgraph} *)
|
||||||
|
|
||||||
open Utils
|
open Catala_utils
|
||||||
open Shared_ast
|
open Shared_ast
|
||||||
|
|
||||||
(** {1 Scope variables dependency graph} *)
|
(** {1 Scope variables dependency graph} *)
|
||||||
|
@ -1,7 +1,7 @@
|
|||||||
(library
|
(library
|
||||||
(name desugared)
|
(name desugared)
|
||||||
(public_name catala.desugared)
|
(public_name catala.desugared)
|
||||||
(libraries ocamlgraph utils shared_ast surface))
|
(libraries ocamlgraph catala_utils shared_ast surface))
|
||||||
|
|
||||||
(documentation
|
(documentation
|
||||||
(package catala)
|
(package catala)
|
||||||
|
@ -15,7 +15,7 @@
|
|||||||
License for the specific language governing permissions and limitations under
|
License for the specific language governing permissions and limitations under
|
||||||
the License. *)
|
the License. *)
|
||||||
|
|
||||||
open Utils
|
open Catala_utils
|
||||||
module SurfacePrint = Surface.Print
|
module SurfacePrint = Surface.Print
|
||||||
open Shared_ast
|
open Shared_ast
|
||||||
module Runtime = Runtime_ocaml.Runtime
|
module Runtime = Runtime_ocaml.Runtime
|
||||||
|
@ -18,7 +18,7 @@
|
|||||||
(** Builds a context that allows for mapping each name to a precise uid, taking
|
(** Builds a context that allows for mapping each name to a precise uid, taking
|
||||||
lexical scopes into account *)
|
lexical scopes into account *)
|
||||||
|
|
||||||
open Utils
|
open Catala_utils
|
||||||
open Shared_ast
|
open Shared_ast
|
||||||
|
|
||||||
(** {1 Name resolution context} *)
|
(** {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) =
|
let raise_unknown_identifier (msg : string) (ident : ident Marked.pos) =
|
||||||
Errors.raise_spanned_error (Marked.get_mark ident)
|
Errors.raise_spanned_error (Marked.get_mark ident)
|
||||||
"\"%s\": unknown identifier %s"
|
"\"%s\": unknown identifier %s"
|
||||||
(Utils.Cli.with_style [ANSITerminal.yellow] "%s" (Marked.unmark ident))
|
(Cli.with_style [ANSITerminal.yellow] "%s" (Marked.unmark ident))
|
||||||
msg
|
msg
|
||||||
|
|
||||||
(** Gets the type associated to an uid *)
|
(** Gets the type associated to an uid *)
|
||||||
@ -254,7 +254,7 @@ let process_subscope_decl
|
|||||||
Errors.raise_multispanned_error
|
Errors.raise_multispanned_error
|
||||||
[Some "first use", Marked.get_mark info; Some "second use", s_pos]
|
[Some "first use", Marked.get_mark info; Some "second use", s_pos]
|
||||||
"Subscope name \"%a\" already used"
|
"Subscope name \"%a\" already used"
|
||||||
(Utils.Cli.format_with_style [ANSITerminal.yellow])
|
(Cli.format_with_style [ANSITerminal.yellow])
|
||||||
subscope
|
subscope
|
||||||
| None ->
|
| None ->
|
||||||
let sub_scope_uid = SubScopeName.fresh (name, name_pos) in
|
let sub_scope_uid = SubScopeName.fresh (name, name_pos) in
|
||||||
@ -310,7 +310,7 @@ let rec process_base_typ
|
|||||||
| None ->
|
| None ->
|
||||||
Errors.raise_spanned_error typ_pos
|
Errors.raise_spanned_error typ_pos
|
||||||
"Unknown type \"%a\", not a struct or enum previously declared"
|
"Unknown type \"%a\", not a struct or enum previously declared"
|
||||||
(Utils.Cli.format_with_style [ANSITerminal.yellow])
|
(Cli.format_with_style [ANSITerminal.yellow])
|
||||||
ident))
|
ident))
|
||||||
|
|
||||||
(** Process a type (function or not) *)
|
(** Process a type (function or not) *)
|
||||||
@ -342,7 +342,7 @@ let process_data_decl
|
|||||||
Errors.raise_multispanned_error
|
Errors.raise_multispanned_error
|
||||||
[Some "First use:", Marked.get_mark info; Some "Second use:", pos]
|
[Some "First use:", Marked.get_mark info; Some "Second use:", pos]
|
||||||
"Variable name \"%a\" already used"
|
"Variable name \"%a\" already used"
|
||||||
(Utils.Cli.format_with_style [ANSITerminal.yellow])
|
(Cli.format_with_style [ANSITerminal.yellow])
|
||||||
name
|
name
|
||||||
| None ->
|
| None ->
|
||||||
let uid = ScopeVar.fresh (name, pos) in
|
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;
|
Some "Second definition:", pos;
|
||||||
]
|
]
|
||||||
"%s name \"%a\" already defined" msg
|
"%s name \"%a\" already defined" msg
|
||||||
(Utils.Cli.format_with_style [ANSITerminal.yellow])
|
(Cli.format_with_style [ANSITerminal.yellow])
|
||||||
name
|
name
|
||||||
in
|
in
|
||||||
match Marked.unmark item with
|
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
|
Errors.raise_spanned_error
|
||||||
(Marked.get_mark suse.Surface.Ast.scope_use_name)
|
(Marked.get_mark suse.Surface.Ast.scope_use_name)
|
||||||
"\"%a\": this scope has not been declared anywhere, is it a typo?"
|
"\"%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)
|
(Marked.unmark suse.Surface.Ast.scope_use_name)
|
||||||
in
|
in
|
||||||
List.fold_left
|
List.fold_left
|
||||||
|
@ -18,7 +18,7 @@
|
|||||||
(** Builds a context that allows for mapping each name to a precise uid, taking
|
(** Builds a context that allows for mapping each name to a precise uid, taking
|
||||||
lexical scopes into account *)
|
lexical scopes into account *)
|
||||||
|
|
||||||
open Utils
|
open Catala_utils
|
||||||
open Shared_ast
|
open Shared_ast
|
||||||
|
|
||||||
(** {1 Name resolution context} *)
|
(** {1 Name resolution context} *)
|
||||||
|
@ -15,10 +15,7 @@
|
|||||||
License for the specific language governing permissions and limitations under
|
License for the specific language governing permissions and limitations under
|
||||||
the License. *)
|
the License. *)
|
||||||
|
|
||||||
module Cli = Utils.Cli
|
open Catala_utils
|
||||||
module File = Utils.File
|
|
||||||
module Errors = Utils.Errors
|
|
||||||
module Pos = Utils.Pos
|
|
||||||
|
|
||||||
(** Associates a {!type: Cli.backend_lang} with its string represtation. *)
|
(** Associates a {!type: Cli.backend_lang} with its string represtation. *)
|
||||||
let languages = ["en", Cli.En; "fr", Cli.Fr; "pl", Cli.Pl]
|
let languages = ["en", Cli.En; "fr", Cli.Fr; "pl", Cli.Pl]
|
||||||
|
@ -15,9 +15,11 @@
|
|||||||
License for the specific language governing permissions and limitations under
|
License for the specific language governing permissions and limitations under
|
||||||
the License. *)
|
the License. *)
|
||||||
|
|
||||||
|
open Catala_utils
|
||||||
|
|
||||||
module Plugin = Plugin.PluginAPI
|
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
|
(** Entry function for the executable. Returns a negative number in case of
|
||||||
error. *)
|
error. *)
|
||||||
|
|
||||||
|
@ -3,7 +3,7 @@
|
|||||||
(public_name catala.driver)
|
(public_name catala.driver)
|
||||||
(libraries
|
(libraries
|
||||||
dynlink
|
dynlink
|
||||||
utils
|
catala_utils
|
||||||
surface
|
surface
|
||||||
desugared
|
desugared
|
||||||
literate
|
literate
|
||||||
|
@ -103,7 +103,7 @@ Two more modules contain additional features for the compiler:
|
|||||||
|
|
||||||
{ul
|
{ul
|
||||||
{li {{: literate.html} Literate programming}}
|
{li {{: literate.html} Literate programming}}
|
||||||
{li {{: utils.html} Compiler utilities}}
|
{li {{: catala_utils.html} Compiler utilities}}
|
||||||
}
|
}
|
||||||
|
|
||||||
The Catala runtimes documentation is available here:
|
The Catala runtimes documentation is available here:
|
||||||
|
@ -14,7 +14,7 @@
|
|||||||
License for the specific language governing permissions and limitations under
|
License for the specific language governing permissions and limitations under
|
||||||
the License. *)
|
the License. *)
|
||||||
|
|
||||||
open Utils
|
open Catala_utils
|
||||||
include Shared_ast
|
include Shared_ast
|
||||||
|
|
||||||
type lit = lcalc glit
|
type lit = lcalc glit
|
||||||
|
@ -14,6 +14,7 @@
|
|||||||
License for the specific language governing permissions and limitations under
|
License for the specific language governing permissions and limitations under
|
||||||
the License. *)
|
the License. *)
|
||||||
|
|
||||||
|
open Catala_utils
|
||||||
open Shared_ast
|
open Shared_ast
|
||||||
|
|
||||||
(** Abstract syntax tree for the lambda calculus *)
|
(** 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
|
'm expr boxed -> 'm expr boxed -> 'm expr boxed -> 'm expr boxed
|
||||||
|
|
||||||
val make_matchopt :
|
val make_matchopt :
|
||||||
Utils.Pos.t ->
|
Pos.t ->
|
||||||
'm expr Var.t ->
|
'm expr Var.t ->
|
||||||
typ ->
|
typ ->
|
||||||
'm expr boxed ->
|
'm expr boxed ->
|
||||||
|
@ -14,7 +14,7 @@
|
|||||||
License for the specific language governing permissions and limitations under
|
License for the specific language governing permissions and limitations under
|
||||||
the License. *)
|
the License. *)
|
||||||
|
|
||||||
open Utils
|
open Catala_utils
|
||||||
open Shared_ast
|
open Shared_ast
|
||||||
open Ast
|
open Ast
|
||||||
module D = Dcalc.Ast
|
module D = Dcalc.Ast
|
||||||
|
@ -14,7 +14,7 @@
|
|||||||
License for the specific language governing permissions and limitations under
|
License for the specific language governing permissions and limitations under
|
||||||
the License. *)
|
the License. *)
|
||||||
|
|
||||||
open Utils
|
open Catala_utils
|
||||||
open Shared_ast
|
open Shared_ast
|
||||||
module D = Dcalc.Ast
|
module D = Dcalc.Ast
|
||||||
module A = Ast
|
module A = Ast
|
||||||
@ -43,7 +43,7 @@ let rec translate_default
|
|||||||
Expr.make_app
|
Expr.make_app
|
||||||
(Expr.make_var
|
(Expr.make_var
|
||||||
(Var.translate A.handle_default)
|
(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;
|
Expr.earray exceptions mark_default;
|
||||||
thunk_expr (translate_expr ctx just);
|
thunk_expr (translate_expr ctx just);
|
||||||
|
@ -14,7 +14,7 @@
|
|||||||
License for the specific language governing permissions and limitations under
|
License for the specific language governing permissions and limitations under
|
||||||
the License. *)
|
the License. *)
|
||||||
|
|
||||||
open Utils
|
open Catala_utils
|
||||||
module D = Dcalc.Ast
|
module D = Dcalc.Ast
|
||||||
module A = Ast
|
module A = Ast
|
||||||
|
|
||||||
|
@ -13,7 +13,7 @@
|
|||||||
WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the
|
WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the
|
||||||
License for the specific language governing permissions and limitations under
|
License for the specific language governing permissions and limitations under
|
||||||
the License. *)
|
the License. *)
|
||||||
open Utils
|
open Catala_utils
|
||||||
open Shared_ast
|
open Shared_ast
|
||||||
open Ast
|
open Ast
|
||||||
module D = Dcalc.Ast
|
module D = Dcalc.Ast
|
||||||
|
@ -14,7 +14,7 @@
|
|||||||
License for the specific language governing permissions and limitations under
|
License for the specific language governing permissions and limitations under
|
||||||
the License. *)
|
the License. *)
|
||||||
|
|
||||||
open Utils
|
open Catala_utils
|
||||||
open Shared_ast
|
open Shared_ast
|
||||||
open Ast
|
open Ast
|
||||||
open String_common
|
open String_common
|
||||||
@ -91,7 +91,7 @@ let format_uid_list (fmt : Format.formatter) (uids : Uid.MarkedString.info list)
|
|||||||
(Format.pp_print_list
|
(Format.pp_print_list
|
||||||
~pp_sep:(fun fmt () -> Format.fprintf fmt ";@ ")
|
~pp_sep:(fun fmt () -> Format.fprintf fmt ";@ ")
|
||||||
(fun fmt info ->
|
(fun fmt info ->
|
||||||
Format.fprintf fmt "\"%a\"" Utils.Uid.MarkedString.format_info info))
|
Format.fprintf fmt "\"%a\"" Uid.MarkedString.format info))
|
||||||
uids
|
uids
|
||||||
|
|
||||||
let format_string_list (fmt : Format.formatter) (uids : string list) : unit =
|
let format_string_list (fmt : Format.formatter) (uids : string list) : unit =
|
||||||
|
@ -1,7 +1,7 @@
|
|||||||
(library
|
(library
|
||||||
(name literate)
|
(name literate)
|
||||||
(public_name catala.literate)
|
(public_name catala.literate)
|
||||||
(libraries re utils surface ubase))
|
(libraries re catala_utils surface ubase))
|
||||||
|
|
||||||
(documentation
|
(documentation
|
||||||
(package catala)
|
(package catala)
|
||||||
|
@ -18,7 +18,7 @@
|
|||||||
(** This modules weaves the source code and the legislative text together into a
|
(** This modules weaves the source code and the legislative text together into a
|
||||||
document that law professionals can understand. *)
|
document that law professionals can understand. *)
|
||||||
|
|
||||||
open Utils
|
open Catala_utils
|
||||||
open Literate_common
|
open Literate_common
|
||||||
module A = Surface.Ast
|
module A = Surface.Ast
|
||||||
module P = Printf
|
module P = Printf
|
||||||
@ -91,7 +91,7 @@ let wrap_html
|
|||||||
</ul>\n"
|
</ul>\n"
|
||||||
css_as_string (literal_title language)
|
css_as_string (literal_title language)
|
||||||
(literal_generated_by language)
|
(literal_generated_by language)
|
||||||
Utils.Cli.version
|
Cli.version
|
||||||
(pre_html (literal_disclaimer_and_link language))
|
(pre_html (literal_disclaimer_and_link language))
|
||||||
(literal_source_files language)
|
(literal_source_files language)
|
||||||
(String.concat "\n"
|
(String.concat "\n"
|
||||||
|
@ -17,7 +17,7 @@
|
|||||||
(** This modules weaves the source code and the legislative text together into a
|
(** This modules weaves the source code and the legislative text together into a
|
||||||
document that law professionals can understand. *)
|
document that law professionals can understand. *)
|
||||||
|
|
||||||
open Utils
|
open Catala_utils
|
||||||
|
|
||||||
(** {1 Helpers} *)
|
(** {1 Helpers} *)
|
||||||
|
|
||||||
|
@ -18,7 +18,7 @@
|
|||||||
(** This modules weaves the source code and the legislative text together into a
|
(** This modules weaves the source code and the legislative text together into a
|
||||||
document that law professionals can understand. *)
|
document that law professionals can understand. *)
|
||||||
|
|
||||||
open Utils
|
open Catala_utils
|
||||||
open Literate_common
|
open Literate_common
|
||||||
module A = Surface.Ast
|
module A = Surface.Ast
|
||||||
module R = Re.Pcre
|
module R = Re.Pcre
|
||||||
@ -158,7 +158,7 @@ codes={\catcode`\$=3\catcode`\^=7}
|
|||||||
https://gouvfr.atlassian.net/wiki/spaces/DB/pages/223019527/Typographie+-+Typography *)
|
https://gouvfr.atlassian.net/wiki/spaces/DB/pages/223019527/Typographie+-+Typography *)
|
||||||
(literal_title language)
|
(literal_title language)
|
||||||
(literal_generated_by language)
|
(literal_generated_by language)
|
||||||
Utils.Cli.version
|
Cli.version
|
||||||
(pre_latexify (literal_disclaimer_and_link language))
|
(pre_latexify (literal_disclaimer_and_link language))
|
||||||
(literal_source_files language)
|
(literal_source_files language)
|
||||||
(String.concat
|
(String.concat
|
||||||
|
@ -17,7 +17,7 @@
|
|||||||
(** This modules weaves the source code and the legislative text together into a
|
(** This modules weaves the source code and the legislative text together into a
|
||||||
document that law professionals can understand. *)
|
document that law professionals can understand. *)
|
||||||
|
|
||||||
open Utils
|
open Catala_utils
|
||||||
|
|
||||||
(** {1 Helpers} *)
|
(** {1 Helpers} *)
|
||||||
|
|
||||||
|
@ -14,7 +14,7 @@
|
|||||||
License for the specific language governing permissions and limitations under
|
License for the specific language governing permissions and limitations under
|
||||||
the License. *)
|
the License. *)
|
||||||
|
|
||||||
open Utils
|
open Catala_utils
|
||||||
open Cli
|
open Cli
|
||||||
|
|
||||||
let literal_title = function
|
let literal_title = function
|
||||||
|
@ -14,32 +14,32 @@
|
|||||||
License for the specific language governing permissions and limitations under
|
License for the specific language governing permissions and limitations under
|
||||||
the License. *)
|
the License. *)
|
||||||
|
|
||||||
open Utils
|
open Catala_utils
|
||||||
|
|
||||||
val literal_title : Cli.backend_lang -> string
|
val literal_title : Cli.backend_lang -> string
|
||||||
(** Return the title traduction according the given
|
(** Return the title traduction according the given
|
||||||
{!type:Utils.Cli.backend_lang}. *)
|
{!type:Cli.backend_lang}. *)
|
||||||
|
|
||||||
val literal_generated_by : Cli.backend_lang -> string
|
val literal_generated_by : Cli.backend_lang -> string
|
||||||
(** Return the 'generated by' traduction according the given
|
(** 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
|
val literal_source_files : Cli.backend_lang -> string
|
||||||
(** Return the 'source files weaved' traduction according the given
|
(** 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
|
val literal_disclaimer_and_link : Cli.backend_lang -> string
|
||||||
(** Return the traduction of a paragraph giving a basic disclaimer about Catala
|
(** Return the traduction of a paragraph giving a basic disclaimer about Catala
|
||||||
and a link to the website according the given {!type:
|
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
|
val literal_last_modification : Cli.backend_lang -> string
|
||||||
(** Return the 'last modification' traduction according the given
|
(** 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
|
val get_language_extension : Cli.backend_lang -> string
|
||||||
(** Return the file extension corresponding to the given
|
(** Return the file extension corresponding to the given
|
||||||
{!type:Utils.Cli.backend_lang}. *)
|
{!type:Cli.backend_lang}. *)
|
||||||
|
|
||||||
val run_pandoc : string -> [ `Html | `Latex ] -> string
|
val run_pandoc : string -> [ `Html | `Latex ] -> string
|
||||||
(** Runs the [pandoc] on a string to pretty-print markdown features into the
|
(** Runs the [pandoc] on a string to pretty-print markdown features into the
|
||||||
|
@ -14,8 +14,10 @@
|
|||||||
License for the specific language governing permissions and limitations under
|
License for the specific language governing permissions and limitations under
|
||||||
the License. *)
|
the License. *)
|
||||||
|
|
||||||
|
open Catala_utils
|
||||||
|
|
||||||
type 'ast plugin_apply_fun_typ =
|
type 'ast plugin_apply_fun_typ =
|
||||||
source_file:Utils.Pos.input_file ->
|
source_file:Pos.input_file ->
|
||||||
output_file:string option ->
|
output_file:string option ->
|
||||||
scope:string option ->
|
scope:string option ->
|
||||||
'ast ->
|
'ast ->
|
||||||
@ -51,9 +53,9 @@ let find name = Hashtbl.find backend_plugins (String.lowercase_ascii name)
|
|||||||
let load_file f =
|
let load_file f =
|
||||||
try
|
try
|
||||||
Dynlink.loadfile f;
|
Dynlink.loadfile f;
|
||||||
Utils.Cli.debug_print "Plugin %S loaded" f
|
Cli.debug_print "Plugin %S loaded" f
|
||||||
with e ->
|
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)
|
(Printexc.to_string e)
|
||||||
|
|
||||||
let load_dir d =
|
let load_dir d =
|
||||||
|
@ -16,8 +16,10 @@
|
|||||||
|
|
||||||
(** {2 catala-facing API} *)
|
(** {2 catala-facing API} *)
|
||||||
|
|
||||||
|
open Catala_utils
|
||||||
|
|
||||||
type 'ast plugin_apply_fun_typ =
|
type 'ast plugin_apply_fun_typ =
|
||||||
source_file:Utils.Pos.input_file ->
|
source_file:Pos.input_file ->
|
||||||
output_file:string option ->
|
output_file:string option ->
|
||||||
scope:string option ->
|
scope:string option ->
|
||||||
'ast ->
|
'ast ->
|
||||||
|
@ -18,7 +18,7 @@
|
|||||||
(** Catala plugin for generating web APIs. It generates OCaml code before the
|
(** Catala plugin for generating web APIs. It generates OCaml code before the
|
||||||
the associated [js_of_ocaml] wrapper. *)
|
the associated [js_of_ocaml] wrapper. *)
|
||||||
|
|
||||||
open Utils
|
open Catala_utils
|
||||||
open Shared_ast
|
open Shared_ast
|
||||||
open String_common
|
open String_common
|
||||||
open Lcalc
|
open Lcalc
|
||||||
|
@ -20,7 +20,7 @@
|
|||||||
let name = "json_schema"
|
let name = "json_schema"
|
||||||
let extension = "_schema.json"
|
let extension = "_schema.json"
|
||||||
|
|
||||||
open Utils
|
open Catala_utils
|
||||||
open String_common
|
open String_common
|
||||||
open Shared_ast
|
open Shared_ast
|
||||||
open Lcalc.Ast
|
open Lcalc.Ast
|
||||||
|
@ -20,13 +20,15 @@
|
|||||||
The code for the Python backend already has first-class support, so there
|
The code for the Python backend already has first-class support, so there
|
||||||
would be no reason to use this plugin instead *)
|
would be no reason to use this plugin instead *)
|
||||||
|
|
||||||
|
open Catala_utils
|
||||||
|
|
||||||
let name = "python-plugin"
|
let name = "python-plugin"
|
||||||
let extension = ".py"
|
let extension = ".py"
|
||||||
|
|
||||||
let apply ~source_file ~output_file ~scope prgm type_ordering =
|
let apply ~source_file ~output_file ~scope prgm type_ordering =
|
||||||
ignore source_file;
|
ignore source_file;
|
||||||
ignore scope;
|
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
|
@@ fun fmt -> Scalc.To_python.format_program fmt prgm type_ordering
|
||||||
|
|
||||||
let () = Driver.Plugin.register_scalc ~name ~extension apply
|
let () = Driver.Plugin.register_scalc ~name ~extension apply
|
||||||
|
@ -14,7 +14,7 @@
|
|||||||
License for the specific language governing permissions and limitations under
|
License for the specific language governing permissions and limitations under
|
||||||
the License. *)
|
the License. *)
|
||||||
|
|
||||||
open Utils
|
open Catala_utils
|
||||||
open Shared_ast
|
open Shared_ast
|
||||||
module D = Dcalc.Ast
|
module D = Dcalc.Ast
|
||||||
module L = Lcalc.Ast
|
module L = Lcalc.Ast
|
||||||
|
@ -14,7 +14,7 @@
|
|||||||
License for the specific language governing permissions and limitations under
|
License for the specific language governing permissions and limitations under
|
||||||
the License. *)
|
the License. *)
|
||||||
|
|
||||||
open Utils
|
open Catala_utils
|
||||||
open Shared_ast
|
open Shared_ast
|
||||||
module A = Ast
|
module A = Ast
|
||||||
module L = Lcalc.Ast
|
module L = Lcalc.Ast
|
||||||
|
@ -14,7 +14,7 @@
|
|||||||
License for the specific language governing permissions and limitations under
|
License for the specific language governing permissions and limitations under
|
||||||
the License. *)
|
the License. *)
|
||||||
|
|
||||||
open Utils
|
open Catala_utils
|
||||||
open Shared_ast
|
open Shared_ast
|
||||||
open Ast
|
open Ast
|
||||||
|
|
||||||
|
@ -15,7 +15,7 @@
|
|||||||
the License. *)
|
the License. *)
|
||||||
[@@@warning "-32-27"]
|
[@@@warning "-32-27"]
|
||||||
|
|
||||||
open Utils
|
open Catala_utils
|
||||||
open Shared_ast
|
open Shared_ast
|
||||||
open Ast
|
open Ast
|
||||||
open String_common
|
open String_common
|
||||||
@ -77,7 +77,7 @@ let format_uid_list (fmt : Format.formatter) (uids : Uid.MarkedString.info list)
|
|||||||
(Format.pp_print_list
|
(Format.pp_print_list
|
||||||
~pp_sep:(fun fmt () -> Format.fprintf fmt ",@ ")
|
~pp_sep:(fun fmt () -> Format.fprintf fmt ",@ ")
|
||||||
(fun fmt info ->
|
(fun fmt info ->
|
||||||
Format.fprintf fmt "\"%a\"" Utils.Uid.MarkedString.format_info info))
|
Format.fprintf fmt "\"%a\"" Uid.MarkedString.format info))
|
||||||
uids
|
uids
|
||||||
|
|
||||||
let format_string_list (fmt : Format.formatter) (uids : string list) : unit =
|
let format_string_list (fmt : Format.formatter) (uids : string list) : unit =
|
||||||
|
@ -14,7 +14,7 @@
|
|||||||
License for the specific language governing permissions and limitations under
|
License for the specific language governing permissions and limitations under
|
||||||
the License. *)
|
the License. *)
|
||||||
|
|
||||||
open Utils
|
open Catala_utils
|
||||||
open Shared_ast
|
open Shared_ast
|
||||||
|
|
||||||
type location = scopelang glocation
|
type location = scopelang glocation
|
||||||
|
@ -16,7 +16,7 @@
|
|||||||
|
|
||||||
(** Abstract syntax tree of the scope language *)
|
(** Abstract syntax tree of the scope language *)
|
||||||
|
|
||||||
open Utils
|
open Catala_utils
|
||||||
open Shared_ast
|
open Shared_ast
|
||||||
|
|
||||||
(** {1 Identifiers} *)
|
(** {1 Identifiers} *)
|
||||||
|
@ -17,7 +17,7 @@
|
|||||||
(** Graph representation of the dependencies between scopes in the Catala
|
(** 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. *)
|
program. Vertices are functions, x -> y if x is used in the definition of y. *)
|
||||||
|
|
||||||
open Utils
|
open Catala_utils
|
||||||
open Shared_ast
|
open Shared_ast
|
||||||
module SVertex = ScopeName
|
module SVertex = ScopeName
|
||||||
|
|
||||||
|
@ -17,7 +17,7 @@
|
|||||||
(** Graph representation of the dependencies between scopes in the Catala
|
(** 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. *)
|
program. Vertices are functions, x -> y if x is used in the definition of y. *)
|
||||||
|
|
||||||
open Utils
|
open Catala_utils
|
||||||
open Shared_ast
|
open Shared_ast
|
||||||
|
|
||||||
(** {1 Scope dependencies} *)
|
(** {1 Scope dependencies} *)
|
||||||
|
@ -1,7 +1,7 @@
|
|||||||
(library
|
(library
|
||||||
(name scopelang)
|
(name scopelang)
|
||||||
(public_name catala.scopelang)
|
(public_name catala.scopelang)
|
||||||
(libraries utils ocamlgraph desugared)
|
(libraries catala_utils ocamlgraph desugared)
|
||||||
(flags
|
(flags
|
||||||
(:standard -short-paths)))
|
(:standard -short-paths)))
|
||||||
|
|
||||||
|
@ -16,7 +16,7 @@
|
|||||||
|
|
||||||
(** Translation from {!module: Desugared.Ast} to {!module: Scopelang.Ast} *)
|
(** Translation from {!module: Desugared.Ast} to {!module: Scopelang.Ast} *)
|
||||||
|
|
||||||
open Utils
|
open Catala_utils
|
||||||
open Shared_ast
|
open Shared_ast
|
||||||
|
|
||||||
(** {1 Expression translation}*)
|
(** {1 Expression translation}*)
|
||||||
@ -33,7 +33,7 @@ type ctx = {
|
|||||||
let tag_with_log_entry
|
let tag_with_log_entry
|
||||||
(e : untyped Ast.expr boxed)
|
(e : untyped Ast.expr boxed)
|
||||||
(l : log_entry)
|
(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.eapp
|
||||||
(Expr.eop (Unop (Log (l, markings))) (Marked.get_mark e))
|
(Expr.eop (Unop (Log (l, markings))) (Marked.get_mark e))
|
||||||
[e] (Marked.get_mark e)
|
[e] (Marked.get_mark e)
|
||||||
|
@ -14,7 +14,7 @@
|
|||||||
License for the specific language governing permissions and limitations under
|
License for the specific language governing permissions and limitations under
|
||||||
the License. *)
|
the License. *)
|
||||||
|
|
||||||
open Utils
|
open Catala_utils
|
||||||
open Shared_ast
|
open Shared_ast
|
||||||
open Ast
|
open Ast
|
||||||
|
|
||||||
|
@ -20,7 +20,7 @@
|
|||||||
|
|
||||||
(* Doesn't define values, so OK to have without an mli *)
|
(* Doesn't define values, so OK to have without an mli *)
|
||||||
|
|
||||||
open Utils
|
open Catala_utils
|
||||||
module Runtime = Runtime_ocaml.Runtime
|
module Runtime = Runtime_ocaml.Runtime
|
||||||
module ScopeName = Uid.Gen ()
|
module ScopeName = Uid.Gen ()
|
||||||
module StructName = Uid.Gen ()
|
module StructName = Uid.Gen ()
|
||||||
|
@ -3,4 +3,4 @@
|
|||||||
(public_name catala.shared_ast)
|
(public_name catala.shared_ast)
|
||||||
(flags
|
(flags
|
||||||
(:standard -short-paths))
|
(:standard -short-paths))
|
||||||
(libraries bindlib unionFind utils catala.runtime_ocaml))
|
(libraries bindlib unionFind catala_utils catala.runtime_ocaml))
|
||||||
|
@ -15,7 +15,7 @@
|
|||||||
License for the specific language governing permissions and limitations under
|
License for the specific language governing permissions and limitations under
|
||||||
the License. *)
|
the License. *)
|
||||||
|
|
||||||
open Utils
|
open Catala_utils
|
||||||
open Definitions
|
open Definitions
|
||||||
|
|
||||||
(** Functions handling the types of [shared_ast] *)
|
(** Functions handling the types of [shared_ast] *)
|
||||||
|
@ -17,7 +17,7 @@
|
|||||||
|
|
||||||
(** Functions handling the expressions of [shared_ast] *)
|
(** Functions handling the expressions of [shared_ast] *)
|
||||||
|
|
||||||
open Utils
|
open Catala_utils
|
||||||
open Definitions
|
open Definitions
|
||||||
|
|
||||||
(** {2 Boxed constructors} *)
|
(** {2 Boxed constructors} *)
|
||||||
|
@ -14,7 +14,7 @@
|
|||||||
License for the specific language governing permissions and limitations under
|
License for the specific language governing permissions and limitations under
|
||||||
the License. *)
|
the License. *)
|
||||||
|
|
||||||
open Utils
|
open Catala_utils
|
||||||
open String_common
|
open String_common
|
||||||
open Definitions
|
open Definitions
|
||||||
|
|
||||||
@ -26,27 +26,27 @@ let uid_list (fmt : Format.formatter) (infos : Uid.MarkedString.info list) :
|
|||||||
Format.pp_print_list
|
Format.pp_print_list
|
||||||
~pp_sep:(fun fmt () -> Format.pp_print_char fmt '.')
|
~pp_sep:(fun fmt () -> Format.pp_print_char fmt '.')
|
||||||
(fun fmt info ->
|
(fun fmt info ->
|
||||||
Utils.Cli.format_with_style
|
Cli.format_with_style
|
||||||
(if begins_with_uppercase (Marked.unmark info) then [ANSITerminal.red]
|
(if begins_with_uppercase (Marked.unmark info) then [ANSITerminal.red]
|
||||||
else [])
|
else [])
|
||||||
fmt
|
fmt
|
||||||
(Utils.Uid.MarkedString.to_string info))
|
(Uid.MarkedString.to_string info))
|
||||||
fmt infos
|
fmt infos
|
||||||
|
|
||||||
let keyword (fmt : Format.formatter) (s : string) : unit =
|
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 =
|
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 =
|
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 =
|
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 =
|
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 =
|
let tlit (fmt : Format.formatter) (l : typ_lit) : unit =
|
||||||
base_type fmt
|
base_type fmt
|
||||||
@ -68,7 +68,7 @@ let location (type a) (fmt : Format.formatter) (l : a glocation) : unit =
|
|||||||
ScopeVar.format_t (Marked.unmark subvar)
|
ScopeVar.format_t (Marked.unmark subvar)
|
||||||
|
|
||||||
let enum_constructor (fmt : Format.formatter) (c : EnumConstructor.t) : unit =
|
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)
|
(Format.asprintf "%a" EnumConstructor.format_t c)
|
||||||
|
|
||||||
let rec typ (ctx : decl_ctx option) (fmt : Format.formatter) (ty : typ) : unit =
|
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 "()"
|
| LUnit -> lit_style fmt "()"
|
||||||
| LRat i ->
|
| LRat i ->
|
||||||
lit_style fmt
|
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 -> (
|
| 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))
|
| En -> lit_style fmt (Format.asprintf "$%s" (Runtime.money_to_string e))
|
||||||
| Fr -> 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))
|
| 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 =
|
let log_entry (fmt : Format.formatter) (entry : log_entry) : unit =
|
||||||
Format.fprintf fmt "@<2>%a"
|
Format.fprintf fmt "@<2>%a"
|
||||||
(fun fmt -> function
|
(fun fmt -> function
|
||||||
| VarDef _ -> Utils.Cli.format_with_style [ANSITerminal.blue] fmt "≔ "
|
| VarDef _ -> Cli.format_with_style [ANSITerminal.blue] fmt "≔ "
|
||||||
| BeginCall -> Utils.Cli.format_with_style [ANSITerminal.yellow] fmt "→ "
|
| BeginCall -> Cli.format_with_style [ANSITerminal.yellow] fmt "→ "
|
||||||
| EndCall -> Utils.Cli.format_with_style [ANSITerminal.yellow] fmt "← "
|
| EndCall -> Cli.format_with_style [ANSITerminal.yellow] fmt "← "
|
||||||
| PosRecordIfTrueBool ->
|
| PosRecordIfTrueBool ->
|
||||||
Utils.Cli.format_with_style [ANSITerminal.green] fmt "☛ ")
|
Cli.format_with_style [ANSITerminal.green] fmt "☛ ")
|
||||||
entry
|
entry
|
||||||
|
|
||||||
let unop (fmt : Format.formatter) (op : unop) : unit =
|
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.fprintf fmt "log@[<hov 2>[%a|%a]@]" log_entry entry
|
||||||
(Format.pp_print_list
|
(Format.pp_print_list
|
||||||
~pp_sep:(fun fmt () -> Format.fprintf fmt ".")
|
~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
|
infos
|
||||||
| Length -> Format.pp_print_string fmt "length"
|
| Length -> Format.pp_print_string fmt "length"
|
||||||
| IntToRat -> Format.pp_print_string fmt "int_to_rat"
|
| IntToRat -> Format.pp_print_string fmt "int_to_rat"
|
||||||
|
@ -16,7 +16,7 @@
|
|||||||
|
|
||||||
(** Printing functions for the default calculus AST *)
|
(** Printing functions for the default calculus AST *)
|
||||||
|
|
||||||
open Utils
|
open Catala_utils
|
||||||
open Definitions
|
open Definitions
|
||||||
|
|
||||||
(** {1 Common syntax highlighting helpers}*)
|
(** {1 Common syntax highlighting helpers}*)
|
||||||
|
@ -15,7 +15,7 @@
|
|||||||
License for the specific language governing permissions and limitations under
|
License for the specific language governing permissions and limitations under
|
||||||
the License. *)
|
the License. *)
|
||||||
|
|
||||||
open Utils
|
open Catala_utils
|
||||||
open Definitions
|
open Definitions
|
||||||
|
|
||||||
let rec fold_left_lets ~f ~init scope_body_expr =
|
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
|
get_body_expr_mark e
|
||||||
| Result e ->
|
| Result e ->
|
||||||
let m = Marked.get_mark e in
|
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 get_body_mark scope_body =
|
||||||
let _, e = Bindlib.unbind scope_body.scope_body_expr in
|
let _, e = Bindlib.unbind scope_body.scope_body_expr in
|
||||||
|
@ -17,7 +17,7 @@
|
|||||||
|
|
||||||
(** Functions handling the scope structures of [shared_ast] *)
|
(** Functions handling the scope structures of [shared_ast] *)
|
||||||
|
|
||||||
open Utils
|
open Catala_utils
|
||||||
open Definitions
|
open Definitions
|
||||||
|
|
||||||
(** {2 Traversal functions} *)
|
(** {2 Traversal functions} *)
|
||||||
|
@ -17,16 +17,16 @@
|
|||||||
(** Typing for the default calculus. Because of the error terms, we perform type
|
(** Typing for the default calculus. Because of the error terms, we perform type
|
||||||
inference using the classical W algorithm with union-find unification. *)
|
inference using the classical W algorithm with union-find unification. *)
|
||||||
|
|
||||||
open Utils
|
open Catala_utils
|
||||||
module A = Definitions
|
module A = Definitions
|
||||||
|
|
||||||
module Any =
|
module Any =
|
||||||
Utils.Uid.Make
|
Uid.Make
|
||||||
(struct
|
(struct
|
||||||
type info = unit
|
type info = unit
|
||||||
|
|
||||||
let to_string _ = "any"
|
let to_string _ = "any"
|
||||||
let format_info fmt () = Format.fprintf fmt "any"
|
let format fmt () = Format.fprintf fmt "any"
|
||||||
let equal _ _ = true
|
let equal _ _ = true
|
||||||
let compare _ _ = 0
|
let compare _ _ = 0
|
||||||
end)
|
end)
|
||||||
|
@ -19,7 +19,7 @@
|
|||||||
|
|
||||||
[@@@ocaml.warning "-7"]
|
[@@@ocaml.warning "-7"]
|
||||||
|
|
||||||
open Utils
|
open Catala_utils
|
||||||
(** {1 Visitor classes for programs} *)
|
(** {1 Visitor classes for programs} *)
|
||||||
|
|
||||||
(** To allow for quick traversal and/or modification of this AST structure, we
|
(** To allow for quick traversal and/or modification of this AST structure, we
|
||||||
|
@ -2,7 +2,7 @@
|
|||||||
(name surface)
|
(name surface)
|
||||||
(public_name catala.surface)
|
(public_name catala.surface)
|
||||||
(libraries
|
(libraries
|
||||||
utils
|
catala_utils
|
||||||
menhirLib
|
menhirLib
|
||||||
sedlex
|
sedlex
|
||||||
re
|
re
|
||||||
|
@ -14,7 +14,7 @@
|
|||||||
License for the specific language governing permissions and limitations under
|
License for the specific language governing permissions and limitations under
|
||||||
the License. *)
|
the License. *)
|
||||||
|
|
||||||
open Utils
|
open Catala_utils
|
||||||
|
|
||||||
let fill_pos_with_legislative_info (p : Ast.program) : Ast.program =
|
let fill_pos_with_legislative_info (p : Ast.program) : Ast.program =
|
||||||
let visitor =
|
let visitor =
|
||||||
|
@ -14,7 +14,7 @@
|
|||||||
|
|
||||||
open Tokens
|
open Tokens
|
||||||
open Sedlexing
|
open Sedlexing
|
||||||
open Utils
|
open Catala_utils
|
||||||
module L = Lexer_common
|
module L = Lexer_common
|
||||||
module R = Re.Pcre
|
module R = Re.Pcre
|
||||||
|
|
||||||
|
@ -17,7 +17,7 @@
|
|||||||
|
|
||||||
open Tokens
|
open Tokens
|
||||||
open Sedlexing
|
open Sedlexing
|
||||||
open Utils
|
open Catala_utils
|
||||||
module R = Re.Pcre
|
module R = Re.Pcre
|
||||||
|
|
||||||
(* Calculates the precedence according a {!val: matched_regex} of the form :
|
(* Calculates the precedence according a {!val: matched_regex} of the form :
|
||||||
|
@ -31,7 +31,7 @@ val code_buffer : Buffer.t
|
|||||||
val update_acc : Sedlexing.lexbuf -> unit
|
val update_acc : Sedlexing.lexbuf -> unit
|
||||||
(** Updates {!val:code_buffer} with the current lexeme *)
|
(** 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 *)
|
(** Error-generating helper *)
|
||||||
|
|
||||||
val token_list_language_agnostic : (string * Tokens.token) list
|
val token_list_language_agnostic : (string * Tokens.token) list
|
||||||
|
@ -18,7 +18,7 @@
|
|||||||
*)
|
*)
|
||||||
|
|
||||||
%{
|
%{
|
||||||
open Utils
|
open Catala_utils
|
||||||
%}
|
%}
|
||||||
|
|
||||||
%parameter<Localisation: sig
|
%parameter<Localisation: sig
|
||||||
|
@ -19,7 +19,7 @@
|
|||||||
Parser_driver.parse_source_file} API. *)
|
Parser_driver.parse_source_file} API. *)
|
||||||
|
|
||||||
open Sedlexing
|
open Sedlexing
|
||||||
open Utils
|
open Catala_utils
|
||||||
|
|
||||||
(** {1 Internal functions} *)
|
(** {1 Internal functions} *)
|
||||||
|
|
||||||
|
@ -17,6 +17,6 @@
|
|||||||
(** Wrapping module around parser and lexer that offers the
|
(** Wrapping module around parser and lexer that offers the
|
||||||
[Surface.Parser_driver.parse_source_file] API. *)
|
[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
|
val parse_top_level_file : Pos.input_file -> Cli.backend_lang -> Ast.program
|
||||||
|
@ -15,7 +15,7 @@
|
|||||||
License for the specific language governing permissions and limitations under
|
License for the specific language governing permissions and limitations under
|
||||||
the License. *)
|
the License. *)
|
||||||
|
|
||||||
open Utils
|
open Catala_utils
|
||||||
open Shared_ast
|
open Shared_ast
|
||||||
open Dcalc
|
open Dcalc
|
||||||
open Ast
|
open Ast
|
||||||
|
@ -17,7 +17,7 @@
|
|||||||
|
|
||||||
(** Generates verification conditions from scope definitions *)
|
(** Generates verification conditions from scope definitions *)
|
||||||
|
|
||||||
open Utils
|
open Catala_utils
|
||||||
open Shared_ast
|
open Shared_ast
|
||||||
|
|
||||||
type verification_condition_kind =
|
type verification_condition_kind =
|
||||||
|
@ -3,7 +3,7 @@
|
|||||||
(public_name catala.verification)
|
(public_name catala.verification)
|
||||||
(libraries
|
(libraries
|
||||||
bindlib
|
bindlib
|
||||||
utils
|
catala_utils
|
||||||
dcalc
|
dcalc
|
||||||
catala.runtime_ocaml
|
catala.runtime_ocaml
|
||||||
dates_calc
|
dates_calc
|
||||||
|
@ -15,7 +15,7 @@
|
|||||||
License for the specific language governing permissions and limitations under
|
License for the specific language governing permissions and limitations under
|
||||||
the License. *)
|
the License. *)
|
||||||
|
|
||||||
open Utils
|
open Catala_utils
|
||||||
open Shared_ast
|
open Shared_ast
|
||||||
|
|
||||||
module type Backend = sig
|
module type Backend = sig
|
||||||
|
@ -14,6 +14,8 @@
|
|||||||
License for the specific language governing permissions and limitations under
|
License for the specific language governing permissions and limitations under
|
||||||
the License. *)
|
the License. *)
|
||||||
|
|
||||||
|
open Catala_utils
|
||||||
|
|
||||||
(** [solve_vc] is the main entry point of this module. It takes a list of
|
(** [solve_vc] is the main entry point of this module. It takes a list of
|
||||||
expressions [vcs] corresponding to verification conditions that must be
|
expressions [vcs] corresponding to verification conditions that must be
|
||||||
discharged by Z3, and attempts to solve them **)
|
discharged by Z3, and attempts to solve them **)
|
||||||
@ -45,4 +47,4 @@ let solve_vc
|
|||||||
true z3_vcs
|
true z3_vcs
|
||||||
in
|
in
|
||||||
if all_proven then
|
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."
|
||||||
|
@ -18,7 +18,7 @@
|
|||||||
without the expected backend. All functions print an error message and exit *)
|
without the expected backend. All functions print an error message and exit *)
|
||||||
|
|
||||||
let dummy () =
|
let dummy () =
|
||||||
Utils.Cli.error_print
|
Cli.error_print
|
||||||
"This instance of Catala was compiled without Z3 support.";
|
"This instance of Catala was compiled without Z3 support.";
|
||||||
exit 124
|
exit 124
|
||||||
|
|
||||||
|
@ -14,7 +14,7 @@
|
|||||||
License for the specific language governing permissions and limitations under
|
License for the specific language governing permissions and limitations under
|
||||||
the License. *)
|
the License. *)
|
||||||
|
|
||||||
open Utils
|
open Catala_utils
|
||||||
open Shared_ast
|
open Shared_ast
|
||||||
open Dcalc
|
open Dcalc
|
||||||
open Ast
|
open Ast
|
||||||
|
@ -15,6 +15,7 @@
|
|||||||
the License. *)
|
the License. *)
|
||||||
|
|
||||||
open Lwt
|
open Lwt
|
||||||
|
open Catala_utils
|
||||||
|
|
||||||
type access_token = string
|
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.member "access_token"
|
||||||
|> Yojson.Basic.Util.to_string
|
|> Yojson.Basic.Util.to_string
|
||||||
in
|
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
|
token
|
||||||
end
|
end
|
||||||
else begin
|
else begin
|
||||||
Utils.Cli.debug_format
|
Cli.debug_format
|
||||||
"The API access token request went wrong ; status is %s and the body is\n\
|
"The API access token request went wrong ; status is %s and the body is\n\
|
||||||
%s"
|
%s"
|
||||||
resp body;
|
resp body;
|
||||||
@ -109,7 +110,7 @@ let run_request (request : (string * string t) t) : Yojson.Basic.t =
|
|||||||
if resp = "200 OK" then
|
if resp = "200 OK" then
|
||||||
try body |> Yojson.Basic.from_string with
|
try body |> Yojson.Basic.from_string with
|
||||||
| Yojson.Basic.Util.Type_error (msg, obj) ->
|
| Yojson.Basic.Util.Type_error (msg, obj) ->
|
||||||
Utils.Cli.error_print
|
Cli.error_print
|
||||||
"Error while parsing JSON answer from API: %s\n\
|
"Error while parsing JSON answer from API: %s\n\
|
||||||
Specific JSON:\n\
|
Specific JSON:\n\
|
||||||
%s\n\
|
%s\n\
|
||||||
@ -128,10 +129,10 @@ let run_request (request : (string * string t) t) : Yojson.Basic.t =
|
|||||||
with Failure _ ->
|
with Failure _ ->
|
||||||
if n > 0 then (
|
if n > 0 then (
|
||||||
Unix.sleep 2;
|
Unix.sleep 2;
|
||||||
Utils.Cli.debug_format "Retrying request...";
|
Cli.debug_format "Retrying request...";
|
||||||
try_n_times (n - 1))
|
try_n_times (n - 1))
|
||||||
else (
|
else (
|
||||||
Utils.Cli.error_print
|
Cli.error_print
|
||||||
"The API request went wrong ; status is %s and the body is\n%s" resp
|
"The API request went wrong ; status is %s and the body is\n%s" resp
|
||||||
body;
|
body;
|
||||||
exit (-1))
|
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 ceta_tex id then CETATEXT
|
||||||
else if Re.execp jorf_rex id then JORFARTI
|
else if Re.execp jorf_rex id then JORFARTI
|
||||||
else
|
else
|
||||||
Utils.Errors.raise_error
|
Errors.raise_error
|
||||||
"LégiFrance ID \"%s\" does not correspond to an ID format recognized \
|
"LégiFrance ID \"%s\" does not correspond to an ID format recognized \
|
||||||
by the LégiFrance API"
|
by the LégiFrance API"
|
||||||
id
|
id
|
||||||
@ -161,7 +162,7 @@ let parse_id (id : string) : article_id =
|
|||||||
{ id; typ }
|
{ id; typ }
|
||||||
|
|
||||||
let retrieve_article (access_token : string) (obj : article_id) : article =
|
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 =
|
content =
|
||||||
run_request
|
run_request
|
||||||
@ -179,7 +180,7 @@ let raise_article_parsing_error
|
|||||||
(json : Yojson.Basic.t)
|
(json : Yojson.Basic.t)
|
||||||
(msg : string)
|
(msg : string)
|
||||||
(obj : Yojson.Basic.t) =
|
(obj : Yojson.Basic.t) =
|
||||||
Utils.Cli.error_print
|
Cli.error_print
|
||||||
"Error while manipulating JSON answer from API: %s\n\
|
"Error while manipulating JSON answer from API: %s\n\
|
||||||
Specific JSON:\n\
|
Specific JSON:\n\
|
||||||
%s\n\
|
%s\n\
|
||||||
|
@ -14,6 +14,8 @@
|
|||||||
License for the specific language governing permissions and limitations under
|
License for the specific language governing permissions and limitations under
|
||||||
the License. *)
|
the License. *)
|
||||||
|
|
||||||
|
open Catala_utils
|
||||||
|
|
||||||
(** Main logic for interacting with LégiFrance when traversing Catala source
|
(** Main logic for interacting with LégiFrance when traversing Catala source
|
||||||
files *)
|
files *)
|
||||||
|
|
||||||
@ -46,12 +48,12 @@ let check_article_expiration
|
|||||||
Some new_version
|
Some new_version
|
||||||
else None
|
else None
|
||||||
in
|
in
|
||||||
Utils.Cli.warning_print
|
Cli.warning_print
|
||||||
"%s %s has expired! Its expiration date is %s according to \
|
"%s %s has expired! Its expiration date is %s according to \
|
||||||
LégiFrance.%s"
|
LégiFrance.%s"
|
||||||
(Utils.Marked.unmark law_heading.Surface.Ast.law_heading_name)
|
(Marked.unmark law_heading.Surface.Ast.law_heading_name)
|
||||||
(Utils.Pos.to_string
|
(Pos.to_string
|
||||||
(Utils.Marked.get_mark law_heading.Surface.Ast.law_heading_name))
|
(Marked.get_mark law_heading.Surface.Ast.law_heading_name))
|
||||||
(Date.print_tm legifrance_expiration_date)
|
(Date.print_tm legifrance_expiration_date)
|
||||||
(match new_version with
|
(match new_version with
|
||||||
| None -> ""
|
| None -> ""
|
||||||
@ -61,7 +63,7 @@ let check_article_expiration
|
|||||||
else None
|
else None
|
||||||
|
|
||||||
type law_article_text = {
|
type law_article_text = {
|
||||||
article_title : string * Utils.Pos.t;
|
article_title : string * Pos.t;
|
||||||
text : string;
|
text : string;
|
||||||
new_version : Api.article_id option;
|
new_version : Api.article_id option;
|
||||||
current_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)
|
(law_article_text : law_article_text)
|
||||||
(access_token : Api.access_token) : unit =
|
(access_token : Api.access_token) : unit =
|
||||||
let print_diff msg diff =
|
let print_diff msg diff =
|
||||||
Utils.Cli.warning_print "%s\n%s" msg
|
Cli.warning_print "%s\n%s" msg
|
||||||
(String.concat "\n"
|
(String.concat "\n"
|
||||||
(List.map
|
(List.map
|
||||||
(fun chunk ->
|
(fun chunk ->
|
||||||
@ -138,7 +140,7 @@ let compare_to_versions
|
|||||||
"There is a diff between the source code version of %s %s and the \
|
"There is a diff between the source code version of %s %s and the \
|
||||||
text stored on LégiFrance:\n"
|
text stored on LégiFrance:\n"
|
||||||
(fst law_article_text.article_title)
|
(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)
|
diff)
|
||||||
| None -> ()
|
| None -> ()
|
||||||
end;
|
end;
|
||||||
@ -154,14 +156,14 @@ let compare_to_versions
|
|||||||
"Here is the diff between the current version of %s %s and what it \
|
"Here is the diff between the current version of %s %s and what it \
|
||||||
will become in the future:\n"
|
will become in the future:\n"
|
||||||
(fst law_article_text.article_title)
|
(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)
|
diff)
|
||||||
| None -> ()
|
| None -> ()
|
||||||
|
|
||||||
(** Fill an [@@Include ...@@] tag inside the Catala source file with the
|
(** Fill an [@@Include ...@@] tag inside the Catala source file with the
|
||||||
legislative contents retrieved from LégiFrance *)
|
legislative contents retrieved from LégiFrance *)
|
||||||
let include_legislative_text
|
let include_legislative_text
|
||||||
(id : string * Utils.Pos.t)
|
(id : string * Pos.t)
|
||||||
(access_token : Api.access_token) : string =
|
(access_token : Api.access_token) : string =
|
||||||
let excerpt = Api.retrieve_law_excerpt access_token (fst id) in
|
let excerpt = Api.retrieve_law_excerpt access_token (fst id) in
|
||||||
let title = "#" ^ Api.get_law_excerpt_title excerpt in
|
let title = "#" ^ Api.get_law_excerpt_title excerpt in
|
||||||
@ -179,12 +181,12 @@ let include_legislative_text
|
|||||||
in
|
in
|
||||||
let to_insert = title ^ "\n\n" ^ String.concat "\n\n" articles in
|
let to_insert = title ^ "\n\n" ^ String.concat "\n\n" articles in
|
||||||
let pos = snd id in
|
let pos = snd id in
|
||||||
Utils.Cli.debug_format "Position: %s" (Utils.Pos.to_string_short pos);
|
Cli.debug_format "Position: %s" (Pos.to_string_short pos);
|
||||||
let file = Utils.Pos.get_file pos in
|
let file = Pos.get_file pos in
|
||||||
let include_line = Utils.Pos.get_end_line pos in
|
let include_line = Pos.get_end_line pos in
|
||||||
let ic = open_in file in
|
let ic = open_in file in
|
||||||
let new_file = file ^ ".new" 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;
|
"LégiFrance inclusion detected, writing new contents to %s" new_file;
|
||||||
let oc = open_out new_file in
|
let oc = open_out new_file in
|
||||||
(* Pos.t lines start at 1 *)
|
(* Pos.t lines start at 1 *)
|
||||||
@ -258,7 +260,7 @@ let driver
|
|||||||
(client_id : string)
|
(client_id : string)
|
||||||
(client_secret : string) =
|
(client_secret : string) =
|
||||||
try
|
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
|
let access_token = Api.get_token client_id client_secret in
|
||||||
(* LégiFrance is only supported for French texts *)
|
(* LégiFrance is only supported for French texts *)
|
||||||
let program =
|
let program =
|
||||||
@ -276,9 +278,9 @@ let driver
|
|||||||
item))
|
item))
|
||||||
program.program_items;
|
program.program_items;
|
||||||
0
|
0
|
||||||
with Utils.Errors.StructuredError (msg, pos) ->
|
with Errors.StructuredError (msg, pos) ->
|
||||||
let bt = Printexc.get_raw_backtrace () in
|
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;
|
if Printexc.backtrace_status () then Printexc.print_raw_backtrace stderr bt;
|
||||||
-1
|
-1
|
||||||
|
|
||||||
@ -286,4 +288,4 @@ let driver
|
|||||||
let _ =
|
let _ =
|
||||||
Stdlib.exit
|
Stdlib.exit
|
||||||
@@ Cmdliner.Cmd.eval'
|
@@ Cmdliner.Cmd.eval'
|
||||||
(Cmdliner.Cmd.v Cli.info (Cli.catala_legifrance_t driver))
|
(Cmdliner.Cmd.v Cli.info (Legifrance_cli.catala_legifrance_t driver))
|
||||||
|
@ -14,6 +14,8 @@
|
|||||||
License for the specific language governing permissions and limitations under
|
License for the specific language governing permissions and limitations under
|
||||||
the License. *)
|
the License. *)
|
||||||
|
|
||||||
|
open Catala_utils
|
||||||
|
|
||||||
(** Helper functions to interact with {!Unix.tm} dates *)
|
(** Helper functions to interact with {!Unix.tm} dates *)
|
||||||
|
|
||||||
type date_format = DDMMYYYY | ISO
|
type date_format = DDMMYYYY | ISO
|
||||||
@ -53,7 +55,7 @@ let parse_expiration_date (date_format : date_format) (expiration_date : string)
|
|||||||
Unix.tm_isdst = false;
|
Unix.tm_isdst = false;
|
||||||
})
|
})
|
||||||
with _ ->
|
with _ ->
|
||||||
Utils.Errors.raise_error "Error while parsing expiration date argument (%s)"
|
Errors.raise_error "Error while parsing expiration date argument (%s)"
|
||||||
expiration_date
|
expiration_date
|
||||||
|
|
||||||
(** Prints an [Unix.tm] under the ISO formatting [YYYY-MM-DD] *)
|
(** Prints an [Unix.tm] under the ISO formatting [YYYY-MM-DD] *)
|
||||||
|
@ -3,7 +3,7 @@
|
|||||||
(package catala_legifrance)
|
(package catala_legifrance)
|
||||||
(libraries
|
(libraries
|
||||||
catala.surface
|
catala.surface
|
||||||
catala.utils
|
catala.catala_utils
|
||||||
cmdliner
|
cmdliner
|
||||||
cohttp
|
cohttp
|
||||||
lwt
|
lwt
|
||||||
|
@ -17,6 +17,7 @@
|
|||||||
(** Command line arguments specification of [legifrance_catala] *)
|
(** Command line arguments specification of [legifrance_catala] *)
|
||||||
|
|
||||||
open Cmdliner
|
open Cmdliner
|
||||||
|
open Catala_utils
|
||||||
|
|
||||||
let file =
|
let file =
|
||||||
Arg.(
|
Arg.(
|
||||||
@ -96,4 +97,4 @@ let info =
|
|||||||
]
|
]
|
||||||
in
|
in
|
||||||
let exits = Cmd.Exit.defaults @ [Cmd.Exit.info ~doc:"on error" 1] 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
|
Loading…
Reference in New Issue
Block a user