mirror of
https://github.com/CatalaLang/catala.git
synced 2024-11-08 07:51:43 +03:00
Working the way into the Python backend
This commit is contained in:
Denis Merigoux
parent
9ab32efcce
commit
fffd0ffb63
15
Makefile
15
Makefile
@ -181,14 +181,20 @@ bench_js: run_french_law_library_benchmark_js
|
||||
|
||||
FRENCH_LAW_OCAML_LIB_DIR=french_law/ocaml
|
||||
FRENCH_LAW_JS_LIB_DIR=french_law/js
|
||||
FRENCH_LAW_PYTHON_LIB_DIR=french_law/python
|
||||
|
||||
$(FRENCH_LAW_PYTHON_LIB_DIR)/allocations_familiales.py: .FORCE
|
||||
CATALA_OPTS="-O" $(MAKE) -C $(ALLOCATIONS_FAMILIALES_DIR) allocations_familiales.py
|
||||
cp -f $(ALLOCATIONS_FAMILIALES_DIR)/allocations_familiales.py \
|
||||
$(FRENCH_LAW_PYTHON_LIB_DIR)/
|
||||
|
||||
$(FRENCH_LAW_OCAML_LIB_DIR)/law_source/allocations_familiales.ml: .FORCE
|
||||
CATALA_OPTS="-O -t" $(MAKE) -C $(ALLOCATIONS_FAMILIALES_DIR) allocations_familiales.ml
|
||||
CATALA_OPTS="-O" $(MAKE) -C $(ALLOCATIONS_FAMILIALES_DIR) allocations_familiales.ml
|
||||
cp -f $(ALLOCATIONS_FAMILIALES_DIR)/allocations_familiales.ml \
|
||||
$(FRENCH_LAW_OCAML_LIB_DIR)/law_source
|
||||
|
||||
$(FRENCH_LAW_OCAML_LIB_DIR)/law_source/unit_tests/tests_allocations_familiales.ml: .FORCE
|
||||
CATALA_OPTS="-O -t" $(MAKE) -s -C $(ALLOCATIONS_FAMILIALES_DIR) tests/tests_allocations_familiales.ml
|
||||
CATALA_OPTS="-O" $(MAKE) -s -C $(ALLOCATIONS_FAMILIALES_DIR) tests/tests_allocations_familiales.ml
|
||||
cp -f $(ALLOCATIONS_FAMILIALES_DIR)/tests/tests_allocations_familiales.ml \
|
||||
$(FRENCH_LAW_OCAML_LIB_DIR)/law_source/unit_tests/
|
||||
|
||||
@ -216,6 +222,11 @@ build_french_law_library_js: generate_french_law_library_ocaml format
|
||||
dune build --profile release $(FRENCH_LAW_OCAML_LIB_DIR)/api_web.bc.js
|
||||
cp -f $(ROOT_DIR)/_build/default/$(FRENCH_LAW_OCAML_LIB_DIR)/api_web.bc.js $(FRENCH_LAW_JS_LIB_DIR)/french_law.js
|
||||
|
||||
#> generate_french_law_library_python : Generates the French law library Python sources from Catala
|
||||
generate_french_law_library_ocaml:\
|
||||
$(FRENCH_LAW_PYTHON_LIB_DIR)/allocations_familiales.py
|
||||
|
||||
|
||||
##########################################
|
||||
# Website assets
|
||||
##########################################
|
||||
|
||||
@ -257,24 +257,29 @@ let driver (source_file : Pos.input_file) (debug : bool) (unstyled : bool)
|
||||
| Contents _ ->
|
||||
Errors.raise_error "This backend does not work if the input is not a file"
|
||||
in
|
||||
let output_file =
|
||||
let output_file (extension : string) : string =
|
||||
match output_file with
|
||||
| Some f -> f
|
||||
| None -> Filename.remove_extension source_file ^ ".ml"
|
||||
| None -> Filename.remove_extension source_file ^ extension
|
||||
in
|
||||
Cli.debug_print (Printf.sprintf "Writing to %s..." output_file);
|
||||
let oc = open_out output_file in
|
||||
let fmt = Format.formatter_of_out_channel oc in
|
||||
|
||||
(match backend with
|
||||
| Cli.OCaml ->
|
||||
let output_file = output_file ".ml" in
|
||||
Cli.debug_print (Printf.sprintf "Writing to %s..." output_file);
|
||||
let oc = open_out output_file in
|
||||
let fmt = Format.formatter_of_out_channel oc in
|
||||
Cli.debug_print "Compiling program into OCaml...";
|
||||
Lcalc.To_ocaml.format_program fmt prgm type_ordering
|
||||
Lcalc.To_ocaml.format_program fmt prgm type_ordering;
|
||||
close_out oc
|
||||
| Cli.Python ->
|
||||
let output_file = output_file ".py" in
|
||||
Cli.debug_print "Compiling program into Python...";
|
||||
Lcalc.To_python.format_program fmt prgm type_ordering
|
||||
Cli.debug_print (Printf.sprintf "Writing to %s..." output_file);
|
||||
let oc = open_out output_file in
|
||||
let fmt = Format.formatter_of_out_channel oc in
|
||||
Lcalc.To_python.format_program fmt prgm type_ordering;
|
||||
close_out oc
|
||||
| _ -> assert false (* should not happen *));
|
||||
close_out oc;
|
||||
0
|
||||
| _ -> assert false
|
||||
(* should not happen *))
|
||||
|
||||
@ -52,3 +52,22 @@ let to_lowercase (s : string) : string =
|
||||
is_first := false)
|
||||
s;
|
||||
!out
|
||||
|
||||
let to_uppercase (s : string) : string =
|
||||
let last_was_underscore = ref false in
|
||||
let is_first = ref true in
|
||||
let out = ref "" in
|
||||
CamomileLibraryDefault.Camomile.UTF8.iter
|
||||
(fun c ->
|
||||
let is_underscore = c = CamomileLibraryDefault.Camomile.UChar.of_char '_' in
|
||||
let c_string = String.make 1 (CamomileLibraryDefault.Camomile.UChar.char_of c) in
|
||||
out :=
|
||||
!out
|
||||
^
|
||||
if is_underscore then ""
|
||||
else if !last_was_underscore || !is_first then String.uppercase_ascii c_string
|
||||
else c_string;
|
||||
last_was_underscore := is_underscore;
|
||||
is_first := false)
|
||||
s;
|
||||
!out
|
||||
|
||||
@ -18,3 +18,6 @@ val to_ascii : string -> string
|
||||
|
||||
val to_lowercase : string -> string
|
||||
(** Converts CamlCase into snake_case *)
|
||||
|
||||
val to_uppercase : string -> string
|
||||
(** Convertes snake_case into CamlCase *)
|
||||
|
||||
@ -20,26 +20,22 @@ module D = Dcalc.Ast
|
||||
let format_lit (fmt : Format.formatter) (l : lit Pos.marked) : unit =
|
||||
match Pos.unmark l with
|
||||
| LBool b -> Dcalc.Print.format_lit fmt (Pos.same_pos_as (Dcalc.Ast.LBool b) l)
|
||||
| LInt i -> Format.fprintf fmt "integer_of_string@ \"%s\"" (Runtime.integer_to_string i)
|
||||
| LUnit -> Dcalc.Print.format_lit fmt (Pos.same_pos_as Dcalc.Ast.LUnit l)
|
||||
| LInt i -> Format.fprintf fmt "integer_of_string(\"%s\")" (Runtime.integer_to_string i)
|
||||
| LUnit -> Format.fprintf fmt "Unit()"
|
||||
| LRat i ->
|
||||
Format.fprintf fmt "decimal_of_string \"%a\"" Dcalc.Print.format_lit
|
||||
Format.fprintf fmt "decimal_of_string(\"%a\")" Dcalc.Print.format_lit
|
||||
(Pos.same_pos_as (Dcalc.Ast.LRat i) l)
|
||||
| LMoney e ->
|
||||
Format.fprintf fmt "money_of_cents_string@ \"%s\""
|
||||
Format.fprintf fmt "money_of_cents_string(\"%s\")"
|
||||
(Runtime.integer_to_string (Runtime.money_to_cents e))
|
||||
| LDate d ->
|
||||
Format.fprintf fmt "date_of_numbers %d %d %d"
|
||||
Format.fprintf fmt "date_of_numbers(%d,%d,%d)"
|
||||
(Runtime.integer_to_int (Runtime.year_of_date d))
|
||||
(Runtime.integer_to_int (Runtime.month_number_of_date d))
|
||||
(Runtime.integer_to_int (Runtime.day_of_month_of_date d))
|
||||
| LDuration d ->
|
||||
let years, months, days = Runtime.duration_to_years_months_days d in
|
||||
Format.fprintf fmt "duration_of_numbers %d %d %d" years months days
|
||||
|
||||
let format_op_kind (fmt : Format.formatter) (k : Dcalc.Ast.op_kind) =
|
||||
Format.fprintf fmt "%s"
|
||||
(match k with KInt -> "!" | KRat -> "&" | KMoney -> "$" | KDate -> "@" | KDuration -> "^")
|
||||
Format.fprintf fmt "duration_of_numbers(%d,%d,%d)" years months days
|
||||
|
||||
let format_log_entry (fmt : Format.formatter) (entry : Dcalc.Ast.log_entry) : unit =
|
||||
match entry with
|
||||
@ -50,18 +46,19 @@ let format_log_entry (fmt : Format.formatter) (entry : Dcalc.Ast.log_entry) : un
|
||||
|
||||
let format_binop (fmt : Format.formatter) (op : Dcalc.Ast.binop Pos.marked) : unit =
|
||||
match Pos.unmark op with
|
||||
| Add k -> Format.fprintf fmt "+%a" format_op_kind k
|
||||
| Sub k -> Format.fprintf fmt "-%a" format_op_kind k
|
||||
| Mult k -> Format.fprintf fmt "*%a" format_op_kind k
|
||||
| Div k -> Format.fprintf fmt "/%a" format_op_kind k
|
||||
| And -> Format.fprintf fmt "%s" "&&"
|
||||
| Or -> Format.fprintf fmt "%s" "||"
|
||||
| Eq -> Format.fprintf fmt "%s" "="
|
||||
| Neq | Xor -> Format.fprintf fmt "%s" "<>"
|
||||
| Lt k -> Format.fprintf fmt "%s%a" "<" format_op_kind k
|
||||
| Lte k -> Format.fprintf fmt "%s%a" "<=" format_op_kind k
|
||||
| Gt k -> Format.fprintf fmt "%s%a" ">" format_op_kind k
|
||||
| Gte k -> Format.fprintf fmt "%s%a" ">=" format_op_kind k
|
||||
| Add _ -> Format.fprintf fmt "+"
|
||||
| Sub _ -> Format.fprintf fmt "-"
|
||||
| Mult _ -> Format.fprintf fmt "*"
|
||||
| Div D.KInt -> Format.fprintf fmt "//"
|
||||
| Div _ -> Format.fprintf fmt "/"
|
||||
| And -> Format.fprintf fmt "and"
|
||||
| Or -> Format.fprintf fmt "or"
|
||||
| Eq -> Format.fprintf fmt "=="
|
||||
| Neq | Xor -> Format.fprintf fmt "!="
|
||||
| Lt _ -> Format.fprintf fmt "<"
|
||||
| Lte _ -> Format.fprintf fmt "<="
|
||||
| Gt _ -> Format.fprintf fmt ">"
|
||||
| Gte _ -> Format.fprintf fmt ">="
|
||||
| Map -> Format.fprintf fmt "Array.map"
|
||||
| Filter -> Format.fprintf fmt "array_filter"
|
||||
|
||||
@ -84,8 +81,8 @@ let format_string_list (fmt : Format.formatter) (uids : string list) : unit =
|
||||
|
||||
let format_unop (fmt : Format.formatter) (op : Dcalc.Ast.unop Pos.marked) : unit =
|
||||
match Pos.unmark op with
|
||||
| Minus k -> Format.fprintf fmt "~-%a" format_op_kind k
|
||||
| Not -> Format.fprintf fmt "%s" "not"
|
||||
| Minus _ -> Format.fprintf fmt "-"
|
||||
| Not -> Format.fprintf fmt "not"
|
||||
| Log (entry, infos) ->
|
||||
Format.fprintf fmt "@[<hov 2>log_entry@ \"%a|%a\"@]" format_log_entry entry format_uid_list
|
||||
infos
|
||||
@ -98,13 +95,11 @@ let format_unop (fmt : Format.formatter) (op : Dcalc.Ast.unop Pos.marked) : unit
|
||||
let avoid_keywords (s : string) : string =
|
||||
if
|
||||
match s with
|
||||
(* list taken from http://caml.inria.fr/pub/docs/manual-ocaml/lex.html#sss:keywords *)
|
||||
| "and" | "as" | "assert" | "asr" | "begin" | "class" | "constraint" | "do" | "done" | "downto"
|
||||
| "else" | "end" | "exception" | "external" | "false" | "for" | "fun" | "function" | "functor"
|
||||
| "if" | "in" | "include" | "inherit" | "initializer" | "land" | "lazy" | "let" | "lor" | "lsl"
|
||||
| "lsr" | "lxor" | "match" | "method" | "mod" | "module" | "mutable" | "new" | "nonrec"
|
||||
| "object" | "of" | "open" | "or" | "private" | "rec" | "sig" | "struct" | "then" | "to"
|
||||
| "true" | "try" | "type" | "val" | "virtual" | "when" | "while" | "with" ->
|
||||
(* list taken from https://www.programiz.com/python-programming/keyword-list *)
|
||||
| "False" | "None" | "True" | "and" | "as" | "assert" | "async" | "await" | "break" | "class"
|
||||
| "continue" | "def" | "del" | "elif" | "else" | "except" | "finally" | "for" | "from"
|
||||
| "global" | "if" | "import" | "in" | "is" | "lambda" | "nonlocal" | "not" | "or" | "pass"
|
||||
| "raise" | "return" | "try" | "while" | "with" | "yield" ->
|
||||
true
|
||||
| _ -> false
|
||||
then s ^ "_"
|
||||
@ -113,7 +108,7 @@ let avoid_keywords (s : string) : string =
|
||||
let format_struct_name (fmt : Format.formatter) (v : Dcalc.Ast.StructName.t) : unit =
|
||||
Format.fprintf fmt "%s"
|
||||
(avoid_keywords
|
||||
(to_lowercase (to_ascii (Format.asprintf "%a" Dcalc.Ast.StructName.format_t v))))
|
||||
(to_uppercase (to_ascii (Format.asprintf "%a" Dcalc.Ast.StructName.format_t v))))
|
||||
|
||||
let format_struct_field_name (fmt : Format.formatter) (v : Dcalc.Ast.StructFieldName.t) : unit =
|
||||
Format.fprintf fmt "%s"
|
||||
@ -121,7 +116,7 @@ let format_struct_field_name (fmt : Format.formatter) (v : Dcalc.Ast.StructField
|
||||
|
||||
let format_enum_name (fmt : Format.formatter) (v : Dcalc.Ast.EnumName.t) : unit =
|
||||
Format.fprintf fmt "%s"
|
||||
(avoid_keywords (to_lowercase (to_ascii (Format.asprintf "%a" Dcalc.Ast.EnumName.format_t v))))
|
||||
(avoid_keywords (to_uppercase (to_ascii (Format.asprintf "%a" Dcalc.Ast.EnumName.format_t v))))
|
||||
|
||||
let format_enum_cons_name (fmt : Format.formatter) (v : Dcalc.Ast.EnumConstructor.t) : unit =
|
||||
Format.fprintf fmt "%s"
|
||||
@ -151,18 +146,24 @@ let rec format_typ (fmt : Format.formatter) (typ : Dcalc.Ast.typ Pos.marked) : u
|
||||
else Format.fprintf fmt "%a" format_typ t
|
||||
in
|
||||
match Pos.unmark typ with
|
||||
| TLit l -> Format.fprintf fmt "%a" Dcalc.Print.format_tlit l
|
||||
| TLit TUnit -> Format.fprintf fmt "Unit"
|
||||
| TLit TMoney -> Format.fprintf fmt "Money"
|
||||
| TLit TInt -> Format.fprintf fmt "Integer"
|
||||
| TLit TRat -> Format.fprintf fmt "Decimal"
|
||||
| TLit TDate -> Format.fprintf fmt "Date"
|
||||
| TLit TDuration -> Format.fprintf fmt "Duration"
|
||||
| TLit TBool -> Format.fprintf fmt "bool"
|
||||
| TTuple (ts, None) ->
|
||||
Format.fprintf fmt "@[<hov 2>(%a)@]"
|
||||
Format.fprintf fmt "Tuple[%a]"
|
||||
(Format.pp_print_list
|
||||
~pp_sep:(fun fmt () -> Format.fprintf fmt "@ *@ ")
|
||||
~pp_sep:(fun fmt () -> Format.fprintf fmt ", ")
|
||||
(fun fmt t -> Format.fprintf fmt "%a" format_typ_with_parens t))
|
||||
ts
|
||||
| TTuple (_, Some s) -> Format.fprintf fmt "%a" format_struct_name s
|
||||
| TEnum (_, e) -> Format.fprintf fmt "%a" format_enum_name e
|
||||
| TArrow (t1, t2) ->
|
||||
Format.fprintf fmt "@[<hov 2>%a ->@ %a@]" format_typ_with_parens t1 format_typ_with_parens t2
|
||||
| TArray t1 -> Format.fprintf fmt "@[%a@ array@]" format_typ_with_parens t1
|
||||
Format.fprintf fmt "Callable[[%a], %a]" format_typ_with_parens t1 format_typ_with_parens t2
|
||||
| TArray t1 -> Format.fprintf fmt "List[%a]" format_typ_with_parens t1
|
||||
| TAny -> Format.fprintf fmt "_"
|
||||
|
||||
let format_var (fmt : Format.formatter) (v : Var.t) : unit =
|
||||
@ -189,8 +190,8 @@ let format_exception (fmt : Format.formatter) (exc : except Pos.marked) : unit =
|
||||
| NoValueProvided ->
|
||||
let pos = Pos.get_position exc in
|
||||
Format.fprintf fmt
|
||||
"(NoValueProvided@ @[<hov 2>{filename = \"%s\";@ start_line=%d;@ start_column=%d;@ \
|
||||
end_line=%d; end_column=%d;@ law_headings=%a}@])"
|
||||
"NoValueProvided(SourcePosition(filename = \"%s\",@ start_line=%d,@ start_column=%d,@ \
|
||||
end_line=%d,@ end_column=%d,@ law_headings=%a))"
|
||||
(Pos.get_file pos) (Pos.get_start_line pos) (Pos.get_start_column pos)
|
||||
(Pos.get_end_line pos) (Pos.get_end_column pos) format_string_list (Pos.get_law_info pos)
|
||||
|
||||
@ -268,18 +269,15 @@ let rec format_expr (ctx : Dcalc.Ast.decl_ctx) (fmt : Format.formatter) (e : exp
|
||||
Format.fprintf fmt "%a%a"
|
||||
(Format.pp_print_list
|
||||
~pp_sep:(fun fmt () -> Format.fprintf fmt "")
|
||||
(fun fmt (x, tau, arg) ->
|
||||
Format.fprintf fmt "@[<hov 2>let@ %a@ :@ %a@ =@ %a@]@ in@\n" format_var x format_typ
|
||||
tau format_with_parens arg))
|
||||
(fun fmt (x, _, arg) -> Format.fprintf fmt "%a = %a@\n" format_var x format_expr arg))
|
||||
xs_tau_arg format_with_parens body
|
||||
| EAbs ((binder, _), taus) ->
|
||||
let xs, body = Bindlib.unmbind binder in
|
||||
let xs_tau = List.map2 (fun x tau -> (x, tau)) (Array.to_list xs) taus in
|
||||
Format.fprintf fmt "@[<hov 2>fun@ %a ->@ %a@]"
|
||||
Format.fprintf fmt "@[<hov 4>lambda %a:@ %a@]"
|
||||
(Format.pp_print_list
|
||||
~pp_sep:(fun fmt () -> Format.fprintf fmt "@ ")
|
||||
(fun fmt (x, tau) ->
|
||||
Format.fprintf fmt "@[<hov 2>(%a:@ %a)@]" format_var x format_typ tau))
|
||||
~pp_sep:(fun fmt () -> Format.fprintf fmt ", ")
|
||||
(fun fmt (x, _) -> Format.fprintf fmt "%a" format_var x))
|
||||
xs_tau format_expr body
|
||||
| EApp ((EOp (Binop ((Dcalc.Ast.Map | Dcalc.Ast.Filter) as op)), _), [ arg1; arg2 ]) ->
|
||||
Format.fprintf fmt "@[<hov 2>%a@ %a@ %a@]" format_binop (op, Pos.no_pos) format_with_parens
|
||||
@ -307,88 +305,60 @@ let rec format_expr (ctx : Dcalc.Ast.decl_ctx) (fmt : Format.formatter) (e : exp
|
||||
| EApp ((EOp (Unop op), _), [ arg1 ]) ->
|
||||
Format.fprintf fmt "@[<hov 2>%a@ %a@]" format_unop (op, Pos.no_pos) format_with_parens arg1
|
||||
| EApp (f, args) ->
|
||||
Format.fprintf fmt "@[<hov 2>%a@ %a@]" format_with_parens f
|
||||
(Format.pp_print_list ~pp_sep:(fun fmt () -> Format.fprintf fmt "@ ") format_with_parens)
|
||||
Format.fprintf fmt "@[<hov 4>%a(%a)@]" format_with_parens f
|
||||
(Format.pp_print_list ~pp_sep:(fun fmt () -> Format.fprintf fmt ",@ ") format_expr)
|
||||
args
|
||||
| EIfThenElse (e1, e2, e3) ->
|
||||
Format.fprintf fmt "@[<hov 2> if@ @[<hov 2>%a@]@ then@ @[<hov 2>%a@]@ else@ @[<hov 2>%a@]@]"
|
||||
format_with_parens e1 format_with_parens e2 format_with_parens e3
|
||||
Format.fprintf fmt "@[<hov 4>%a@ if@ %a@ else@ %a@]" format_with_parens e2 format_with_parens
|
||||
e1 format_with_parens e3
|
||||
| EOp (Ternop op) -> Format.fprintf fmt "%a" format_ternop (op, Pos.no_pos)
|
||||
| EOp (Binop op) -> Format.fprintf fmt "%a" format_binop (op, Pos.no_pos)
|
||||
| EOp (Unop op) -> Format.fprintf fmt "%a" format_unop (op, Pos.no_pos)
|
||||
| EAssert e' ->
|
||||
Format.fprintf fmt "@[<hov 2>if @ %a@ then@ ()@ else@ raise AssertionFailed@]"
|
||||
format_with_parens e'
|
||||
| ERaise exc -> Format.fprintf fmt "raise@ %a" format_exception (exc, Pos.get_position e)
|
||||
| ERaise exc -> Format.fprintf fmt "raise_(%a)" format_exception (exc, Pos.get_position e)
|
||||
| ECatch (e1, exc, e2) ->
|
||||
Format.fprintf fmt "@[<hov 2>try@ %a@ with@ %a@ ->@ %a@]" format_with_parens e1
|
||||
Format.fprintf fmt "@[<hov 4>TryCatch(%a).rescue(%a,@ lambda _: %a)@]" format_expr e1
|
||||
format_exception
|
||||
(exc, Pos.get_position e)
|
||||
format_with_parens e2
|
||||
|
||||
let format_struct_embedding (fmt : Format.formatter)
|
||||
((struct_name, struct_fields) : D.StructName.t * (D.StructFieldName.t * D.typ Pos.marked) list)
|
||||
=
|
||||
if List.length struct_fields = 0 then
|
||||
Format.fprintf fmt "let embed_%a (_: %a) : runtime_value = Unit@\n@\n" format_struct_name
|
||||
struct_name format_struct_name struct_name
|
||||
else
|
||||
Format.fprintf fmt
|
||||
"@[<hov 2>let embed_%a (x: %a) : runtime_value =@ Struct([\"%a\"],@ @[<hov 2>[%a]@])@]@\n@\n"
|
||||
format_struct_name struct_name format_struct_name struct_name D.StructName.format_t
|
||||
struct_name
|
||||
(Format.pp_print_list
|
||||
~pp_sep:(fun fmt () -> Format.fprintf fmt ";@\n")
|
||||
(fun _fmt (struct_field, struct_field_type) ->
|
||||
Format.fprintf fmt "(\"%a\",@ %a@ x.%a)" D.StructFieldName.format_t struct_field
|
||||
typ_embedding_name struct_field_type format_struct_field_name struct_field))
|
||||
struct_fields
|
||||
|
||||
let format_enum_embedding (fmt : Format.formatter)
|
||||
((enum_name, enum_cases) : D.EnumName.t * (D.EnumConstructor.t * D.typ Pos.marked) list) =
|
||||
if List.length enum_cases = 0 then
|
||||
Format.fprintf fmt "let embed_%a (_: %a) : runtime_value = Unit@\n@\n" format_enum_name
|
||||
enum_name format_enum_name enum_name
|
||||
else
|
||||
Format.fprintf fmt
|
||||
"@[<hov 2>let embed_%a (x: %a) : runtime_value =@ Enum([\"%a\"],@ @[<hov 2>match x with@ \
|
||||
%a@])@]@\n\
|
||||
@\n"
|
||||
format_enum_name enum_name format_enum_name enum_name D.EnumName.format_t enum_name
|
||||
(Format.pp_print_list
|
||||
~pp_sep:(fun fmt () -> Format.fprintf fmt "@\n")
|
||||
(fun _fmt (enum_cons, enum_cons_type) ->
|
||||
Format.fprintf fmt "@[<hov 2>| %a x ->@ (\"%a\", %a x)@]" format_enum_cons_name enum_cons
|
||||
D.EnumConstructor.format_t enum_cons typ_embedding_name enum_cons_type))
|
||||
enum_cases
|
||||
|
||||
let format_ctx (type_ordering : Scopelang.Dependency.TVertex.t list) (fmt : Format.formatter)
|
||||
(ctx : D.decl_ctx) : unit =
|
||||
let format_struct_decl fmt (struct_name, struct_fields) =
|
||||
if List.length struct_fields = 0 then
|
||||
Format.fprintf fmt "type %a = unit@\n@\n" format_struct_name struct_name
|
||||
Format.fprintf fmt "class %a(Unit):@\n\tpass@\n@\n" format_struct_name struct_name
|
||||
else
|
||||
Format.fprintf fmt "type %a = {@\n@[<hov 2> %a@]@\n}@\n@\n" format_struct_name struct_name
|
||||
Format.fprintf fmt "class %a:@\n\tdef __init__(self, %a) -> None:@\n%a@\n@\n"
|
||||
format_struct_name struct_name
|
||||
(Format.pp_print_list
|
||||
~pp_sep:(fun fmt () -> Format.fprintf fmt ", ")
|
||||
(fun _fmt (struct_field, struct_field_type) ->
|
||||
Format.fprintf fmt "%a: %a" format_struct_field_name struct_field format_typ
|
||||
struct_field_type))
|
||||
struct_fields
|
||||
(Format.pp_print_list
|
||||
~pp_sep:(fun fmt () -> Format.fprintf fmt "@\n")
|
||||
(fun _fmt (struct_field, struct_field_type) ->
|
||||
Format.fprintf fmt "%a:@ %a;" format_struct_field_name struct_field format_typ
|
||||
struct_field_type))
|
||||
struct_fields;
|
||||
if !Cli.trace_flag then format_struct_embedding fmt (struct_name, struct_fields)
|
||||
(fun _fmt (struct_field, _) ->
|
||||
Format.fprintf fmt "\t\tself.%a = %a" format_struct_field_name struct_field
|
||||
format_struct_field_name struct_field))
|
||||
struct_fields
|
||||
in
|
||||
let format_enum_decl fmt (enum_name, enum_cons) =
|
||||
if List.length enum_cons = 0 then
|
||||
Format.fprintf fmt "type %a = unit@\n@\n" format_enum_name enum_name
|
||||
Format.fprintf fmt "class %a(Unit):@\n\tpass@\n@\n" format_enum_name enum_name
|
||||
else
|
||||
Format.fprintf fmt "type %a =@\n@[<hov 2> %a@]@\n@\n" format_enum_name enum_name
|
||||
Format.fprintf fmt "class %a:@\n\tpass@\n@\n%a" format_enum_name enum_name
|
||||
(Format.pp_print_list
|
||||
~pp_sep:(fun fmt () -> Format.fprintf fmt "@\n")
|
||||
~pp_sep:(fun fmt () -> Format.fprintf fmt "@\n@\n")
|
||||
(fun _fmt (enum_cons, enum_cons_type) ->
|
||||
Format.fprintf fmt "| %a@ of@ %a" format_enum_cons_name enum_cons format_typ
|
||||
enum_cons_type))
|
||||
enum_cons;
|
||||
if !Cli.trace_flag then format_enum_embedding fmt (enum_name, enum_cons)
|
||||
Format.fprintf fmt
|
||||
"class %a_%a(%a):@\n\
|
||||
\tdef __init__(self, value: %a) -> None:@\n\
|
||||
\t\tself.value = value" format_enum_name enum_name format_enum_cons_name enum_cons
|
||||
format_enum_name enum_name format_typ enum_cons_type))
|
||||
enum_cons
|
||||
in
|
||||
let is_in_type_ordering s =
|
||||
List.exists
|
||||
@ -421,7 +391,7 @@ let format_program (fmt : Format.formatter) (p : Ast.program)
|
||||
Format.fprintf fmt
|
||||
"# This file has been generated by the Catala compiler, do not edit!\n\
|
||||
@\n\
|
||||
from catala_runtime import *@\n\
|
||||
from .catala_runtime import *@\n\
|
||||
@\n\
|
||||
%a@\n\
|
||||
@\n\
|
||||
@ -430,5 +400,15 @@ let format_program (fmt : Format.formatter) (p : Ast.program)
|
||||
(Format.pp_print_list
|
||||
~pp_sep:(fun fmt () -> Format.fprintf fmt "@\n@\n")
|
||||
(fun fmt (name, e) ->
|
||||
Format.fprintf fmt "@[<hov 2>let@ %a@ =@ %a@]" format_var name (format_expr p.decl_ctx) e))
|
||||
match Pos.unmark e with
|
||||
| EAbs ((binder, _), typs) ->
|
||||
let vars, body = Bindlib.unmbind binder in
|
||||
let vars_and_typs = List.map2 (fun var typ -> (var, typ)) (Array.to_list vars) typs in
|
||||
Format.fprintf fmt "@[<hov 4>def %a(%a):@\n%a@]" format_var name
|
||||
(Format.pp_print_list
|
||||
~pp_sep:(fun fmt () -> Format.fprintf fmt ", ")
|
||||
(fun fmt (var, typ) -> Format.fprintf fmt "%a: %a" format_var var format_typ typ))
|
||||
vars_and_typs (format_expr p.decl_ctx) body
|
||||
| _ -> assert false
|
||||
(* should not happen*)))
|
||||
p.scopes
|
||||
|
||||
@ -29,6 +29,13 @@ help : ../Makefile.common.mk
|
||||
OCaml \
|
||||
$<
|
||||
|
||||
#> <target_file>.py : Compiles the file to Python
|
||||
%.py: %.catala_$(CATALA_LANG)
|
||||
@$(CATALA) Makefile $<
|
||||
$(CATALA) \
|
||||
Python \
|
||||
$<
|
||||
|
||||
#> <target_file>.tex : Weaves the file to LaTeX
|
||||
%.tex: %.catala_$(CATALA_LANG)
|
||||
@$(CATALA) Makefile $<
|
||||
|
||||
3
examples/allocations_familiales/.gitignore
vendored
3
examples/allocations_familiales/.gitignore
vendored
@ -13,4 +13,5 @@ _minted*
|
||||
*.pyg
|
||||
*.d
|
||||
*.new
|
||||
*.ml
|
||||
*.ml
|
||||
*.py
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@ -12,7 +12,7 @@
|
||||
from gmpy2 import log2, mpz, mpq, mpfr, mpc # type: ignore
|
||||
import datetime
|
||||
import dateutil.relativedelta # type: ignore
|
||||
from typing import NewType, List, Callable, Tuple, Optional, TypeVar
|
||||
from typing import NewType, List, Callable, Tuple, Optional, TypeVar, Iterable
|
||||
|
||||
# =====
|
||||
# Types
|
||||
@ -25,6 +25,10 @@ Date = NewType('Date', datetime.date)
|
||||
Duration = NewType('Duration', object)
|
||||
|
||||
|
||||
class Unit:
|
||||
pass
|
||||
|
||||
|
||||
class SourcePosition:
|
||||
def __init__(self,
|
||||
filename: str,
|
||||
@ -61,6 +65,58 @@ class NoValueProvided(Exception):
|
||||
def __init__(self, source_position: SourcePosition) -> None:
|
||||
self.source_position = SourcePosition
|
||||
|
||||
|
||||
def raise_(ex):
|
||||
raise ex
|
||||
|
||||
|
||||
class TryCatch:
|
||||
def __init__(self, fun, *args, **kwargs):
|
||||
self.fun = fun
|
||||
self.args = args
|
||||
self.kwargs = kwargs
|
||||
|
||||
self.exception_types_and_handlers = []
|
||||
self.finalize = None
|
||||
|
||||
def rescue(self, exception_types, handler):
|
||||
if not isinstance(exception_types, Iterable):
|
||||
exception_types = (exception_types,)
|
||||
|
||||
self.exception_types_and_handlers.append((exception_types, handler))
|
||||
return self
|
||||
|
||||
def ensure(self, finalize, *finalize_args, **finalize_kwargs):
|
||||
if self.finalize is not None:
|
||||
raise Exception('ensure() called twice')
|
||||
|
||||
self.finalize = finalize
|
||||
self.finalize_args = finalize_args
|
||||
self.finalize_kwargs = finalize_kwargs
|
||||
return self
|
||||
|
||||
def __call__(self):
|
||||
try:
|
||||
return self.fun(*self.args, **self.kwargs)
|
||||
|
||||
except BaseException as exc:
|
||||
handler = self.find_applicable_handler(exc)
|
||||
if handler is None:
|
||||
raise
|
||||
return handler(exc)
|
||||
|
||||
finally:
|
||||
if self.finalize is not None:
|
||||
self.finalize()
|
||||
|
||||
def find_applicable_handler(self, exc):
|
||||
applicable_handlers = (
|
||||
handler
|
||||
for exception_types, handler in self.exception_types_and_handlers
|
||||
if isinstance(exc, exception_types)
|
||||
)
|
||||
return next(applicable_handlers, None)
|
||||
|
||||
# ============================
|
||||
# Constructors and conversions
|
||||
# ============================
|
||||
|
||||
Loading…
Reference in New Issue
Block a user