mirror of
https://github.com/CatalaLang/catala.git
synced 2024-11-08 07:51:43 +03:00
Merge branch 'master' into adelaett-withoutexceptionsfix
This commit is contained in:
adelaett
commit
a9809b69a9
@ -50,7 +50,6 @@ buildDunePackage {
|
||||
js_of_ocaml
|
||||
js_of_ocaml-ppx
|
||||
menhirLib
|
||||
ocaml-crunch
|
||||
ocamlgraph
|
||||
pkgs.z3
|
||||
ppx_deriving
|
||||
|
||||
@ -452,36 +452,37 @@ let call_unstyled f =
|
||||
style_flag := prev;
|
||||
res
|
||||
|
||||
let time_marker () =
|
||||
let time_marker ppf () =
|
||||
let new_time = Unix.gettimeofday () in
|
||||
let old_time = !time in
|
||||
time := new_time;
|
||||
let delta = (new_time -. old_time) *. 1000. in
|
||||
if delta > 50. then
|
||||
Printf.printf "%s"
|
||||
(with_style
|
||||
[ANSITerminal.Bold; ANSITerminal.black]
|
||||
"[TIME] %.0f ms\n" delta)
|
||||
format_with_style
|
||||
[ANSITerminal.Bold; ANSITerminal.black]
|
||||
ppf
|
||||
(Printf.sprintf "[TIME] %.0fms@\n" delta)
|
||||
|
||||
(** Prints [\[DEBUG\]] in purple on the terminal standard output *)
|
||||
let debug_marker () =
|
||||
time_marker ();
|
||||
with_style [ANSITerminal.Bold; ANSITerminal.magenta] "[DEBUG] "
|
||||
let debug_marker ppf () =
|
||||
time_marker ppf ();
|
||||
format_with_style [ANSITerminal.Bold; ANSITerminal.magenta] ppf "[DEBUG] "
|
||||
|
||||
(** Prints [\[ERROR\]] in red on the terminal error output *)
|
||||
let error_marker () =
|
||||
with_style [ANSITerminal.Bold; ANSITerminal.red] "[ERROR] "
|
||||
let error_marker ppf () =
|
||||
format_with_style [ANSITerminal.Bold; ANSITerminal.red] ppf "[ERROR] "
|
||||
|
||||
(** Prints [\[WARNING\]] in yellow on the terminal standard output *)
|
||||
let warning_marker () =
|
||||
with_style [ANSITerminal.Bold; ANSITerminal.yellow] "[WARNING] "
|
||||
let warning_marker ppf () =
|
||||
format_with_style [ANSITerminal.Bold; ANSITerminal.yellow] ppf "[WARNING] "
|
||||
|
||||
(** Prints [\[RESULT\]] in green on the terminal standard output *)
|
||||
let result_marker () =
|
||||
with_style [ANSITerminal.Bold; ANSITerminal.green] "[RESULT] "
|
||||
let result_marker ppf () =
|
||||
format_with_style [ANSITerminal.Bold; ANSITerminal.green] ppf "[RESULT] "
|
||||
|
||||
(** Prints [\[LOG\]] in red on the terminal error output *)
|
||||
let log_marker () = with_style [ANSITerminal.Bold; ANSITerminal.black] "[LOG] "
|
||||
let log_marker ppf () =
|
||||
format_with_style [ANSITerminal.Bold; ANSITerminal.black] ppf "[LOG] "
|
||||
|
||||
(**{2 Printers}*)
|
||||
|
||||
@ -509,36 +510,35 @@ let add_prefix_to_each_line (s : string) (prefix : int -> string) =
|
||||
(fun _ -> "\n")
|
||||
(String.split_on_char '\n' s)
|
||||
|
||||
let debug_print (format : ('a, out_channel, unit) format) =
|
||||
if !debug_flag then Printf.printf ("%s" ^^ format ^^ "\n%!") (debug_marker ())
|
||||
else Printf.ifprintf stdout format
|
||||
let debug_print format =
|
||||
if !debug_flag then Format.printf ("%a" ^^ format ^^ "\n%!") debug_marker ()
|
||||
else Format.ifprintf Format.std_formatter format
|
||||
|
||||
let debug_format (format : ('a, Format.formatter, unit) format) =
|
||||
if !debug_flag then
|
||||
Format.printf ("%s@[<hov>" ^^ format ^^ "@]@.") (debug_marker ())
|
||||
Format.printf ("%a@[<hov>" ^^ format ^^ "@]@.") debug_marker ()
|
||||
else Format.ifprintf Format.std_formatter format
|
||||
|
||||
let error_print (format : ('a, out_channel, unit) format) =
|
||||
Printf.eprintf ("%s" ^^ format ^^ "\n%!") (error_marker ())
|
||||
let error_print format =
|
||||
Format.eprintf ("%a" ^^ format ^^ "@\n") error_marker ()
|
||||
|
||||
let error_format (format : ('a, Format.formatter, unit) format) =
|
||||
Format.eprintf ("%s" ^^ format ^^ "\n%!") (error_marker ())
|
||||
|
||||
let warning_print (format : ('a, out_channel, unit) format) =
|
||||
if !disable_warnings_flag then Printf.ifprintf stdout format
|
||||
else Printf.printf ("%s" ^^ format ^^ "\n%!") (warning_marker ())
|
||||
let warning_print format =
|
||||
if !disable_warnings_flag then Format.ifprintf Format.std_formatter format
|
||||
else Format.printf ("%a" ^^ format ^^ "@\n") warning_marker ()
|
||||
|
||||
let warning_format (format : ('a, Format.formatter, unit) format) =
|
||||
Format.printf ("%s" ^^ format ^^ "\n%!") (warning_marker ())
|
||||
let warning_format format =
|
||||
Format.printf ("%a" ^^ format ^^ "\n%!") warning_marker ()
|
||||
|
||||
let result_print (format : ('a, out_channel, unit) format) =
|
||||
Printf.printf ("%s" ^^ format ^^ "\n%!") (result_marker ())
|
||||
let result_print format =
|
||||
Format.printf ("%a" ^^ format ^^ "\n%!") result_marker ()
|
||||
|
||||
let result_format (format : ('a, Format.formatter, unit) format) =
|
||||
Format.printf ("%s" ^^ format ^^ "\n%!") (result_marker ())
|
||||
let result_format format =
|
||||
Format.printf ("%a" ^^ format ^^ "\n%!") result_marker ()
|
||||
|
||||
let log_print (format : ('a, out_channel, unit) format) =
|
||||
Printf.printf ("%s" ^^ format ^^ "\n%!") (log_marker ())
|
||||
let log_print format = Format.printf ("%a" ^^ format ^^ "\n%!") log_marker ()
|
||||
|
||||
let log_format (format : ('a, Format.formatter, unit) format) =
|
||||
Format.printf ("%s@[<hov>" ^^ format ^^ "@]@.") (log_marker ())
|
||||
let log_format format =
|
||||
Format.printf ("%a@[<hov>" ^^ format ^^ "@]@.") log_marker ()
|
||||
|
||||
@ -134,11 +134,11 @@ val call_unstyled : (unit -> 'a) -> 'a
|
||||
(** [call_unstyled f] calls the function [f] with the [style_flag] set to false
|
||||
during the execution. *)
|
||||
|
||||
val debug_marker : unit -> string
|
||||
val error_marker : unit -> string
|
||||
val warning_marker : unit -> string
|
||||
val result_marker : unit -> string
|
||||
val log_marker : unit -> string
|
||||
val debug_marker : Format.formatter -> unit -> unit
|
||||
val error_marker : Format.formatter -> unit -> unit
|
||||
val warning_marker : Format.formatter -> unit -> unit
|
||||
val result_marker : Format.formatter -> unit -> unit
|
||||
val log_marker : Format.formatter -> unit -> unit
|
||||
|
||||
(**{2 Printers}*)
|
||||
|
||||
@ -150,13 +150,13 @@ val concat_with_line_depending_prefix_and_suffix :
|
||||
val add_prefix_to_each_line : string -> (int -> string) -> string
|
||||
(** The int argument of the prefix corresponds to the line number, starting at 0 *)
|
||||
|
||||
val debug_print : ('a, Format.formatter, unit) format -> 'a
|
||||
val debug_format : ('a, Format.formatter, unit) format -> 'a
|
||||
val debug_print : ('a, out_channel, unit) format -> 'a
|
||||
val error_print : ('a, Format.formatter, unit) format -> 'a
|
||||
val error_format : ('a, Format.formatter, unit) format -> 'a
|
||||
val error_print : ('a, out_channel, unit) format -> 'a
|
||||
val warning_print : ('a, out_channel, unit) format -> 'a
|
||||
val warning_print : ('a, Format.formatter, unit) format -> 'a
|
||||
val warning_format : ('a, Format.formatter, unit) format -> 'a
|
||||
val result_print : ('a, out_channel, unit) format -> 'a
|
||||
val result_print : ('a, Format.formatter, unit) format -> 'a
|
||||
val result_format : ('a, Format.formatter, unit) format -> 'a
|
||||
val log_print : ('a, out_channel, unit) format -> 'a
|
||||
val log_print : ('a, Format.formatter, unit) format -> 'a
|
||||
val log_format : ('a, Format.formatter, unit) format -> 'a
|
||||
|
||||
@ -85,15 +85,20 @@ let rec typ (ctx : decl_ctx option) (fmt : Format.formatter) (ty : typ) : unit =
|
||||
~pp_sep:(fun fmt () -> Format.fprintf fmt "@ %a@ " op_style "*")
|
||||
typ)
|
||||
ts
|
||||
| TStruct s ->
|
||||
(* match ctx with | None -> *)
|
||||
Format.fprintf fmt "@[<hov 2>%a@]" StructName.format_t s
|
||||
(* | Some ctx -> Format.fprintf fmt "@[<hov 2> %a%a%a%a@]" punctuation "{"
|
||||
(Format.pp_print_list ~pp_sep:(fun fmt () -> Format.fprintf fmt "%a@ "
|
||||
punctuation ";") (fun fmt (field, mty) -> Format.fprintf fmt "%a%a%a%a@
|
||||
%a" punctuation "\"" StructField.format_t field punctuation "\""
|
||||
punctuation ":" typ mty)) (StructField.Map.bindings (StructName.Map.find
|
||||
s ctx.ctx_structs)) punctuation "}_" StructName.format_t s *)
|
||||
| TStruct s -> (
|
||||
match ctx with
|
||||
| None -> Format.fprintf fmt "@[<hov 2>%a@]" StructName.format_t s
|
||||
| Some ctx ->
|
||||
Format.fprintf fmt "@[<hov 2>%a@ %a%a%a@]" StructName.format_t s
|
||||
punctuation "{"
|
||||
(Format.pp_print_list
|
||||
~pp_sep:(fun fmt () -> Format.fprintf fmt "%a@ " punctuation ";")
|
||||
(fun fmt (field, mty) ->
|
||||
Format.fprintf fmt "%a%a%a%a@ %a" punctuation "\""
|
||||
StructField.format_t field punctuation "\"" punctuation ":" typ
|
||||
mty))
|
||||
(StructField.Map.bindings (StructName.Map.find s ctx.ctx_structs))
|
||||
punctuation "}")
|
||||
| TEnum e -> (
|
||||
match ctx with
|
||||
| None -> Format.fprintf fmt "@[<hov 2>%a@]" EnumName.format_t e
|
||||
@ -107,9 +112,7 @@ let rec typ (ctx : decl_ctx option) (fmt : Format.formatter) (ty : typ) : unit =
|
||||
typ mty))
|
||||
(EnumConstructor.Map.bindings (EnumName.Map.find e ctx.ctx_enums))
|
||||
punctuation "]")
|
||||
| TOption t ->
|
||||
Format.fprintf fmt "@[<hov 2>%a@ %a%a%a@]" base_type "option" punctuation
|
||||
"(" typ t punctuation ")"
|
||||
| TOption t -> Format.fprintf fmt "@[<hov 2>%a@ %a@]" base_type "option" typ t
|
||||
| TArrow ([t1], t2) ->
|
||||
Format.fprintf fmt "@[<hov 2>%a@ %a@ %a@]" typ_with_parens t1 op_style "→"
|
||||
typ t2
|
||||
@ -246,11 +249,17 @@ let operator : type a. Format.formatter -> a Op.t -> unit =
|
||||
let open Op in
|
||||
match op with
|
||||
| Log (entry, infos) ->
|
||||
Format.fprintf fmt "%a@[<hov 2>[%a|%a]@]" op_style "log" log_entry entry
|
||||
Format.fprintf fmt "%a%a%a%a"
|
||||
(Cli.format_with_style [ANSITerminal.blue])
|
||||
"#{" log_entry entry
|
||||
(Format.pp_print_list
|
||||
~pp_sep:(fun fmt () -> Format.fprintf fmt ".")
|
||||
(fun fmt info -> Uid.MarkedString.format fmt info))
|
||||
~pp_sep:(fun fmt () -> punctuation fmt ".")
|
||||
(fun fmt info ->
|
||||
Cli.format_with_style [ANSITerminal.blue] fmt
|
||||
(Uid.MarkedString.to_string info)))
|
||||
infos
|
||||
(Cli.format_with_style [ANSITerminal.blue])
|
||||
"}"
|
||||
| op -> Format.fprintf fmt "%a" op_style (operator_to_string op)
|
||||
|
||||
let except (fmt : Format.formatter) (exn : except) : unit =
|
||||
@ -266,8 +275,107 @@ let var_debug fmt v =
|
||||
|
||||
let var fmt v = Format.pp_print_string fmt (Bindlib.name_of v)
|
||||
|
||||
let needs_parens (type a) (e : (a, _) gexpr) : bool =
|
||||
match Marked.unmark e with EAbs _ | EStruct _ -> true | _ -> false
|
||||
(* Define precedence levels for auto parentheses *)
|
||||
module Precedence = struct
|
||||
type op = Xor | And | Or | Comp | Mul | Div | Add | Sub
|
||||
|
||||
type t =
|
||||
| Contained
|
||||
(* No parens needed, the term has unambiguous beginning and end *)
|
||||
| Op of op
|
||||
| App (* Function application, right-associative *)
|
||||
| Abs (* lambda, *)
|
||||
| Dot (* *)
|
||||
|
||||
let expr : type a. (a, 't) gexpr -> t =
|
||||
fun e ->
|
||||
match Marked.unmark e with
|
||||
| ELit _ -> Contained (* Todo: unop if < 0 *)
|
||||
| EApp { f = EOp { op; _ }, _; _ } -> (
|
||||
match op with
|
||||
| Not | GetDay | GetMonth | GetYear | FirstDayOfMonth | LastDayOfMonth
|
||||
| Length | Log _ | Minus | Minus_int | Minus_rat | Minus_mon | Minus_dur
|
||||
| ToRat | ToRat_int | ToRat_mon | ToMoney | ToMoney_rat | Round
|
||||
| Round_rat | Round_mon ->
|
||||
App
|
||||
| And -> Op And
|
||||
| Or -> Op Or
|
||||
| Xor -> Op Xor
|
||||
| Eq | Eq_int_int | Eq_rat_rat | Eq_mon_mon | Eq_dur_dur | Eq_dat_dat ->
|
||||
Op Comp
|
||||
| Lt | Lt_int_int | Lt_rat_rat | Lt_mon_mon | Lt_dat_dat | Lt_dur_dur ->
|
||||
Op Comp
|
||||
| Lte | Lte_int_int | Lte_rat_rat | Lte_mon_mon | Lte_dat_dat
|
||||
| Lte_dur_dur ->
|
||||
Op Comp
|
||||
| Gt | Gt_int_int | Gt_rat_rat | Gt_mon_mon | Gt_dat_dat | Gt_dur_dur ->
|
||||
Op Comp
|
||||
| Gte | Gte_int_int | Gte_rat_rat | Gte_mon_mon | Gte_dat_dat
|
||||
| Gte_dur_dur ->
|
||||
Op Comp
|
||||
| Add | Add_int_int | Add_rat_rat | Add_mon_mon | Add_dat_dur _
|
||||
| Add_dur_dur ->
|
||||
Op Add
|
||||
| Sub | Sub_int_int | Sub_rat_rat | Sub_mon_mon | Sub_dat_dat
|
||||
| Sub_dat_dur | Sub_dur_dur ->
|
||||
Op Sub
|
||||
| Mult | Mult_int_int | Mult_rat_rat | Mult_mon_rat | Mult_dur_int ->
|
||||
Op Mul
|
||||
| Div | Div_int_int | Div_rat_rat | Div_mon_rat | Div_mon_mon
|
||||
| Div_dur_dur ->
|
||||
Op Div
|
||||
| HandleDefault | HandleDefaultOpt | Map | Concat | Filter | Reduce | Fold
|
||||
->
|
||||
App)
|
||||
| EApp _ -> App
|
||||
| EOp _ -> Contained
|
||||
| EArray _ -> Contained
|
||||
| EVar _ -> Contained
|
||||
| EAbs _ -> Abs
|
||||
| EIfThenElse _ -> Contained
|
||||
| EStruct _ -> Contained
|
||||
| EInj _ -> App
|
||||
| EMatch _ -> App
|
||||
| ETuple _ -> Contained
|
||||
| ETupleAccess _ -> Dot
|
||||
| ELocation _ -> Contained
|
||||
| EScopeCall _ -> App
|
||||
| EDStructAccess _ | EStructAccess _ -> Dot
|
||||
| EAssert _ -> App
|
||||
| EDefault _ -> Contained
|
||||
| EEmptyError -> Contained
|
||||
| EErrorOnEmpty _ -> App
|
||||
| ERaise _ -> App
|
||||
| ECatch _ -> App
|
||||
|
||||
let needs_parens ~context ?(rhs = false) e =
|
||||
match expr context, expr e with
|
||||
| _, Contained -> false
|
||||
| Dot, Dot -> not rhs
|
||||
| _, Dot -> false
|
||||
| Dot, _ -> true
|
||||
| App, App -> not rhs
|
||||
| App, Op _ -> true
|
||||
| App, Abs -> true
|
||||
| Abs, _ -> false
|
||||
| Op a, Op b -> (
|
||||
match a, b with
|
||||
| _, Xor -> true
|
||||
| And, And | Or, Or -> false
|
||||
| And, Or | Or, And -> true
|
||||
| (And | Or | Xor), _ -> false
|
||||
| _, (And | Or | Comp) -> true
|
||||
| Comp, _ -> false
|
||||
| Add, (Add | Sub) -> false
|
||||
| Sub, (Add | Sub) -> rhs
|
||||
| (Add | Sub), (Mul | Div) -> false
|
||||
| (Mul | Div), (Add | Sub) -> true
|
||||
| Mul, (Mul | Div) -> false
|
||||
| Div, (Mul | Div) -> rhs)
|
||||
| Op _, App -> false
|
||||
| Op _, _ -> true
|
||||
| Contained, _ -> false
|
||||
end
|
||||
|
||||
let rec expr_aux :
|
||||
type a.
|
||||
@ -281,9 +389,16 @@ let rec expr_aux :
|
||||
let exprb bnd_ctx e = expr_aux ~debug ctx bnd_ctx e in
|
||||
let expr e = exprb bnd_ctx e in
|
||||
let var = if debug then var_debug else var in
|
||||
let rainbow =
|
||||
let rec skip_log : type a. (a, 't) gexpr -> (a, 't) gexpr = function
|
||||
| EApp { f = EOp { op = Log _; _ }, _; args = [e] }, _ when not debug ->
|
||||
skip_log e
|
||||
| e -> e
|
||||
in
|
||||
let e = skip_log e in
|
||||
let paren_depth = ref 0 in
|
||||
let colors =
|
||||
[
|
||||
ANSITerminal.white;
|
||||
(* ANSITerminal.white; *)
|
||||
ANSITerminal.red;
|
||||
ANSITerminal.blue;
|
||||
ANSITerminal.yellow;
|
||||
@ -292,38 +407,35 @@ let rec expr_aux :
|
||||
ANSITerminal.cyan;
|
||||
]
|
||||
in
|
||||
let rainbow_state = ref 0 in
|
||||
let with_parens fmt e =
|
||||
if needs_parens e then (
|
||||
let floyd =
|
||||
incr rainbow_state;
|
||||
[
|
||||
(* ANSITerminal.Blink; *)
|
||||
List.nth rainbow (!rainbow_state mod List.length rainbow);
|
||||
]
|
||||
in
|
||||
|
||||
Cli.format_with_style floyd fmt "(";
|
||||
expr fmt e;
|
||||
Cli.format_with_style floyd fmt ")")
|
||||
else expr fmt e
|
||||
let paren ~rhs expr fmt e1 =
|
||||
if Precedence.needs_parens ~rhs ~context:e (skip_log e1) then (
|
||||
let current_depth = !paren_depth mod List.length colors in
|
||||
incr paren_depth;
|
||||
Format.pp_open_hvbox fmt 1;
|
||||
Cli.format_with_style [List.nth colors current_depth] fmt "(";
|
||||
expr fmt e1;
|
||||
Format.pp_close_box fmt ();
|
||||
Cli.format_with_style [List.nth colors current_depth] fmt ")")
|
||||
else expr fmt e1
|
||||
in
|
||||
let lhs ex = paren ~rhs:false ex in
|
||||
let rhs ex = paren ~rhs:true ex in
|
||||
match Marked.unmark e with
|
||||
| EVar v -> var fmt v
|
||||
| ETuple es ->
|
||||
Format.fprintf fmt "@[<hov 2>%a%a%a@]" punctuation "("
|
||||
(Format.pp_print_list
|
||||
~pp_sep:(fun fmt () -> Format.fprintf fmt ",@ ")
|
||||
(fun fmt e -> expr fmt e))
|
||||
(fun fmt e -> lhs expr fmt e))
|
||||
es punctuation ")"
|
||||
| EArray es ->
|
||||
Format.fprintf fmt "@[<hov 2>%a%a%a@]" punctuation "["
|
||||
Format.fprintf fmt "@[<hv 2>%a %a@] %a" punctuation "["
|
||||
(Format.pp_print_list
|
||||
~pp_sep:(fun fmt () -> Format.fprintf fmt ";@ ")
|
||||
(fun fmt e -> expr fmt e))
|
||||
(fun fmt e -> lhs expr fmt e))
|
||||
es punctuation "]"
|
||||
| ETupleAccess { e; index; _ } ->
|
||||
expr fmt e;
|
||||
lhs expr fmt e;
|
||||
punctuation fmt ".";
|
||||
Format.pp_print_int fmt index
|
||||
| ELit l -> lit fmt l
|
||||
@ -332,14 +444,15 @@ let rec expr_aux :
|
||||
let expr = exprb bnd_ctx in
|
||||
let xs_tau = List.mapi (fun i tau -> xs.(i), tau) tys in
|
||||
let xs_tau_arg = List.map2 (fun (x, tau) arg -> x, tau, arg) xs_tau args in
|
||||
Format.fprintf fmt "%a%a"
|
||||
Format.fprintf fmt "@[<hv 0>%a%a@]"
|
||||
(Format.pp_print_list
|
||||
~pp_sep:(fun fmt () -> Format.fprintf fmt "")
|
||||
(fun fmt (x, tau, arg) ->
|
||||
Format.fprintf fmt "@[<hov 2>%a@ %a@ %a@ %a@ %a@ %a@ %a@]@\n" keyword
|
||||
"let" var x punctuation ":" (typ ctx) tau punctuation "=" expr arg
|
||||
keyword "in"))
|
||||
xs_tau_arg expr body
|
||||
Format.fprintf fmt
|
||||
"@[<hv 0>@[<hv 2>@[<hov 4>%a@ %a@ %a@ %a@ %a@]@ %a@]@ %a@]@\n"
|
||||
keyword "let" var x punctuation ":" (typ ctx) tau punctuation "="
|
||||
expr arg keyword "in"))
|
||||
xs_tau_arg (rhs expr) body
|
||||
| EAbs { binder; tys } ->
|
||||
let xs, body, bnd_ctx = Bindlib.unmbind_in bnd_ctx binder in
|
||||
let expr = exprb bnd_ctx in
|
||||
@ -350,98 +463,80 @@ let rec expr_aux :
|
||||
(fun fmt (x, tau) ->
|
||||
Format.fprintf fmt "%a%a%a %a%a" punctuation "(" var x punctuation
|
||||
":" (typ ctx) tau punctuation ")"))
|
||||
xs_tau punctuation "→" expr body
|
||||
xs_tau punctuation "→" (rhs expr) body
|
||||
| EApp { f = EOp { op = (Map | Filter) as op; _ }, _; args = [arg1; arg2] } ->
|
||||
Format.fprintf fmt "@[<hov 2>%a@ %a@ %a@]" operator op with_parens arg1
|
||||
with_parens arg2
|
||||
Format.fprintf fmt "@[<hov 2>%a@ %a@ %a@]" operator op (lhs expr) arg1
|
||||
(rhs expr) arg2
|
||||
| EApp { f = EOp { op = (And | Or) as op; _ }, _; args = [arg1; arg2] } ->
|
||||
Format.fprintf fmt "%a@ %a %a" (lhs expr) arg1 operator op (rhs expr) arg2
|
||||
| EApp { f = EOp { op; _ }, _; args = [arg1; arg2] } ->
|
||||
Format.fprintf fmt "@[<hov 2>%a@ %a@ %a@]" with_parens arg1 operator op
|
||||
with_parens arg2
|
||||
| EApp { f = EOp { op = Log _; _ }, _; args = [arg1] } when not debug ->
|
||||
expr fmt arg1
|
||||
Format.fprintf fmt "@[<hv 0>%a@ %a %a@]" (lhs expr) arg1 operator op
|
||||
(rhs expr) arg2
|
||||
| EApp { f = EOp { op; _ }, _; args = [arg1] } ->
|
||||
Format.fprintf fmt "@[<hov 2>%a@ %a@]" operator op with_parens arg1
|
||||
Format.fprintf fmt "%a %a" operator op (rhs expr) arg1
|
||||
| EApp { f; args } ->
|
||||
Format.fprintf fmt "@[<hov 2>%a@ %a@]" expr f
|
||||
Format.fprintf fmt "@[<hv 2>%a@ %a@]" (lhs expr) f
|
||||
(Format.pp_print_list
|
||||
~pp_sep:(fun fmt () -> Format.fprintf fmt "@ ")
|
||||
with_parens)
|
||||
~pp_sep:(fun fmt () -> Format.fprintf fmt ",@ ")
|
||||
(rhs expr))
|
||||
args
|
||||
| EIfThenElse { cond; etrue; efalse } ->
|
||||
Format.fprintf fmt "@[<hov 2>%a@ %a@ %a@ %a@ %a@ %a@]" keyword "if" expr
|
||||
cond keyword "then" expr etrue keyword "else" expr efalse
|
||||
Format.fprintf fmt
|
||||
"@[<hv 0>@[<hv 2>%a@ %a@]@ @[<hv 2>%a@ %a@]@ @[<hv 2>%a@ %a@]@]" keyword
|
||||
"if" expr cond keyword "then" expr etrue keyword "else" (rhs expr) efalse
|
||||
| EOp { op; _ } -> operator fmt op
|
||||
| EDefault { excepts; just; cons } ->
|
||||
if List.length excepts = 0 then
|
||||
Format.fprintf fmt "@[<hov 2>%a%a@ %a@ %a%a@]" punctuation "⟨" expr just
|
||||
punctuation "⊢" expr cons punctuation "⟩"
|
||||
else
|
||||
Format.fprintf fmt "@[<hov 2>%a%a@ %a@ %a@ %a@ %a%a@]" punctuation "⟨"
|
||||
Format.fprintf fmt
|
||||
"@[<hv 0>@[<hov 2>%a %a@]@ @[<hov 2>%a %a@ %a %a@] %a@]" punctuation "⟨"
|
||||
(Format.pp_print_list
|
||||
~pp_sep:(fun fmt () -> Format.fprintf fmt "%a@ " punctuation ",")
|
||||
expr)
|
||||
(lhs expr))
|
||||
excepts punctuation "|" expr just punctuation "⊢" expr cons punctuation
|
||||
"⟩"
|
||||
| EEmptyError -> lit_style fmt "∅ "
|
||||
| EEmptyError -> lit_style fmt "∅"
|
||||
| EErrorOnEmpty e' ->
|
||||
Format.fprintf fmt "%a@ %a" op_style "error_empty" with_parens e'
|
||||
Format.fprintf fmt "@[<hov 2>%a@ %a@]" op_style "error_empty" (rhs expr) e'
|
||||
| EAssert e' ->
|
||||
Format.fprintf fmt "@[<hov 2>%a@ %a%a%a@]" keyword "assert" punctuation "("
|
||||
expr e' punctuation ")"
|
||||
(rhs expr) e' punctuation ")"
|
||||
| ECatch { body; exn; handler } ->
|
||||
Format.fprintf fmt "@[<hov 2>%a@ %a@ %a@ %a ->@ %a@]" keyword "try"
|
||||
with_parens body keyword "with" except exn with_parens handler
|
||||
Format.fprintf fmt "@[<hv 0>@[<hov 2>%a@ %a@]@ @[<hov 2>%a@ %a ->@ %a@]@]"
|
||||
keyword "try" expr body keyword "with" except exn (rhs expr) handler
|
||||
| ERaise exn ->
|
||||
Format.fprintf fmt "@[<hov 2>%a@ %a@]" keyword "raise" except exn
|
||||
| ELocation loc -> location fmt loc
|
||||
| EDStructAccess { e; field; _ } ->
|
||||
Format.fprintf fmt "%a%a%a%a%a" expr e punctuation "." punctuation "\""
|
||||
IdentName.format_t field punctuation "\""
|
||||
Format.fprintf fmt "%a%a%a%a%a" (lhs expr) e punctuation "." punctuation
|
||||
"\"" IdentName.format_t field punctuation "\""
|
||||
| EStruct { name; fields } ->
|
||||
Format.fprintf fmt "@[<hov 2>%a@ %a@ %a%a@]" punctuation "{"
|
||||
Format.fprintf fmt "@[<hv 0>@[<hv 2>%a%a@,@[<hv 0>%a@]@]@,%a@]" punctuation
|
||||
"{" StructName.format_t name
|
||||
(Format.pp_print_list
|
||||
~pp_sep:(fun fmt () -> Format.fprintf fmt "%a@ " punctuation ";")
|
||||
~pp_sep:(fun fmt () -> punctuation fmt ";")
|
||||
(fun fmt (field_name, field_expr) ->
|
||||
Format.fprintf fmt "%a%a%a%a@ %a" punctuation "\""
|
||||
Format.fprintf fmt "@ @[<hov 2>%a%a%a %a@ %a@]" punctuation "\""
|
||||
StructField.format_t field_name punctuation "\"" punctuation "="
|
||||
expr field_expr))
|
||||
(lhs expr) field_expr))
|
||||
(StructField.Map.bindings fields)
|
||||
punctuation "}_" StructName.format_t name
|
||||
punctuation "}"
|
||||
| EStructAccess { e; field; _ } ->
|
||||
Format.fprintf fmt "%a%a%a%a%a" expr e punctuation "." punctuation "\""
|
||||
StructField.format_t field punctuation "\""
|
||||
Format.fprintf fmt "%a%a%a%a%a" (lhs expr) e punctuation "." punctuation
|
||||
"\"" StructField.format_t field punctuation "\""
|
||||
| EInj { e; cons; _ } ->
|
||||
Format.fprintf fmt "%a@ %a" EnumConstructor.format_t cons with_parens e
|
||||
| EMatch { e; cases; name }
|
||||
when name = Definitions.option_enum
|
||||
&&
|
||||
match EnumConstructor.Map.find_opt Definitions.none_constr cases with
|
||||
| Some (EAbs { binder; _ }, _) -> (
|
||||
let _, body = Bindlib.unmbind binder in
|
||||
match body with
|
||||
| EInj { name; cons; _ }, _ ->
|
||||
EnumName.equal name Definitions.option_enum
|
||||
&& EnumConstructor.equal cons Definitions.none_constr
|
||||
| _ -> false)
|
||||
| _ -> false -> (
|
||||
match EnumConstructor.Map.find Definitions.some_constr cases with
|
||||
| EAbs { binder; tys = [tau] }, _ ->
|
||||
let[@warning "-8"] [| x |], body = Bindlib.unmbind binder in
|
||||
|
||||
Format.fprintf fmt "@[<hov 2>%a@ %a@ %a@ %a@ %a@ %a@ %a@]@\n%a" keyword
|
||||
"let*" var x punctuation ":" (typ ctx) tau punctuation "=" expr e
|
||||
keyword "in" expr body
|
||||
| _ -> assert false)
|
||||
Format.fprintf fmt "%a@ %a" EnumConstructor.format_t cons (rhs expr) e
|
||||
| EMatch { e; cases; _ } ->
|
||||
Format.fprintf fmt "@[<v 0>@[<hov 2>%a@ %a@]@ %a@ %a@ %a@]" keyword "match"
|
||||
expr e keyword "with"
|
||||
Format.fprintf fmt "@[<v 0>@[<hov 2>%a@ %a@]@ %a@ %a@]" keyword "match"
|
||||
(lhs expr) e keyword "with"
|
||||
(Format.pp_print_list
|
||||
~pp_sep:(fun fmt () -> Format.fprintf fmt "@\n")
|
||||
(fun fmt (cons_name, case_expr) ->
|
||||
Format.fprintf fmt "@[<hov 2>%a %a@ %a@ %a@]" punctuation "|"
|
||||
enum_constructor cons_name punctuation "→" expr case_expr))
|
||||
enum_constructor cons_name punctuation "→" (rhs expr) case_expr))
|
||||
(EnumConstructor.Map.bindings cases)
|
||||
keyword "end"
|
||||
| EScopeCall { scope; args } ->
|
||||
Format.pp_open_hovbox fmt 2;
|
||||
ScopeName.format_t fmt scope;
|
||||
@ -454,7 +549,7 @@ let rec expr_aux :
|
||||
~pp_sep:(fun fmt () -> Format.fprintf fmt "%a@ " punctuation ";")
|
||||
(fun fmt (field_name, field_expr) ->
|
||||
Format.fprintf fmt "%a%a%a%a@ %a" punctuation "\"" ScopeVar.format_t
|
||||
field_name punctuation "\"" punctuation "=" expr field_expr)
|
||||
field_name punctuation "\"" punctuation "=" (rhs expr) field_expr)
|
||||
fmt
|
||||
(ScopeVar.Map.bindings args);
|
||||
Format.pp_close_box fmt ();
|
||||
|
||||
@ -26,7 +26,7 @@ scope B:
|
||||
```catala-test-inline
|
||||
$ catala Interpret -s A
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] x = [$0.00; $9.00; $5.20]
|
||||
[RESULT] x = [ $0.00; $9.00; $5.20 ]
|
||||
```
|
||||
|
||||
```catala-test-inline
|
||||
|
||||
@ -33,13 +33,14 @@ scope B:
|
||||
$ catala Interpret -s A
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] x =
|
||||
[S { "id"= 0; "income"= $0.00 }; S { "id"= 1; "income"= $9.00 };
|
||||
S { "id"= 2; "income"= $5.20 }]
|
||||
[ {S "id" = 0; "income" = $0.00};
|
||||
{S "id" = 1; "income" = $9.00};
|
||||
{S "id" = 2; "income" = $5.20} ]
|
||||
```
|
||||
|
||||
```catala-test-inline
|
||||
$ catala Interpret -s B
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] argmax = S { "id"= 1; "income"= $9.00 }
|
||||
[RESULT] argmin = S { "id"= 0; "income"= $0.00 }
|
||||
[RESULT] argmax = {S "id" = 1; "income" = $9.00}
|
||||
[RESULT] argmin = {S "id" = 0; "income" = $0.00}
|
||||
```
|
||||
|
||||
@ -39,27 +39,43 @@ let scope S (x: integer|internal|output) =
|
||||
(λ (i_1: integer) (i_2: integer) →
|
||||
if
|
||||
let i : integer = i_1 in
|
||||
to_rat_int 2 -! i *! 2 -! i <.
|
||||
let i : integer = i_2 in
|
||||
to_rat_int 2 -! i *! 2 -! i then i_1 else i_2) 42 [1; 2; 3]
|
||||
= 2;
|
||||
to_rat_int ((2 -! i) *! (2 -! i))
|
||||
<. let i : integer = i_2 in
|
||||
to_rat_int ((2 -! i) *! (2 -! i))
|
||||
then i_1
|
||||
else i_2),
|
||||
42,
|
||||
[ 1; 2; 3 ]
|
||||
= 2;
|
||||
assert reduce
|
||||
(λ (max1: decimal) (max2: decimal) →
|
||||
if max1 >. max2 then max1 else max2) 10.
|
||||
map (λ (i: integer) → to_rat_int i) [1; 2; 3] = 3.;
|
||||
if max1 >. max2 then max1 else max2),
|
||||
10.,
|
||||
map (λ (i: integer) → to_rat_int i) [ 1; 2; 3 ]
|
||||
= 3.;
|
||||
assert reduce
|
||||
(λ (max1: integer) (max2: integer) →
|
||||
if max1 >! max2 then max1 else max2) 10 [1; 2; 3] = 3;
|
||||
assert length filter (λ (i: integer) → i >=! 2) [1; 2; 3] = 2;
|
||||
assert length [1; 2; 3] = 3;
|
||||
assert reduce (λ (sum1: integer) (sum2: integer) → sum1 +! sum2) 0
|
||||
map (λ (i: integer) → i +! 2) [1; 2; 3] = 12;
|
||||
assert reduce (λ (sum1: integer) (sum2: integer) → sum1 +! sum2) 0
|
||||
[1; 2; 3] = 6;
|
||||
if max1 >! max2 then max1 else max2),
|
||||
10,
|
||||
[ 1; 2; 3 ]
|
||||
= 3;
|
||||
assert length filter (λ (i: integer) → i >=! 2) [ 1; 2; 3 ] = 2;
|
||||
assert length [ 1; 2; 3 ] = 3;
|
||||
assert reduce
|
||||
(λ (sum1: integer) (sum2: integer) → sum1 +! sum2),
|
||||
0,
|
||||
map (λ (i: integer) → i +! 2) [ 1; 2; 3 ]
|
||||
= 12;
|
||||
assert reduce
|
||||
(λ (sum1: integer) (sum2: integer) → sum1 +! sum2),
|
||||
0,
|
||||
[ 1; 2; 3 ]
|
||||
= 6;
|
||||
assert map (λ (i: integer) → i +! 2)
|
||||
filter (λ (i: integer) → i >! 2) [1; 2; 3] = [5];
|
||||
assert filter (λ (i: integer) → i >=! 2) [1; 2; 3] = [2; 3];
|
||||
assert map (λ (i: integer) → i +! 2) [1; 2; 3] = [3; 4; 5]
|
||||
filter (λ (i: integer) → i >! 2) [ 1; 2; 3 ]
|
||||
= [ 5 ];
|
||||
assert filter (λ (i: integer) → i >=! 2) [ 1; 2; 3 ] = [ 2; 3 ];
|
||||
assert map (λ (i: integer) → i +! 2) [ 1; 2; 3 ] = [ 3; 4; 5 ]
|
||||
```
|
||||
|
||||
```catala-test-inline
|
||||
|
||||
@ -13,6 +13,6 @@ scope A:
|
||||
```catala-test-inline
|
||||
$ catala Interpret -s A
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] x = [0; 1; 2; 3; 4; 5; 6]
|
||||
[RESULT] y = [0; 1; 2; 3; 4; 5; 6; 7; 8; 9; 10]
|
||||
[RESULT] x = [ 0; 1; 2; 3; 4; 5; 6 ]
|
||||
[RESULT] y = [ 0; 1; 2; 3; 4; 5; 6; 7; 8; 9; 10 ]
|
||||
```
|
||||
|
||||
@ -20,12 +20,12 @@ scope B:
|
||||
```catala-test-inline
|
||||
$ catala Interpret -s A
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] x = [$0.00; $9.00; $5.20]
|
||||
[RESULT] x = [ $0.00; $9.00; $5.20 ]
|
||||
```
|
||||
|
||||
```catala-test-inline
|
||||
$ catala Interpret -s B
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] y = [$9.00; $5.20]
|
||||
[RESULT] z = [false; true; true]
|
||||
[RESULT] y = [ $9.00; $5.20 ]
|
||||
[RESULT] z = [ false; true; true ]
|
||||
```
|
||||
|
||||
@ -24,7 +24,7 @@ scope B:
|
||||
```catala-test-inline
|
||||
$ catala Interpret -s A
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] x = [0; 9; 64]
|
||||
[RESULT] x = [ 0; 9; 64 ]
|
||||
```
|
||||
|
||||
```catala-test-inline
|
||||
|
||||
@ -14,19 +14,24 @@ scope TestBool:
|
||||
```catala-test-inline
|
||||
$ catala Dcalc
|
||||
let TestBool :
|
||||
TestBool_in {"foo_in": unit → bool; "bar_in": unit → integer} →
|
||||
TestBool {"foo": bool; "bar": integer} =
|
||||
TestBool_in {"foo_in": unit → bool; "bar_in": unit → integer} →
|
||||
TestBool {"foo": bool; "bar": integer} =
|
||||
λ (TestBool_in: TestBool_in {"foo_in": unit → bool; "bar_in":
|
||||
unit → integer}) →
|
||||
let foo : unit → bool = TestBool_in."foo_in" in
|
||||
let bar : unit → integer = TestBool_in."bar_in" in
|
||||
let bar1 : integer = error_empty ⟨bar () | true ⊢ ⟨true ⊢ 1⟩⟩
|
||||
in
|
||||
let foo1 : bool = error_empty
|
||||
⟨foo () | true ⊢
|
||||
⟨⟨bar1 >=! 0 ⊢ true⟩, ⟨bar1 <! 0 ⊢ false⟩ | false ⊢
|
||||
∅ ⟩⟩ in
|
||||
TestBool { "foo"= foo1; "bar"= bar1 } in
|
||||
let bar1 : integer =
|
||||
error_empty ⟨ bar () | true ⊢ ⟨true ⊢ 1⟩ ⟩
|
||||
in
|
||||
let foo1 : bool =
|
||||
error_empty
|
||||
⟨ foo ()
|
||||
| true
|
||||
⊢ ⟨ ⟨bar1 >=! 0 ⊢ true⟩, ⟨bar1 <! 0 ⊢ false⟩
|
||||
| false ⊢ ∅ ⟩ ⟩
|
||||
in
|
||||
{TestBool "foo" = foo1; "bar" = bar1}
|
||||
in
|
||||
TestBool
|
||||
```
|
||||
|
||||
@ -47,5 +52,6 @@ struct TestBool = {
|
||||
let scope TestBool (foo: bool|context|output) (bar: integer|context|output) =
|
||||
let bar : integer = reentrant or by default ⟨true ⊢ 1⟩;
|
||||
let foo : bool = reentrant or by default
|
||||
⟨⟨bar >=! 0 ⊢ true⟩, ⟨bar <! 0 ⊢ false⟩ | false ⊢ ∅ ⟩
|
||||
⟨ ⟨bar >=! 0 ⊢ true⟩, ⟨bar <! 0 ⊢ false⟩
|
||||
| false ⊢ ∅ ⟩
|
||||
```
|
||||
|
||||
@ -12,6 +12,9 @@ scope Test:
|
||||
|
||||
```catala-test-inline
|
||||
$ catala Interpret -s Test
|
||||
catala: internal error, uncaught exception:
|
||||
Dates_calc.Dates.AmbiguousComputation
|
||||
|
||||
[WARNING] In scope "Test", the variable "ambiguous" is never used anywhere; maybe it's unnecessary?
|
||||
|
||||
┌─⯈ tests/test_date/bad/rounding_option.catala_en:5.10-19:
|
||||
@ -19,8 +22,5 @@ $ catala Interpret -s Test
|
||||
5 │ context ambiguous content boolean
|
||||
│ ‾‾‾‾‾‾‾‾‾
|
||||
|
||||
catala: internal error, uncaught exception:
|
||||
Dates_calc.Dates.AmbiguousComputation
|
||||
|
||||
#return code 125#
|
||||
```
|
||||
|
||||
@ -12,6 +12,9 @@ champ d'application Test:
|
||||
|
||||
```catala-test-inline
|
||||
$ catala Interpret -s Test
|
||||
catala: internal error, uncaught exception:
|
||||
Dates_calc.Dates.AmbiguousComputation
|
||||
|
||||
[WARNING] In scope "Test", the variable "ambiguité" is never used anywhere; maybe it's unnecessary?
|
||||
|
||||
┌─⯈ tests/test_date/bad/rounding_option.catala_fr:5.11-20:
|
||||
@ -19,8 +22,5 @@ $ catala Interpret -s Test
|
||||
5 │ contexte ambiguité contenu booléen
|
||||
│ ‾‾‾‾‾‾‾‾‾
|
||||
|
||||
catala: internal error, uncaught exception:
|
||||
Dates_calc.Dates.AmbiguousComputation
|
||||
|
||||
#return code 125#
|
||||
```
|
||||
|
||||
@ -50,5 +50,5 @@ scope Benefit:
|
||||
$ catala Interpret -s Benefit
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] benefit = $2000.00
|
||||
[RESULT] person = Person { "age"= 26; "disabled"= true }
|
||||
[RESULT] person = {Person "age" = 26; "disabled" = true}
|
||||
```
|
||||
|
||||
@ -39,7 +39,8 @@ struct Foo = {
|
||||
|
||||
let scope Foo (y: integer|input) (x: integer|internal|output) =
|
||||
let x : integer =
|
||||
⟨⟨⟨⟨y = 4 ⊢ 4⟩, ⟨y = 5 ⊢ 5⟩ | false ⊢ ∅ ⟩ | true
|
||||
⊢ ⟨⟨y = 2 ⊢ 2⟩, ⟨y = 3 ⊢ 3⟩ | false ⊢ ∅ ⟩⟩ |
|
||||
true ⊢ ⟨⟨y = 0 ⊢ 0⟩, ⟨y = 1 ⊢ 1⟩ | false ⊢ ∅ ⟩⟩
|
||||
⟨ ⟨ ⟨ ⟨y = 4 ⊢ 4⟩, ⟨y = 5 ⊢ 5⟩ | false ⊢ ∅ ⟩
|
||||
| true
|
||||
⊢ ⟨ ⟨y = 2 ⊢ 2⟩, ⟨y = 3 ⊢ 3⟩ | false ⊢ ∅ ⟩ ⟩
|
||||
| true ⊢ ⟨ ⟨y = 0 ⊢ 0⟩, ⟨y = 1 ⊢ 1⟩ | false ⊢ ∅ ⟩ ⟩
|
||||
```
|
||||
|
||||
@ -20,12 +20,15 @@ let S =
|
||||
let f1 : ((bool), integer) → integer =
|
||||
λ (env: (bool)) (y: integer) →
|
||||
let x1 : bool = env.0 in
|
||||
if x1 then y else -! y in
|
||||
(f1, (x)) in
|
||||
if x1 then y else -! y
|
||||
in
|
||||
(f1, (x))
|
||||
in
|
||||
let z : integer =
|
||||
let code_and_env : (((bool), integer) → integer * (bool)) = f in
|
||||
let code : ((bool), integer) → integer = code_and_env.0 in
|
||||
let env : (bool) = code_and_env.1 in
|
||||
code env -1 in
|
||||
S { "z"= z }
|
||||
code env, -1
|
||||
in
|
||||
{S "z" = z}
|
||||
```
|
||||
|
||||
@ -43,9 +43,10 @@ let A =
|
||||
λ (A_in: A_in {"f_in": integer → integer}) →
|
||||
let f : integer → integer = A_in."f_in" in
|
||||
let f1 : integer → integer =
|
||||
λ (x: integer) → error_empty
|
||||
⟨f x | true ⊢ ⟨true ⊢ x +! 1⟩⟩ in
|
||||
A { }
|
||||
λ (x: integer) →
|
||||
error_empty ⟨ f x | true ⊢ ⟨true ⊢ x +! 1⟩ ⟩
|
||||
in
|
||||
{A}
|
||||
```
|
||||
|
||||
```catala-test-inline
|
||||
@ -61,7 +62,8 @@ let B =
|
||||
λ (B_in: B_in {"b_in": bool}) →
|
||||
let b : bool = B_in."b_in" in
|
||||
let a.f : integer → integer =
|
||||
λ (x: integer) → ⟨b && x >! 0 ⊢ x -! 1⟩ in
|
||||
let result : A {} = A (A_in { "f_in"= a.f }) in
|
||||
B { }
|
||||
λ (x: integer) → ⟨b && x >! 0 ⊢ x -! 1⟩
|
||||
in
|
||||
let result : A {} = A {A_in "f_in" = a.f} in
|
||||
{B}
|
||||
```
|
||||
|
||||
@ -28,11 +28,13 @@ let A =
|
||||
let f : unit → integer = A_in."f_in" in
|
||||
let a : integer = error_empty ⟨true ⊢ 0⟩ in
|
||||
let b : integer = error_empty ⟨true ⊢ a +! 1⟩ in
|
||||
let e1 : integer = error_empty
|
||||
⟨e () | true ⊢ ⟨true ⊢ b +! c +! d +! 1⟩⟩ in
|
||||
let f1 : integer = error_empty
|
||||
⟨f () | true ⊢ ⟨true ⊢ e1 +! 1⟩⟩ in
|
||||
A { "b"= b; "d"= d; "f"= f1 }
|
||||
let e1 : integer =
|
||||
error_empty ⟨ e () | true ⊢ ⟨true ⊢ b +! c +! d +! 1⟩ ⟩
|
||||
in
|
||||
let f1 : integer =
|
||||
error_empty ⟨ f () | true ⊢ ⟨true ⊢ e1 +! 1⟩ ⟩
|
||||
in
|
||||
{A "b" = b; "d" = d; "f" = f1}
|
||||
```
|
||||
|
||||
```catala-test-inline
|
||||
|
||||
@ -19,10 +19,10 @@ $ catala Dcalc -s B
|
||||
let B =
|
||||
λ (B_in: B_in {}) →
|
||||
let a.x : bool = error_empty ⟨true ⊢ false⟩ in
|
||||
let result : A {"y": integer} = A (A_in { "x_in"= a.x }) in
|
||||
let result : A {"y": integer} = A {A_in "x_in" = a.x} in
|
||||
let a.y : integer = result."y" in
|
||||
let _ : unit = assert (error_empty a.y = 1) in
|
||||
B { }
|
||||
let _ : unit = assert (error_empty (a.y = 1)) in
|
||||
{B}
|
||||
```
|
||||
|
||||
```catala-test-inline
|
||||
|
||||
@ -24,12 +24,12 @@ scope B:
|
||||
$ catala Dcalc -s B
|
||||
let B =
|
||||
λ (B_in: B_in {}) →
|
||||
let a.a : unit → integer = λ (_: unit) → ∅ in
|
||||
let a.a : unit → integer = λ (_: unit) → ∅ in
|
||||
let a.b : integer = error_empty ⟨true ⊢ 2⟩ in
|
||||
let result : A {"c": integer} = A (A_in { "a_in"= a.a; "b_in"= a.b }) in
|
||||
let result : A {"c": integer} = A {A_in "a_in" = a.a; "b_in" = a.b} in
|
||||
let a.c : integer = result."c" in
|
||||
let _ : unit = assert (error_empty a.c = 1) in
|
||||
B { }
|
||||
let _ : unit = assert (error_empty (a.c = 1)) in
|
||||
{B}
|
||||
```
|
||||
|
||||
```catala-test-inline
|
||||
|
||||
@ -28,8 +28,8 @@ scope S:
|
||||
```catala-test-inline
|
||||
$ catala Interpret -s S
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] a = A { "x"= -2.; "y"= B { "y"= false; "z"= -1. } }
|
||||
[RESULT] b = B { "y"= true; "z"= 42. }
|
||||
[RESULT] a = {A "x" = -2.; "y" = {B "y" = false; "z" = -1.}}
|
||||
[RESULT] b = {B "y" = true; "z" = 42.}
|
||||
```
|
||||
|
||||
## Check scope of let-in vs scope variable
|
||||
|
||||
@ -21,6 +21,6 @@ scope S:
|
||||
```catala-test-inline
|
||||
$ catala Interpret -s S
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] a = A { "x"= 0; "y"= B { "y"= true; "z"= 0. } }
|
||||
[RESULT] b = B { "y"= true; "z"= 0. }
|
||||
[RESULT] a = {A "x" = 0; "y" = {B "y" = true; "z" = 0.}}
|
||||
[RESULT] b = {B "y" = true; "z" = 0.}
|
||||
```
|
||||
|
||||
@ -23,7 +23,7 @@ scope S:
|
||||
$ catala Interpret -s S
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] a = 1946.5744
|
||||
[RESULT] b = A { "y"= true; "z"= 2091. }
|
||||
[RESULT] b = {A "y" = true; "z" = 2091.}
|
||||
```
|
||||
|
||||
## Test toplevel function defs
|
||||
|
||||
@ -21,6 +21,6 @@ scope Titi:
|
||||
```catala-test-inline
|
||||
$ catala Interpret -s Titi
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] fizz = Toto { "foo"= 1213 }
|
||||
[RESULT] fuzz = Toto { "foo"= 1323 }
|
||||
[RESULT] fizz = {Toto "foo" = 1213}
|
||||
[RESULT] fuzz = {Toto "foo" = 1323}
|
||||
```
|
||||
|
||||
@ -34,7 +34,7 @@ $ catala Interpret -t -s HousingComputation
|
||||
│ ‾
|
||||
|
||||
[LOG] → RentComputation.direct
|
||||
[LOG] ≔ RentComputation.direct.input: RentComputation_in { }
|
||||
[LOG] ≔ RentComputation.direct.input: {RentComputation_in}
|
||||
[LOG] ≔ RentComputation.g: <function>
|
||||
[LOG] ≔ RentComputation.f: <function>
|
||||
[LOG] ☛ Definition applied:
|
||||
@ -43,7 +43,7 @@ $ catala Interpret -t -s HousingComputation
|
||||
7 │ definition f of x equals (output of RentComputation).f of x
|
||||
│ ‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾
|
||||
|
||||
[LOG] ≔ RentComputation.direct.output: RentComputation { "f"= λ (param0: integer) → RentComputation { "f"= λ (x: integer) → error_empty ⟨true ⊢ λ (x1: integer) → error_empty ⟨true ⊢ x1 +! 1⟩ x +! 1⟩ }."f" param0 }
|
||||
[LOG] ≔ RentComputation.direct.output: {RentComputation "f" = λ (param0: integer) → {RentComputation "f" = λ (x: integer) → error_empty ⟨true ⊢ (λ (x1: integer) → error_empty ⟨true ⊢ x1 +! 1⟩) (x +! 1)⟩ }."f" param0 }
|
||||
[LOG] ← RentComputation.direct
|
||||
[LOG] → RentComputation.f
|
||||
[LOG] ≔ RentComputation.f.input0: 1
|
||||
@ -70,20 +70,30 @@ $ catala Interpret -t -s HousingComputation
|
||||
[LOG] ≔ HousingComputation.result: 3
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] f =
|
||||
λ (x: integer) → error_empty
|
||||
⟨true ⊢
|
||||
let result : RentComputation {"f": integer → integer} =
|
||||
λ (RentComputation_in: RentComputation_in {}) →
|
||||
let g : integer → integer = error_empty
|
||||
(λ (x1: integer) → error_empty ⟨true ⊢ x1 +! 1⟩)
|
||||
in
|
||||
let f : integer → integer = error_empty
|
||||
(λ (x1: integer) → error_empty
|
||||
⟨true ⊢ g x1 +! 1⟩) in
|
||||
RentComputation { "f"= f } RentComputation_in { } in
|
||||
let result1 : RentComputation {"f": integer → integer} =
|
||||
RentComputation { "f"=
|
||||
λ (param0: integer) → result."f" param0 } in
|
||||
if true then result1 else result1."f" x⟩
|
||||
λ (x: integer) →
|
||||
error_empty
|
||||
⟨true ⊢
|
||||
(let result : RentComputation {"f": integer → integer} =
|
||||
(λ (RentComputation_in: RentComputation_in {}) →
|
||||
let g : integer → integer =
|
||||
error_empty
|
||||
(λ (x1: integer) →
|
||||
error_empty ⟨true ⊢ x1 +! 1⟩)
|
||||
in
|
||||
let f : integer → integer =
|
||||
error_empty
|
||||
(λ (x1: integer) →
|
||||
error_empty ⟨true ⊢ g (x1 +! 1)⟩)
|
||||
in
|
||||
{RentComputation "f" = f})
|
||||
{RentComputation_in}
|
||||
in
|
||||
let result1 : RentComputation {"f": integer → integer} =
|
||||
{RentComputation
|
||||
"f" = λ (param0: integer) → result."f" param0
|
||||
}
|
||||
in
|
||||
if true then result1 else result1)."f"
|
||||
x⟩
|
||||
[RESULT] result = 3
|
||||
```
|
||||
|
||||
@ -13,7 +13,8 @@ $ catala Lcalc -s Foo
|
||||
let Foo =
|
||||
λ (Foo_in: Foo_in {}) →
|
||||
let bar : integer =
|
||||
try handle_default [] (λ (_: unit) → true) (λ (_: unit) → 0) with
|
||||
EmptyError -> raise NoValueProvided in
|
||||
Foo { "bar"= bar }
|
||||
try handle_default [ ], (λ (_: unit) → true), (λ (_: unit) → 0)
|
||||
with EmptyError -> raise NoValueProvided
|
||||
in
|
||||
{Foo "bar" = bar}
|
||||
```
|
||||
|
||||
@ -38,7 +38,7 @@ scope B:
|
||||
$ catala Interpret -s A
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] t =
|
||||
T { "a"= S { "x"= 0; "y"= false }; "b"= S { "x"= 1; "y"= true } }
|
||||
{T "a" = {S "x" = 0; "y" = false}; "b" = {S "x" = 1; "y" = true}}
|
||||
```
|
||||
|
||||
```catala-test-inline
|
||||
@ -46,5 +46,5 @@ $ catala Interpret -s B
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] out = 1
|
||||
[RESULT] t =
|
||||
T { "a"= S { "x"= 0; "y"= false }; "b"= S { "x"= 1; "y"= true } }
|
||||
{T "a" = {S "x" = 0; "y" = false}; "b" = {S "x" = 1; "y" = true}}
|
||||
```
|
||||
|
||||
@ -26,6 +26,6 @@ $ catala Interpret -s A
|
||||
│ ‾‾‾
|
||||
└─ Article
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] x = Foo { "f"= 1 }
|
||||
[RESULT] x = {Foo "f" = 1}
|
||||
[RESULT] y = 1
|
||||
```
|
||||
|
||||
@ -20,6 +20,6 @@ scope A:
|
||||
```catala-test-inline
|
||||
$ catala Interpret -s A
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] s = S { "x"= 1; "y"= 2 }
|
||||
[RESULT] s = {S "x" = 1; "y" = 2}
|
||||
[RESULT] z = 3
|
||||
```
|
||||
|
||||
Loading…
Reference in New Issue
Block a user