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

refactor(compiler)!: merge Cli.frontend_lang and Cli.backend_lang into an unique variant

Browse Source
This commit is contained in:
EmileRolley 2021-05-26 21:18:18 +02:00
parent 0ffbb9b266
commit 2095ba8860
9 changed files with 53 additions and 62 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
src/catala/dcalc/print.ml
View File

@ -86,6 +86,7 @@ let rec format_typ (ctx : Ast.decl_ctx) (fmt : Format.formatter) (typ : typ Pos.
| TArray t1 -> Format.fprintf fmt "@[<hov 2>%a@ %a@]" format_base_type "array" format_typ t1
| TAny -> Format.fprintf fmt "any"
(* (EmileRolley) NOTE: seems to be factorizable with Lcalc.Print.format_lit. *)
let format_lit (fmt : Format.formatter) (l : lit Pos.marked) : unit =
match Pos.unmark l with
| LBool b -> Format.fprintf fmt "%b" b
@ -97,9 +98,9 @@ let format_lit (fmt : Format.formatter) (l : lit Pos.marked) : unit =
(Runtime.decimal_to_string ~max_prec_digits:!Utils.Cli.max_prec_digits i)
| LMoney e -> (
match !Utils.Cli.locale_lang with
| `En -> Format.fprintf fmt "$%s" (Runtime.money_to_string e)
| `Fr -> Format.fprintf fmt "%s €" (Runtime.money_to_string e)
| `Pl -> Format.fprintf fmt "%s PLN" (Runtime.money_to_string e))
| En -> Format.fprintf fmt "$%s" (Runtime.money_to_string e)
| Fr -> Format.fprintf fmt "%s €" (Runtime.money_to_string e)
| Pl -> Format.fprintf fmt "%s PLN" (Runtime.money_to_string e))
| LDate d -> Format.fprintf fmt "%s" (Runtime.date_to_string d)
| LDuration d -> Format.fprintf fmt "%s" (Runtime.duration_to_string d)

7
src/catala/driver.ml
View File

@ -16,8 +16,8 @@ module Cli = Utils.Cli
module Errors = Utils.Errors
module Pos = Utils.Pos
(** Associates a {!type: Cli.frontend_lang} with its string represtation. *)
let languages = [ ("en", `En); ("fr", `Fr); ("pl", `Pl) ]
(** Associates a {!type: Cli.backend_lang} with its string represtation. *)
let languages = [ ("en", Cli.En); ("fr", Cli.Fr); ("pl", Cli.Pl) ]
(** Associates a file extension with its corresponding {!type: Cli.frontend_lang} string
representation. *)
@ -58,7 +58,7 @@ let driver (source_file : Pos.input_file) (debug : bool) (dcalc : bool) (unstyle
Errors.raise_error
(Printf.sprintf "The selected language (%s) is not supported by Catala" l)
in
Cli.locale_lang := Cli.to_backend_lang language;
Cli.locale_lang := language;
let backend =
let backend = String.lowercase_ascii backend in
if backend = "makefile" then Cli.Makefile
@ -97,7 +97,6 @@ let driver (source_file : Pos.input_file) (debug : bool) (dcalc : bool) (unstyle
(String.concat "\\\n" program.program_source_files);
0
| Cli.Latex | Cli.Html ->
let language : Cli.backend_lang = Cli.to_backend_lang language in
let source_file =
match source_file with
| FileName f -> f

7
src/catala/lcalc/print.ml
View File

@ -27,6 +27,7 @@ let begins_with_uppercase (s : string) : bool =
let first_letter = CamomileLibraryDefault.Camomile.UTF8.get s 0 in
is_uppercase first_letter
(* (EmileRolley) NOTE: seems to be factorizable with Dcalc.Print.format_lit. *)
let format_lit (fmt : Format.formatter) (l : lit Pos.marked) : unit =
match Pos.unmark l with
| LBool b -> Format.fprintf fmt "%b" b
@ -37,9 +38,9 @@ let format_lit (fmt : Format.formatter) (l : lit Pos.marked) : unit =
(Runtime.decimal_to_string ~max_prec_digits:!Utils.Cli.max_prec_digits i)
| LMoney e -> (
match !Utils.Cli.locale_lang with
| `En -> Format.fprintf fmt "$%s" (Runtime.money_to_string e)
| `Fr -> Format.fprintf fmt "%s €" (Runtime.money_to_string e)
| `Pl -> Format.fprintf fmt "%s PLN" (Runtime.money_to_string e))
| En -> Format.fprintf fmt "$%s" (Runtime.money_to_string e)
| Fr -> Format.fprintf fmt "%s €" (Runtime.money_to_string e)
| Pl -> Format.fprintf fmt "%s PLN" (Runtime.money_to_string e))
| LDate d -> Format.fprintf fmt "%s" (Runtime.date_to_string d)
| LDuration d -> Format.fprintf fmt "%s" (Runtime.duration_to_string d)

28
src/catala/literate/html.ml
View File

@ -70,18 +70,18 @@ let wrap_html (source_files : string list) (language : Cli.backend_lang) (fmt :
</ul>\n"
css_as_string
(match language with
| `Fr -> "Implémentation de texte législatif"
| `En -> "Legislative text implementation"
| `Pl -> "Implementacja tekstu legislacyjnego")
| Fr -> "Implémentation de texte législatif"
| En -> "Legislative text implementation"
| Pl -> "Implementacja tekstów legislacyjnych")
(match language with
| `Fr -> "Document généré par"
| `En -> "Document generated by"
| `Pl -> "Dokument wygenerowany przez")
| Fr -> "Document généré par"
| En -> "Document generated by"
| Pl -> "Dokument wygenerowany przez")
Utils.Cli.version
(match language with
| `Fr -> "Fichiers sources tissés dans ce document"
| `En -> "Source files weaved in this document"
| `Pl -> "Pliki źródłowe w tym dokumencie")
| Fr -> "Fichiers sources tissés dans ce document"
| En -> "Source files weaved in this document"
| Pl -> "Pliki źródłowe w tym dokumencie")
(String.concat "\n"
(List.map
(fun filename ->
@ -94,9 +94,9 @@ let wrap_html (source_files : string list) (language : Cli.backend_lang) (fmt :
Printf.sprintf "<li><tt>%s</tt>, %s %s</li>"
(pre_html (Filename.basename filename))
(match language with
| `Fr -> "dernière modification le"
| `En -> "last modification"
| `Pl -> "ostatnia modyfikacja")
| Fr -> "dernière modification le"
| En -> "last modification"
| Pl -> "ostatnia modyfikacja")
ftime)
source_files));
wrapped fmt
@ -111,7 +111,7 @@ let pygmentize_code (c : string Pos.marked) (language : C.backend_lang) : string
close_out oc;
let pygments = "pygmentize" in
let pygments_lexer =
match language with `Fr -> "catala_fr" | `En -> "catala_en" | `Pl -> "catala_pl"
match language with Fr -> "catala_fr" | En -> "catala_en" | Pl -> "catala_pl"
in
let pygments_args =
[|
@ -167,7 +167,7 @@ let rec law_structure_to_html (language : C.backend_lang) (fmt : Format.formatte
let h_number = heading.law_heading_precedence + 1 in
Format.fprintf fmt "<h%d class='law-heading'><a href='%s'>%s</a></h%d>\n" h_number
(match (heading.law_heading_id, language) with
| Some id, `Fr ->
| Some id, Fr ->
let ltime = Unix.localtime (Unix.time ()) in
P.sprintf "https://legifrance.gouv.fr/codes/id/%s/%d-%02d-%02d" id
(1900 + ltime.Unix.tm_year) (ltime.Unix.tm_mon + 1) ltime.Unix.tm_mday

32
src/catala/literate/latex.ml
View File

@ -80,20 +80,20 @@ let wrap_latex (source_files : string list) (language : C.backend_lang) (fmt : F
%s : \n\
\\begin{itemize}%s\\end{itemize}\n\n\
\\[\\star\\star\\star\\]\\\\\n"
(match language with `Fr -> "french" | `En -> "english" | `Pl -> "polish")
(match language with Fr -> "french" | En -> "english" | Pl -> "polish")
(match language with
| `Fr -> "Implémentation de texte législatif"
| `En -> "Legislative text implementation"
| `Pl -> "Implementacja tekstów legislacyjnych")
| Fr -> "Implémentation de texte législatif"
| En -> "Legislative text implementation"
| Pl -> "Implementacja tekstów legislacyjnych")
(match language with
| `Fr -> "Document généré par"
| `En -> "Document generated by"
| `Pl -> "Dokument wygenerowany przez")
| Fr -> "Document généré par"
| En -> "Document generated by"
| Pl -> "Dokument wygenerowany przez")
Utils.Cli.version
(match language with
| `Fr -> "Fichiers sources tissés dans ce document"
| `En -> "Source files weaved in this document"
| `Pl -> "Pliki źródłowe w tym dokumencie")
| Fr -> "Fichiers sources tissés dans ce document"
| En -> "Source files weaved in this document"
| Pl -> "Pliki źródłowe w tym dokumencie")
(String.concat ","
(List.map
(fun filename ->
@ -106,9 +106,9 @@ let wrap_latex (source_files : string list) (language : C.backend_lang) (fmt : F
Printf.sprintf "\\item\\texttt{%s}, %s %s"
(pre_latexify (Filename.basename filename))
(match language with
| `Fr -> "dernière modification le"
| `En -> "last modification"
| `Pl -> "ostatnia modyfikacja")
| Fr -> "dernière modification le"
| En -> "last modification"
| Pl -> "ostatnia modyfikacja")
ftime)
source_files));
wrapped fmt;
@ -165,11 +165,11 @@ let rec law_structure_to_latex (language : C.backend_lang) (fmt : Format.formatt
\\end{minted}"
(pre_latexify (Filename.basename (Pos.get_file (Pos.get_position c))))
(Pos.get_start_line (Pos.get_position c) - 1)
(match language with `Fr -> "catala_fr" | `En -> "catala_en" | `Pl -> "catala_pl")
(match language with Fr -> "catala_fr" | En -> "catala_en" | Pl -> "catala_pl")
(math_syms_replace (Pos.unmark c))
| A.CodeBlock (_, c, true) ->
let metadata_title =
match language with `Fr -> "Métadonnées" | `En -> "Metadata" | `Pl -> "Metadane"
match language with Fr -> "Métadonnées" | En -> "Metadata" | Pl -> "Metadane"
in
Format.fprintf fmt
"\\begin{tcolorbox}[colframe=OliveGreen, breakable, \
@ -182,7 +182,7 @@ let rec law_structure_to_latex (language : C.backend_lang) (fmt : Format.formatt
metadata_title metadata_title
(Pos.get_start_line (Pos.get_position c) - 1)
(pre_latexify (Filename.basename (Pos.get_file (Pos.get_position c))))
(match language with `Fr -> "catala_fr" | `En -> "catala_en" | `Pl -> "catala_pl")
(match language with Fr -> "catala_fr" | En -> "catala_en" | Pl -> "catala_pl")
(math_syms_replace (Pos.unmark c))
(** {1 API} *)

16
src/catala/surface/parser_driver.ml
View File

@ -226,16 +226,16 @@ module Parser_En = ParserAux (Lexer_en)
module Parser_Fr = ParserAux (Lexer_fr)
module Parser_Pl = ParserAux (Lexer_pl)
let localised_parser : Cli.frontend_lang -> lexbuf -> Ast.source_file = function
| `En -> Parser_En.commands_or_includes
| `Fr -> Parser_Fr.commands_or_includes
| `Pl -> Parser_Pl.commands_or_includes
let localised_parser : Cli.backend_lang -> lexbuf -> Ast.source_file = function
| En -> Parser_En.commands_or_includes
| Fr -> Parser_Fr.commands_or_includes
| Pl -> Parser_Pl.commands_or_includes
(** {1 Parsing multiple files} *)
(** Parses a single source file *)
let rec parse_source_file (source_file : Pos.input_file) (language : Cli.frontend_lang) :
Ast.program =
let rec parse_source_file (source_file : Pos.input_file) (language : Cli.backend_lang) : Ast.program
=
Cli.debug_print
(Printf.sprintf "Parsing %s" (match source_file with FileName s | Contents s -> s));
let lexbuf, input =
@ -260,7 +260,7 @@ let rec parse_source_file (source_file : Pos.input_file) (language : Cli.fronten
(** Expands the include directives in a parsing result, thus parsing new source files *)
and expand_includes (source_file : string) (commands : Ast.law_structure list)
(language : Cli.frontend_lang) : Ast.program =
(language : Cli.backend_lang) : Ast.program =
List.fold_left
(fun acc command ->
match command with
@ -287,7 +287,7 @@ and expand_includes (source_file : string) (commands : Ast.law_structure list)
(** {1 API} *)
let parse_top_level_file (source_file : Pos.input_file) (language : Cli.frontend_lang) : Ast.program
let parse_top_level_file (source_file : Pos.input_file) (language : Cli.backend_lang) : Ast.program
=
let program = parse_source_file source_file language in
{ program with Ast.program_items = law_struct_list_to_tree program.Ast.program_items }

2
src/catala/surface/parser_driver.mli
View File

@ -16,4 +16,4 @@
open Utils
val parse_top_level_file : Pos.input_file -> Cli.frontend_lang -> Ast.program
val parse_top_level_file : Pos.input_file -> Cli.backend_lang -> Ast.program

10
src/catala/utils/cli.ml
View File

@ -12,18 +12,12 @@
or implied. See the License for the specific language governing permissions and limitations under
the License. *)
(* TODO: Factorize frontend_lang and backend_lang into a unique algebric type. *)
type frontend_lang = [ `Fr | `En | `Pl ]
type backend_lang = [ `Fr | `En | `Pl ]
let to_backend_lang (lang : frontend_lang) : backend_lang =
match lang with `En -> `En | `Fr -> `Fr | `Pl -> `Pl
type backend_lang = En | Fr | Pl
(** Source files to be compiled *)
let source_files : string list ref = ref []
let locale_lang : backend_lang ref = ref `En
let locale_lang : backend_lang ref = ref En
let contents : string ref = ref ""

6
src/catala/utils/cli.mli
View File

@ -12,11 +12,7 @@
or implied. See the License for the specific language governing permissions and limitations under
the License. *)
type frontend_lang = [ `En | `Fr | `Pl ]
type backend_lang = [ `En | `Fr | `Pl ]
val to_backend_lang : frontend_lang -> backend_lang
type backend_lang = En | Fr | Pl
(** {2 Configuration globals} *)