Add date rounding option within scopes

This commit is contained in:
Raphaël Monat 2023-01-20 18:18:53 +01:00
parent 7f83a99daa
commit 7021c41f93
30 changed files with 4051 additions and 3264 deletions

View File

@ -58,6 +58,7 @@ type 'm ctx = {
('m Ast.expr Var.t * naked_typ * Desugared.Ast.io) ScopeVar.Map.t
SubScopeName.Map.t;
local_vars : ('m Scopelang.Ast.expr, 'm Ast.expr Var.t) Var.Map.t;
date_rounding : date_rounding;
}
let mark_tany m pos = Expr.with_ty m (Marked.mark pos TAny) ~pos
@ -557,7 +558,8 @@ let rec translate_expr (ctx : 'm ctx) (e : 'm Scopelang.Ast.expr) :
Expr.eifthenelse (translate_expr ctx cond) (translate_expr ctx etrue)
(translate_expr ctx efalse)
m
| EOp { op; tys } -> Expr.eop (Operator.translate op) tys m
| EOp { op; tys } ->
Expr.eop (Operator.translate (Some ctx.date_rounding) op) tys m
| EErrorOnEmpty e' -> Expr.eerroronempty (translate_expr ctx e') m
| EArray es -> Expr.earray (List.map (translate_expr ctx) es) m
@ -914,6 +916,17 @@ let translate_scope_decl
| _ -> ctx)
ctx scope_variables
in
let date_rounding =
List.find_opt
(function Desugared.Ast.DateRounding _ -> true)
sigma.scope_options
|> Option.map (function
| Desugared.Ast.DateRounding Desugared.Ast.Increasing ->
(RoundUp : Runtime_ocaml.Runtime.date_rounding)
| DateRounding Decreasing -> RoundDown)
|> Option.value ~default:Dates_calc.Dates.AbortOnRound
in
let ctx = { ctx with date_rounding } in
let scope_input_var = scope_sig.scope_sig_input_var in
let scope_input_struct_name = scope_sig.scope_sig_input_struct in
let scope_return_struct_name = scope_sig.scope_sig_output_struct in
@ -1079,6 +1092,7 @@ let translate_program (prgm : 'm Scopelang.Ast.program) : 'm Ast.program =
subscope_vars = SubScopeName.Map.empty;
local_vars = Var.Map.empty;
toplevel_vars;
date_rounding = AbortOnRound;
}
in
(* the resulting expression is the list of definitions of all the scopes,

View File

@ -239,7 +239,7 @@ and evaluate_operator :
| Add_int_int, [LInt x; LInt y] -> LInt (o_add_int_int x y)
| Add_rat_rat, [LRat x; LRat y] -> LRat (o_add_rat_rat x y)
| Add_mon_mon, [LMoney x; LMoney y] -> LMoney (o_add_mon_mon x y)
| Add_dat_dur, [LDate x; LDuration y] -> LDate (o_add_dat_dur x y)
| Add_dat_dur r, [LDate x; LDuration y] -> LDate (o_add_dat_dur r x y)
| Add_dur_dur, [LDuration x; LDuration y] ->
LDuration (o_add_dur_dur x y)
| Sub_int_int, [LInt x; LInt y] -> LInt (o_sub_int_int x y)
@ -294,7 +294,7 @@ and evaluate_operator :
LBool (protect o_eq_dur_dur x y)
| ( ( Minus_int | Minus_rat | Minus_mon | Minus_dur | ToRat_int
| ToRat_mon | ToMoney_rat | Round_rat | Round_mon | Add_int_int
| Add_rat_rat | Add_mon_mon | Add_dat_dur | Add_dur_dur
| Add_rat_rat | Add_mon_mon | Add_dat_dur _ | Add_dur_dur
| Sub_int_int | Sub_rat_rat | Sub_mon_mon | Sub_dat_dat
| Sub_dat_dur | Sub_dur_dur | Mult_int_int | Mult_rat_rat
| Mult_mon_rat | Mult_dur_int | Div_int_int | Div_rat_rat

View File

@ -175,6 +175,7 @@ let always_false_rule
type assertion = expr boxed
type variation_typ = Increasing | Decreasing
type reference_typ = Decree | Law
type catala_option = DateRounding of variation_typ
type meta_assertion =
| FixedBy of reference_typ Marked.pos
@ -196,6 +197,7 @@ type scope = {
scope_uid : ScopeName.t;
scope_defs : scope_def ScopeDefMap.t;
scope_assertions : assertion list;
scope_options : catala_option list;
scope_meta_assertions : meta_assertion list;
}

View File

@ -76,6 +76,7 @@ val always_false_rule :
type assertion = expr boxed
type variation_typ = Increasing | Decreasing
type reference_typ = Decree | Law
type catala_option = DateRounding of variation_typ
type meta_assertion =
| FixedBy of reference_typ Marked.pos
@ -119,6 +120,7 @@ type scope = {
scope_uid : ScopeName.t;
scope_defs : scope_def ScopeDefMap.t;
scope_assertions : assertion list;
scope_options : catala_option list;
scope_meta_assertions : meta_assertion list;
}

View File

@ -1142,6 +1142,21 @@ let process_scope_use_item
| Surface.Ast.Rule rule -> process_rule precond scope ctxt prgm rule
| Surface.Ast.Definition def -> process_def precond scope ctxt prgm def
| Surface.Ast.Assertion ass -> process_assert precond scope ctxt prgm ass
| Surface.Ast.DateRounding (r, _) ->
let scope_uid = scope in
let scope : Ast.scope = ScopeName.Map.find scope_uid prgm.program_scopes in
let r =
match r with
| Surface.Ast.Increasing -> Ast.Increasing
| Surface.Ast.Decreasing -> Ast.Decreasing
in
let new_scope =
{ scope with scope_options = Ast.DateRounding r :: scope.scope_options }
in
{
prgm with
program_scopes = ScopeName.Map.add scope_uid new_scope prgm.program_scopes;
}
| _ -> prgm
(** {1 Translating top-level items} *)
@ -1381,6 +1396,7 @@ let translate_program
scope_defs = init_scope_defs ctxt s_context.var_idmap;
scope_assertions = [];
scope_meta_assertions = [];
scope_options = [];
scope_uid = s_uid;
})
ctxt.Name_resolution.scopes

View File

@ -78,7 +78,7 @@ and translate_expr (ctx : 'm ctx) (e : 'm D.expr) : 'm A.expr boxed =
l) ->
Expr.elit l m
| ELit LEmptyError -> Expr.eraise EmptyError m
| EOp { op; tys } -> Expr.eop (Operator.translate op) tys m
| EOp { op; tys } -> Expr.eop (Operator.translate None op) tys m
| EIfThenElse { cond; etrue; efalse } ->
Expr.eifthenelse (translate_expr ctx cond) (translate_expr ctx etrue)
(translate_expr ctx efalse)

View File

@ -302,7 +302,8 @@ let rec translate_and_hoist (ctx : 'm ctx) (e : 'm D.expr) :
let es', hoists = es |> List.map (translate_and_hoist ctx) |> List.split in
Expr.earray es' mark, disjoint_union_maps (Expr.pos e) hoists
| EOp { op; tys } -> Expr.eop (Operator.translate op) tys mark, Var.Map.empty
| EOp { op; tys } ->
Expr.eop (Operator.translate None op) tys mark, Var.Map.empty
and translate_expr ?(append_esome = true) (ctx : 'm ctx) (e : 'm D.expr) :
'm A.expr boxed =

View File

@ -70,8 +70,8 @@ let format_op
| LastDayOfMonth -> Format.pp_print_string fmt "last_day_of_month"
| Round_mon -> Format.pp_print_string fmt "money_round"
| Round_rat -> Format.pp_print_string fmt "decimal_round"
| Add_int_int | Add_rat_rat | Add_mon_mon | Add_dat_dur | Add_dur_dur | Concat
->
| Add_int_int | Add_rat_rat | Add_mon_mon | Add_dat_dur _ | Add_dur_dur
| Concat ->
Format.pp_print_string fmt "+"
| Sub_int_int | Sub_rat_rat | Sub_mon_mon | Sub_dat_dat | Sub_dat_dur
| Sub_dur_dur ->

View File

@ -49,6 +49,7 @@ type 'm scope_decl = {
scope_sig : (typ * Desugared.Ast.io) ScopeVar.Map.t;
scope_decl_rules : 'm rule list;
scope_mark : 'm mark;
scope_options : Desugared.Ast.catala_option list;
}
type 'm program = {

View File

@ -41,6 +41,7 @@ type 'm scope_decl = {
scope_sig : (typ * Desugared.Ast.io) ScopeVar.Map.t;
scope_decl_rules : 'm rule list;
scope_mark : 'm mark;
scope_options : Desugared.Ast.catala_option list;
}
type 'm program = {

View File

@ -643,6 +643,7 @@ let translate_scope (ctx : ctx) (scope : Desugared.Ast.scope) :
Ast.scope_decl_rules;
Ast.scope_sig;
Ast.scope_mark = Untyped { pos };
Ast.scope_options = scope.scope_options;
}
(** {1 API} *)

View File

@ -81,6 +81,7 @@ and naked_typ =
(** {2 Constants and operators} *)
type date = Runtime.date
type date_rounding = Runtime.date_rounding
type duration = Runtime.duration
type log_entry =
@ -162,7 +163,9 @@ module Op = struct
| Add_int_int : ([< scopelang | dcalc | lcalc ], resolved) t
| Add_rat_rat : ([< scopelang | dcalc | lcalc ], resolved) t
| Add_mon_mon : ([< scopelang | dcalc | lcalc ], resolved) t
| Add_dat_dur : ([< scopelang | dcalc | lcalc ], resolved) t
| Add_dat_dur :
date_rounding
-> ([< scopelang | dcalc | lcalc ], resolved) t
| Add_dur_dur : ([< scopelang | dcalc | lcalc ], resolved) t
| Sub : (desugared, overloaded) t
| Sub_int_int : ([< scopelang | dcalc | lcalc ], resolved) t

View File

@ -52,7 +52,12 @@ let name : type a k. (a, k) t -> string = function
| Add_int_int -> "o_add_int_int"
| Add_rat_rat -> "o_add_rat_rat"
| Add_mon_mon -> "o_add_mon_mon"
| Add_dat_dur -> "o_add_dat_dur"
| Add_dat_dur rm -> begin
match rm with
| RoundUp -> "o_add_dat_dur(u)"
| RoundDown -> "o_add_dat_dur(d)"
| AbortOnRound -> "o_add_dat_dur(a)"
end
| Add_dur_dur -> "o_add_dur_dur"
| Sub -> "o_sub"
| Sub_int_int -> "o_sub_int_int"
@ -125,6 +130,7 @@ let compare (type a k a2 k2) (t1 : (a, k) t) (t2 : (a2, k2) t) =
match compare_log_entries l1 l2 with
| 0 -> List.compare Uid.MarkedString.compare info1 info2
| n -> n)
| Add_dat_dur l, Add_dat_dur r -> Stdlib.compare l r
| Not, Not
| Length, Length
| GetDay, GetDay
@ -157,7 +163,6 @@ let compare (type a k a2 k2) (t1 : (a, k) t) (t2 : (a2, k2) t) =
| Add_int_int, Add_int_int
| Add_rat_rat, Add_rat_rat
| Add_mon_mon, Add_mon_mon
| Add_dat_dur, Add_dat_dur
| Add_dur_dur, Add_dur_dur
| Sub, Sub
| Sub_int_int, Sub_int_int
@ -240,7 +245,7 @@ let compare (type a k a2 k2) (t1 : (a, k) t) (t2 : (a2, k2) t) =
| Add_int_int, _ -> -1 | _, Add_int_int -> 1
| Add_rat_rat, _ -> -1 | _, Add_rat_rat -> 1
| Add_mon_mon, _ -> -1 | _, Add_mon_mon -> 1
| Add_dat_dur, _ -> -1 | _, Add_dat_dur -> 1
| Add_dat_dur _, _ -> -1 | _, Add_dat_dur _ -> 1
| Add_dur_dur, _ -> -1 | _, Add_dur_dur -> 1
| Sub, _ -> -1 | _, Sub -> 1
| Sub_int_int, _ -> -1 | _, Sub_int_int -> 1
@ -316,7 +321,7 @@ let kind_dispatch :
overloaded op
| ( Minus_int | Minus_rat | Minus_mon | Minus_dur | ToRat_int | ToRat_mon
| ToMoney_rat | Round_rat | Round_mon | Add_int_int | Add_rat_rat
| Add_mon_mon | Add_dat_dur | Add_dur_dur | Sub_int_int | Sub_rat_rat
| Add_mon_mon | Add_dat_dur _ | Add_dur_dur | Sub_int_int | Sub_rat_rat
| Sub_mon_mon | Sub_dat_dat | Sub_dat_dur | Sub_dur_dur | Mult_int_int
| Mult_rat_rat | Mult_mon_rat | Mult_dur_int | Div_int_int | Div_rat_rat
| Div_mon_mon | Div_mon_rat | Div_dur_dur | Lt_int_int | Lt_rat_rat
@ -331,9 +336,10 @@ let kind_dispatch :
lcalc *)
let translate :
type k.
date_rounding option ->
([< scopelang | dcalc | lcalc ], k) t ->
([< scopelang | dcalc | lcalc ], k) t =
fun op ->
fun r op ->
match op with
| Length -> Length
| Log (i, l) -> Log (i, l)
@ -364,7 +370,7 @@ let translate :
| Add_int_int -> Add_int_int
| Add_rat_rat -> Add_rat_rat
| Add_mon_mon -> Add_mon_mon
| Add_dat_dur -> Add_dat_dur
| Add_dat_dur rmode -> Add_dat_dur (Option.value r ~default:rmode)
| Add_dur_dur -> Add_dur_dur
| Sub_int_int -> Sub_int_int
| Sub_rat_rat -> Sub_rat_rat
@ -450,7 +456,7 @@ let resolved_type (op, pos) =
| Add_int_int -> [TInt; TInt], TInt
| Add_rat_rat -> [TRat; TRat], TRat
| Add_mon_mon -> [TMoney; TMoney], TMoney
| Add_dat_dur -> [TDate; TDuration], TDate
| Add_dat_dur _ -> [TDate; TDuration], TDate
| Add_dur_dur -> [TDuration; TDuration], TDuration
| Sub_int_int -> [TInt; TInt], TInt
| Sub_rat_rat -> [TRat; TRat], TRat
@ -511,8 +517,8 @@ let resolve_overload_aux (op : ('a, overloaded) t) (operands : typ_lit list) :
| Add, [TRat; TRat] -> Add_rat_rat, `Straight
| Add, [TMoney; TMoney] -> Add_mon_mon, `Straight
| Add, [TDuration; TDuration] -> Add_dur_dur, `Straight
| Add, [TDate; TDuration] -> Add_dat_dur, `Straight
| Add, [TDuration; TDate] -> Add_dat_dur, `Reversed
| Add, [TDate; TDuration] -> Add_dat_dur AbortOnRound, `Straight
| Add, [TDuration; TDate] -> Add_dat_dur AbortOnRound, `Reversed
| Sub, [TInt; TInt] -> Sub_int_int, `Straight
| Sub, [TRat; TRat] -> Sub_rat_rat, `Straight
| Sub, [TMoney; TMoney] -> Sub_mon_mon, `Straight

View File

@ -51,6 +51,7 @@ val kind_dispatch :
(** Calls one of the supplied functions depending on the kind of the operator *)
val translate :
date_rounding option ->
([< scopelang | dcalc | lcalc ], 'k) t ->
([< scopelang | dcalc | lcalc ], 'k) t
(** An identity function that allows translating an operator between different

View File

@ -188,7 +188,9 @@ let operator_to_string : type a k. (a, k) Op.t -> string = function
| Add_int_int -> "+!"
| Add_rat_rat -> "+."
| Add_mon_mon -> "+$"
| Add_dat_dur -> "+@"
| Add_dat_dur AbortOnRound -> "+@"
| Add_dat_dur RoundUp -> "+@u"
| Add_dat_dur RoundDown -> "+@d"
| Add_dur_dur -> "+^"
| Sub -> "-"
| Sub_int_int -> "-!"

View File

@ -586,6 +586,7 @@ type scope_use_item =
| Definition of definition
| Assertion of assertion
| MetaAssertion of meta_assertion
| DateRounding of variation_typ Marked.pos
[@@deriving
visitors
{

File diff suppressed because it is too large Load Diff

View File

@ -496,6 +496,17 @@ let scope_item :=
Definition d, Marked.get_mark (Shared_ast.RuleName.get_info d.definition_id)
}
| ASSERTION ; contents = addpos(assertion) ; <>
| DATE ; i = LIDENT ; v = addpos(variation_type) ;
{
(* Round is a builtin, we need to check which one it is *)
match Localisation.lex_builtin i with
| Some Round ->
DateRounding(v), Marked.get_mark v
| _ ->
Errors.raise_spanned_error
(Pos.from_lpos $sloc)
"Expected round"
}
let struct_scope_base :=
| DATA ; i = lident ;

View File

@ -124,7 +124,8 @@ let date_of_year (year : int) = Runtime.date_of_numbers year 1 1
defined here as Jan 1, 1900 **)
let nb_days_to_date (nb : int) : string =
Runtime.date_to_string
(Runtime.Oper.o_add_dat_dur base_day (Runtime.duration_of_numbers 0 0 nb))
(Runtime.Oper.o_add_dat_dur AbortOnRound base_day
(Runtime.duration_of_numbers 0 0 nb))
(** [print_z3model_expr] pretty-prints the value [e] given by a Z3 model
according to the Catala type [ty], corresponding to [e] **)
@ -541,7 +542,8 @@ let rec translate_op :
| And, _ -> app Boolean.mk_and
| Or, _ -> app Boolean.mk_or
| Xor, _ -> app2 Boolean.mk_xor
| (Add_int_int | Add_rat_rat | Add_mon_mon | Add_dat_dur | Add_dur_dur), _ ->
| (Add_int_int | Add_rat_rat | Add_mon_mon | Add_dat_dur _ | Add_dur_dur), _
->
app Arithmetic.mk_add
| ( ( Sub_int_int | Sub_rat_rat | Sub_mon_mon | Sub_dat_dat | Sub_dat_dur
| Sub_dur_dur ),

25
date.catala_en Normal file
View File

@ -0,0 +1,25 @@
```catala
declaration scope AgeIsLessThan:
input birthday content date
input currentday content date
input years content duration
output r content boolean
scope AgeIsLessThan:
definition r equals birthday + years <= currentday
date round increasing
declaration scope Test:
age scope AgeIsLessThan
internal bday content date
internal today content date
scope Test:
definition bday equals |2000-02-29|
definition today equals |2018-03-01|
definition age.birthday equals bday
definition age.currentday equals today
definition age.years equals 18 year
assertion age.r
# assertion bday + 18 year <= today
```

32
date.catala_fr Normal file
View File

@ -0,0 +1,32 @@
```catala
déclaration champ d'application CalculAge:
entrée birthday contenu date
entrée currentday contenu date
entrée années contenu durée
résultat r contenu booléen
champ d'application CalculAge:
définition r égal à birthday + années <= currentday
date arrondi croissant
déclaration champ d'application Test:
age champ d'application CalculAge
age2 champ d'application CalculAge
interne bday contenu date
interne oops contenu date
interne today contenu date
champ d'application Test:
définition bday égal à |2000-02-29|
définition today égal à |2018-03-01|
définition oops égal à |2018-02-28|
définition age.birthday égal à bday
définition age.currentday égal à today
définition age.années égal à 18 an
assertion age.r
définition age2.birthday égal à bday
définition age2.currentday égal à oops
définition age2.années égal à 18 an
assertion non age2.r
# assertion bday + 18 an <= today
```

View File

@ -203,8 +203,11 @@ exception cas_base_l822_4 règle condition_logement_location_tiers
selon ménage.logement.loué_ou_sous_loué_à_des_tiers sous forme
-- LouéOuSousLouéÀDesTiers.Non: vrai
-- LouéOuSousLouéÀDesTiers.Oui de personne:
personne.date_naissance_personne_sous_location + 30 an >
date_courante ou
(résultat de CalculAgeSupStrict avec
{ -- date_naissance: personne.date_naissance_personne_sous_location
-- date_courante: date_courante
-- années: 30 an }).r
ou
personne.conforme_article_l442_1
conséquence rempli
```
@ -943,6 +946,7 @@ champ d'application ÉligibilitéAllocationLogement:
= 0
et
(selon ménage.situation_familiale sous forme
# VERIF: opération ambiguë
-- Mariés de date_mariage : date_courante <= date_mariage + durée_l841_1_3
-- n'importe quel: faux)
conséquence rempli

View File

@ -1148,7 +1148,10 @@ champ d'application ÉligibilitéAidesPersonnelleLogement:
règle prise_en_compte_personne_à_charge de personne_à_charge sous condition
selon personne_à_charge sous forme
-- EnfantÀCharge de enfant:
enfant.date_de_naissance + 21 an > date_courante
(résultat de CalculAgeSupStrict avec
{ -- date_naissance: enfant.date_de_naissance
-- date_courante: date_courante
-- années: 21 an }).r
-- AutrePersonneÀCharge de parent: faux
conséquence rempli
```
@ -1177,12 +1180,17 @@ champ d'application ÉligibilitéAidesPersonnelleLogement:
parent.ressources <=
plafond_individuel_l815_9_sécu * 1,25 et
(
# VERIF: parent.date_naissance + âge_l351_8_1_sécu est ambiguë, à détecter
(parent.date_naissance +
âge_l351_8_1_sécu <= date_courante ou
(parent.titulaire_allocation_personne_âgée et
parent.date_naissance + 65 an <=
date_courante)
(résultat de CalculAgeInfEq avec
{ -- date_naissance: parent.date_naissance
-- date_courante: date_courante
-- années: 65 an }).r
)
) ou
# VERIF: parent.date_naissance + âge_l161_17_2_sécu est ambiguë, à détecter
(parent.date_naissance +
âge_l161_17_2_sécu <= date_courante et
parent.bénéficiaire_l161_19_l351_8_l643_3_sécu)
@ -2075,6 +2083,7 @@ champ d'application ÉligibilitéPrimeDeDéménagement:
-- AvantPremierJourMoisCivilTroisièmeMoisDeGrossesse: faux
-- AprèsPremierJourMoisCivilTroisièmeMoisDeGrossesse: vrai
-- DateDeNaissance de date_naissance:
# VERIF: ambigü
date_courante <=
((premier_jour_du_mois de (date_naissance + 2 an))) + (-1 jour))
)

View File

@ -9,4 +9,24 @@ déclaration énumération Collectivité :
-- Métropole
-- SaintPierreEtMiquelon
-- Mayotte
déclaration champ d'application CalculAgeInfEq:
entrée date_naissance contenu date
entrée date_courante contenu date
entrée années contenu durée
résultat r contenu booléen
champ d'application CalculAgeInfEq:
définition r égal à date_naissance + années <= date_courante
date arrondi croissant
déclaration champ d'application CalculAgeSupStrict:
entrée date_naissance contenu date
entrée date_courante contenu date
entrée années contenu durée
résultat r contenu booléen
champ d'application CalculAgeSupStrict:
définition r égal à date_naissance + années > date_courante
date arrondi croissant
```

File diff suppressed because it is too large Load Diff

View File

@ -2145,6 +2145,31 @@ class type base_mensuelle_allocations_familiales =
base_mensuelle_allocations_familiales##.montant
}
class type calcul_age_inf_eq =
object method r: bool Js.t Js.readonly_prop
end
let calcul_age_inf_eq_to_jsoo (calcul_age_inf_eq : CalculAgeInfEq.t)
: calcul_age_inf_eq Js.t = object%js
val r = Js.bool calcul_age_inf_eq.r
end
let calcul_age_inf_eq_of_jsoo
(calcul_age_inf_eq : calcul_age_inf_eq Js.t) : CalculAgeInfEq.t =
{r = Js.to_bool calcul_age_inf_eq##.r
}
class type calcul_age_sup_strict =
object method r: bool Js.t Js.readonly_prop
end
let calcul_age_sup_strict_to_jsoo (calcul_age_sup_strict
: CalculAgeSupStrict.t) : calcul_age_sup_strict Js.t =
object%js
val r = Js.bool calcul_age_sup_strict.r
end
let calcul_age_sup_strict_of_jsoo
(calcul_age_sup_strict : calcul_age_sup_strict Js.t) :
CalculAgeSupStrict.t = {r = Js.to_bool calcul_age_sup_strict##.r
}
class type smic =
object method brutHoraire: Js.number Js.t Js.readonly_prop
end
@ -4440,6 +4465,54 @@ class type base_mensuelle_allocations_familiales_in =
base_mensuelle_allocations_familiales_in##.dateCouranteIn
}
class type calcul_age_inf_eq_in =
object
method dateNaissanceIn: Js.js_string Js.t Js.readonly_prop
method dateCouranteIn: Js.js_string Js.t Js.readonly_prop
method anneesIn: Runtime_jsoo.Runtime.duration Js.t Js.readonly_prop
end
let calcul_age_inf_eq_in_to_jsoo (calcul_age_inf_eq_in
: CalculAgeInfEqIn.t) : calcul_age_inf_eq_in Js.t =
object%js
val dateNaissanceIn =
date_to_jsoo calcul_age_inf_eq_in.date_naissance_in
val dateCouranteIn = date_to_jsoo calcul_age_inf_eq_in.date_courante_in
val anneesIn = duration_to_jsoo calcul_age_inf_eq_in.annees_in
end
let calcul_age_inf_eq_in_of_jsoo
(calcul_age_inf_eq_in : calcul_age_inf_eq_in Js.t) : CalculAgeInfEqIn.t =
{
date_naissance_in = date_of_jsoo calcul_age_inf_eq_in##.dateNaissanceIn;
date_courante_in = date_of_jsoo calcul_age_inf_eq_in##.dateCouranteIn;
annees_in = duration_of_jsoo calcul_age_inf_eq_in##.anneesIn
}
class type calcul_age_sup_strict_in =
object
method dateNaissanceIn: Js.js_string Js.t Js.readonly_prop
method dateCouranteIn: Js.js_string Js.t Js.readonly_prop
method anneesIn: Runtime_jsoo.Runtime.duration Js.t Js.readonly_prop
end
let calcul_age_sup_strict_in_to_jsoo (calcul_age_sup_strict_in
: CalculAgeSupStrictIn.t) : calcul_age_sup_strict_in Js.t =
object%js
val dateNaissanceIn =
date_to_jsoo calcul_age_sup_strict_in.date_naissance_in
val dateCouranteIn =
date_to_jsoo calcul_age_sup_strict_in.date_courante_in
val anneesIn = duration_to_jsoo calcul_age_sup_strict_in.annees_in
end
let calcul_age_sup_strict_in_of_jsoo
(calcul_age_sup_strict_in : calcul_age_sup_strict_in Js.t) :
CalculAgeSupStrictIn.t =
{
date_naissance_in =
date_of_jsoo calcul_age_sup_strict_in##.dateNaissanceIn;
date_courante_in =
date_of_jsoo calcul_age_sup_strict_in##.dateCouranteIn;
annees_in = duration_of_jsoo calcul_age_sup_strict_in##.anneesIn
}
class type smic_in =
object
method dateCouranteIn: Js.js_string Js.t Js.readonly_prop
@ -4556,6 +4629,23 @@ let base_mensuelle_allocations_familiales
|> base_mensuelle_allocations_familiales_to_jsoo
let calcul_age_inf_eq (calcul_age_inf_eq_in : calcul_age_inf_eq_in Js.t)
: calcul_age_inf_eq Js.t =
calcul_age_inf_eq_in
|> calcul_age_inf_eq_in_of_jsoo
|> calcul_age_inf_eq
|> calcul_age_inf_eq_to_jsoo
let calcul_age_sup_strict
(calcul_age_sup_strict_in : calcul_age_sup_strict_in Js.t)
: calcul_age_sup_strict Js.t =
calcul_age_sup_strict_in
|> calcul_age_sup_strict_in_of_jsoo
|> calcul_age_sup_strict
|> calcul_age_sup_strict_to_jsoo
let smic (smic_in : smic_in Js.t)
: smic Js.t =
smic_in |> smic_in_of_jsoo |> smic |> smic_to_jsoo
@ -4588,15 +4678,6 @@ let calcul_aide_personnalisee_logement_accession_propriete
|> calcul_aide_personnalisee_logement_accession_propriete_to_jsoo
let eligibilite_aides_personnelle_logement
(eligibilite_aides_personnelle_logement_in : eligibilite_aides_personnelle_logement_in Js.t)
: eligibilite_aides_personnelle_logement Js.t =
eligibilite_aides_personnelle_logement_in
|> eligibilite_aides_personnelle_logement_in_of_jsoo
|> eligibilite_aides_personnelle_logement
|> eligibilite_aides_personnelle_logement_to_jsoo
let ressources_aides_personnelle_logement
(ressources_aides_personnelle_logement_in : ressources_aides_personnelle_logement_in Js.t)
: ressources_aides_personnelle_logement Js.t =
@ -4606,6 +4687,15 @@ let ressources_aides_personnelle_logement
|> ressources_aides_personnelle_logement_to_jsoo
let eligibilite_aides_personnelle_logement
(eligibilite_aides_personnelle_logement_in : eligibilite_aides_personnelle_logement_in Js.t)
: eligibilite_aides_personnelle_logement Js.t =
eligibilite_aides_personnelle_logement_in
|> eligibilite_aides_personnelle_logement_in_of_jsoo
|> eligibilite_aides_personnelle_logement
|> eligibilite_aides_personnelle_logement_to_jsoo
let eligibilite_prestations_familiales
(eligibilite_prestations_familiales_in : eligibilite_prestations_familiales_in Js.t)
: eligibilite_prestations_familiales Js.t =
@ -4730,6 +4820,12 @@ let _ =
method baseMensuelleAllocationsFamiliales : (base_mensuelle_allocations_familiales_in Js.t -> base_mensuelle_allocations_familiales Js.t) Js.callback =
Js.wrap_callback base_mensuelle_allocations_familiales
method calculAgeInfEq : (calcul_age_inf_eq_in Js.t -> calcul_age_inf_eq Js.t) Js.callback =
Js.wrap_callback calcul_age_inf_eq
method calculAgeSupStrict : (calcul_age_sup_strict_in Js.t -> calcul_age_sup_strict Js.t) Js.callback =
Js.wrap_callback calcul_age_sup_strict
method smic : (smic_in Js.t -> smic Js.t) Js.callback =
Js.wrap_callback smic
@ -4743,12 +4839,12 @@ let _ =
Js.wrap_callback
calcul_aide_personnalisee_logement_accession_propriete
method eligibiliteAidesPersonnelleLogement : (eligibilite_aides_personnelle_logement_in Js.t -> eligibilite_aides_personnelle_logement Js.t) Js.callback =
Js.wrap_callback eligibilite_aides_personnelle_logement
method ressourcesAidesPersonnelleLogement : (ressources_aides_personnelle_logement_in Js.t -> ressources_aides_personnelle_logement Js.t) Js.callback =
Js.wrap_callback ressources_aides_personnelle_logement
method eligibiliteAidesPersonnelleLogement : (eligibilite_aides_personnelle_logement_in Js.t -> eligibilite_aides_personnelle_logement Js.t) Js.callback =
Js.wrap_callback eligibilite_aides_personnelle_logement
method eligibilitePrestationsFamiliales : (eligibilite_prestations_familiales_in Js.t -> eligibilite_prestations_familiales Js.t) Js.callback =
Js.wrap_callback eligibilite_prestations_familiales

View File

@ -144,6 +144,20 @@ let embed_allocations_familiales (x: AllocationsFamiliales.t) : runtime_value =
[("montant_versé", embed_money x.AllocationsFamiliales.montant_verse)])
module CalculAgeInfEq = struct
type t = {r: bool}
end
let embed_calcul_age_inf_eq (x: CalculAgeInfEq.t) : runtime_value =
Struct(["CalculAgeInfEq"], [("r", embed_bool x.CalculAgeInfEq.r)])
module CalculAgeSupStrict = struct
type t = {r: bool}
end
let embed_calcul_age_sup_strict (x: CalculAgeSupStrict.t) : runtime_value =
Struct(["CalculAgeSupStrict"], [("r", embed_bool x.CalculAgeSupStrict.r)])
module Smic = struct
type t = {brut_horaire: money}
end
@ -310,6 +324,38 @@ let embed_allocations_familiales_in (x: AllocationsFamilialesIn.t) : runtime_val
x.AllocationsFamilialesIn.avait_enfant_a_charge_avant_1er_janvier_2012_in)])
module CalculAgeInfEqIn = struct
type t = {
date_naissance_in: date;
date_courante_in: date;
annees_in: duration
}
end
let embed_calcul_age_inf_eq_in (x: CalculAgeInfEqIn.t) : runtime_value =
Struct(["CalculAgeInfEq_in"],
[("date_naissance_in", embed_date
x.CalculAgeInfEqIn.date_naissance_in);
("date_courante_in", embed_date
x.CalculAgeInfEqIn.date_courante_in);
("années_in", embed_duration x.CalculAgeInfEqIn.annees_in)])
module CalculAgeSupStrictIn = struct
type t = {
date_naissance_in: date;
date_courante_in: date;
annees_in: duration
}
end
let embed_calcul_age_sup_strict_in (x: CalculAgeSupStrictIn.t) : runtime_value =
Struct(["CalculAgeSupStrict_in"],
[("date_naissance_in", embed_date
x.CalculAgeSupStrictIn.date_naissance_in);
("date_courante_in", embed_date
x.CalculAgeSupStrictIn.date_courante_in);
("années_in", embed_duration x.CalculAgeSupStrictIn.annees_in)])
module SmicIn = struct
type t = {date_courante_in: date; residence_in: Collectivite.t}
end
@ -437,6 +483,64 @@ let enfant_le_plus_age (enfant_le_plus_age_in: EnfantLePlusAgeIn.t) : EnfantLePl
"Prologue"]})))) in
{EnfantLePlusAge.le_plus_age = le_plus_age_}
let calcul_age_inf_eq (calcul_age_inf_eq_in: CalculAgeInfEqIn.t) : CalculAgeInfEq.t =
let date_naissance_: date = calcul_age_inf_eq_in.CalculAgeInfEqIn.date_naissance_in in
let date_courante_: date = calcul_age_inf_eq_in.CalculAgeInfEqIn.date_courante_in in
let annees_: duration = calcul_age_inf_eq_in.CalculAgeInfEqIn.annees_in in
let r_: bool = (log_variable_definition ["CalculAgeInfEq"; "r"]
(embed_bool) (
try
(handle_default
{filename = "examples/allocations_familiales/../smic/../prologue_france/prologue.catala_fr";
start_line=17; start_column=12; end_line=17; end_column=13;
law_headings=["Prologue";
"Montant du salaire minimum de croissance"]} (
[||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/allocations_familiales/../smic/../prologue_france/prologue.catala_fr";
start_line=20; start_column=14; end_line=20; end_column=15;
law_headings=["Prologue";
"Montant du salaire minimum de croissance"]}
true))
(fun (_: unit) ->
o_lte_dat_dat (o_add_dat_dur(u) date_naissance_ annees_)
date_courante_))
with
EmptyError -> (raise (NoValueProvided
{filename = "examples/allocations_familiales/../smic/../prologue_france/prologue.catala_fr";
start_line=17; start_column=12; end_line=17; end_column=13;
law_headings=["Prologue"; "Montant du salaire minimum de croissance"]})))) in
{CalculAgeInfEq.r = r_}
let calcul_age_sup_strict (calcul_age_sup_strict_in: CalculAgeSupStrictIn.t) : CalculAgeSupStrict.t =
let date_naissance_: date = calcul_age_sup_strict_in.CalculAgeSupStrictIn.date_naissance_in in
let date_courante_: date = calcul_age_sup_strict_in.CalculAgeSupStrictIn.date_courante_in in
let annees_: duration = calcul_age_sup_strict_in.CalculAgeSupStrictIn.annees_in in
let r_: bool = (log_variable_definition ["CalculAgeSupStrict"; "r"]
(embed_bool) (
try
(handle_default
{filename = "examples/allocations_familiales/../smic/../prologue_france/prologue.catala_fr";
start_line=27; start_column=12; end_line=27; end_column=13;
law_headings=["Prologue";
"Montant du salaire minimum de croissance"]} (
[||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/allocations_familiales/../smic/../prologue_france/prologue.catala_fr";
start_line=30; start_column=14; end_line=30; end_column=15;
law_headings=["Prologue";
"Montant du salaire minimum de croissance"]}
true))
(fun (_: unit) ->
o_gt_dat_dat (o_add_dat_dur(u) date_naissance_ annees_)
date_courante_))
with
EmptyError -> (raise (NoValueProvided
{filename = "examples/allocations_familiales/../smic/../prologue_france/prologue.catala_fr";
start_line=27; start_column=12; end_line=27; end_column=13;
law_headings=["Prologue"; "Montant du salaire minimum de croissance"]})))) in
{CalculAgeSupStrict.r = r_}
let smic (smic_in: SmicIn.t) : Smic.t =
let date_courante_: date = smic_in.SmicIn.date_courante_in in
let residence_: Collectivite.t = smic_in.SmicIn.residence_in in
@ -1357,7 +1461,7 @@ let prestations_familiales (prestations_familiales_in: PrestationsFamilialesIn.t
(enfant_.Enfant.remuneration_mensuelle)
plafond_l512_3_2_)
(o_gt_dat_dat
(o_add_dat_dur
(o_add_dat_dur(a)
(enfant_.Enfant.date_de_naissance)
age_l512_3_2_)
date_courante_)))))
@ -2008,7 +2112,8 @@ let allocations_familiales (allocations_familiales_in: AllocationsFamilialesIn.t
"Partie réglementaire - Décrets en Conseil d'Etat";
"Code de la sécurité sociale"]}
(o_lte_dat_dat
(o_add_dat_dur (enfant_.Enfant.date_de_naissance)
(o_add_dat_dur(a)
(enfant_.Enfant.date_de_naissance)
(duration_of_numbers (11) (0) (0)))
(date_of_numbers (2008) (4) (30)))))
(fun (_: unit) ->
@ -2503,7 +2608,7 @@ let allocations_familiales (allocations_familiales_in: AllocationsFamilialesIn.t
(o_and
(o_lt_dur_dur
(o_sub_dat_dat
(o_add_dat_dur
(o_add_dat_dur(a)
(enfant_.Enfant.date_de_naissance)
prestations_familiales_dot_age_l512_3_2_)
date_courante_)
@ -3604,7 +3709,7 @@ let allocations_familiales (allocations_familiales_in: AllocationsFamilialesIn.t
enfants_a_charge_droit_ouvert_prestation_familiale_)
nombre_enfants_alinea_2_l521_3_)
(o_lte_dat_dat
(o_add_dat_dur
(o_add_dat_dur(a)
(enfant_.Enfant.date_de_naissance)
((log_end_call
["AllocationsFamiliales";
@ -3649,7 +3754,7 @@ let allocations_familiales (allocations_familiales_in: AllocationsFamilialesIn.t
"est_enfant_le_plus_âgé"; "input0"]
(embed_enfant) enfant_))))))))
(o_lte_dat_dat
(o_add_dat_dur
(o_add_dat_dur(a)
(enfant_.Enfant.date_de_naissance)
((log_end_call
["AllocationsFamiliales";
@ -4844,12 +4949,12 @@ let allocations_familiales (allocations_familiales_in: AllocationsFamilialesIn.t
(integer_of_string "1"))
(o_and
(o_lte_dat_dat
(o_add_dat_dur
(o_add_dat_dur(a)
(enfant_.Enfant.date_de_naissance)
(duration_of_numbers (11) (0) (0)))
date_courante_)
(o_gt_dat_dat
(o_add_dat_dur
(o_add_dat_dur(a)
(enfant_.Enfant.date_de_naissance)
(duration_of_numbers (16) (0) (0)))
date_courante_)))))))
@ -4896,7 +5001,7 @@ let allocations_familiales (allocations_familiales_in: AllocationsFamilialesIn.t
enfants_a_charge_droit_ouvert_prestation_familiale_)
(integer_of_string "1"))
(o_lte_dat_dat
(o_add_dat_dur
(o_add_dat_dur(a)
(enfant_.Enfant.date_de_naissance)
(duration_of_numbers (16) (0) (0)))
date_courante_))))))
@ -5339,14 +5444,14 @@ let interface_allocations_familiales (interface_allocations_familiales_in: Inter
Enfant.obligation_scolaire =
( if
(o_gte_dat_dat
(o_add_dat_dur
(o_add_dat_dur(a)
(enfant_.EnfantEntree.d_date_de_naissance)
(duration_of_numbers (3) (0) (0)))
i_date_courante_) then
(SituationObligationScolaire.Avant ()) else
( if
(o_gte_dat_dat
(o_add_dat_dur
(o_add_dat_dur(a)
(enfant_.EnfantEntree.d_date_de_naissance)
(duration_of_numbers (16) (0) (0)))
i_date_courante_) then

View File

@ -376,6 +376,31 @@ class type allocations_familiales =
allocations_familiales##.montantVerse
}
class type calcul_age_inf_eq =
object method r: bool Js.t Js.readonly_prop
end
let calcul_age_inf_eq_to_jsoo (calcul_age_inf_eq : CalculAgeInfEq.t)
: calcul_age_inf_eq Js.t = object%js
val r = Js.bool calcul_age_inf_eq.r
end
let calcul_age_inf_eq_of_jsoo
(calcul_age_inf_eq : calcul_age_inf_eq Js.t) : CalculAgeInfEq.t =
{r = Js.to_bool calcul_age_inf_eq##.r
}
class type calcul_age_sup_strict =
object method r: bool Js.t Js.readonly_prop
end
let calcul_age_sup_strict_to_jsoo (calcul_age_sup_strict
: CalculAgeSupStrict.t) : calcul_age_sup_strict Js.t =
object%js
val r = Js.bool calcul_age_sup_strict.r
end
let calcul_age_sup_strict_of_jsoo
(calcul_age_sup_strict : calcul_age_sup_strict Js.t) :
CalculAgeSupStrict.t = {r = Js.to_bool calcul_age_sup_strict##.r
}
class type smic =
object method brutHoraire: Js.number Js.t Js.readonly_prop
end
@ -677,6 +702,54 @@ class type allocations_familiales_in =
allocations_familiales_in##.avaitEnfantAChargeAvant1erJanvier2012In
}
class type calcul_age_inf_eq_in =
object
method dateNaissanceIn: Js.js_string Js.t Js.readonly_prop
method dateCouranteIn: Js.js_string Js.t Js.readonly_prop
method anneesIn: Runtime_jsoo.Runtime.duration Js.t Js.readonly_prop
end
let calcul_age_inf_eq_in_to_jsoo (calcul_age_inf_eq_in
: CalculAgeInfEqIn.t) : calcul_age_inf_eq_in Js.t =
object%js
val dateNaissanceIn =
date_to_jsoo calcul_age_inf_eq_in.date_naissance_in
val dateCouranteIn = date_to_jsoo calcul_age_inf_eq_in.date_courante_in
val anneesIn = duration_to_jsoo calcul_age_inf_eq_in.annees_in
end
let calcul_age_inf_eq_in_of_jsoo
(calcul_age_inf_eq_in : calcul_age_inf_eq_in Js.t) : CalculAgeInfEqIn.t =
{
date_naissance_in = date_of_jsoo calcul_age_inf_eq_in##.dateNaissanceIn;
date_courante_in = date_of_jsoo calcul_age_inf_eq_in##.dateCouranteIn;
annees_in = duration_of_jsoo calcul_age_inf_eq_in##.anneesIn
}
class type calcul_age_sup_strict_in =
object
method dateNaissanceIn: Js.js_string Js.t Js.readonly_prop
method dateCouranteIn: Js.js_string Js.t Js.readonly_prop
method anneesIn: Runtime_jsoo.Runtime.duration Js.t Js.readonly_prop
end
let calcul_age_sup_strict_in_to_jsoo (calcul_age_sup_strict_in
: CalculAgeSupStrictIn.t) : calcul_age_sup_strict_in Js.t =
object%js
val dateNaissanceIn =
date_to_jsoo calcul_age_sup_strict_in.date_naissance_in
val dateCouranteIn =
date_to_jsoo calcul_age_sup_strict_in.date_courante_in
val anneesIn = duration_to_jsoo calcul_age_sup_strict_in.annees_in
end
let calcul_age_sup_strict_in_of_jsoo
(calcul_age_sup_strict_in : calcul_age_sup_strict_in Js.t) :
CalculAgeSupStrictIn.t =
{
date_naissance_in =
date_of_jsoo calcul_age_sup_strict_in##.dateNaissanceIn;
date_courante_in =
date_of_jsoo calcul_age_sup_strict_in##.dateCouranteIn;
annees_in = duration_of_jsoo calcul_age_sup_strict_in##.anneesIn
}
class type smic_in =
object
method dateCouranteIn: Js.js_string Js.t Js.readonly_prop
@ -797,6 +870,23 @@ let enfant_le_plus_age (enfant_le_plus_age_in : enfant_le_plus_age_in Js.t)
|> enfant_le_plus_age_to_jsoo
let calcul_age_inf_eq (calcul_age_inf_eq_in : calcul_age_inf_eq_in Js.t)
: calcul_age_inf_eq Js.t =
calcul_age_inf_eq_in
|> calcul_age_inf_eq_in_of_jsoo
|> calcul_age_inf_eq
|> calcul_age_inf_eq_to_jsoo
let calcul_age_sup_strict
(calcul_age_sup_strict_in : calcul_age_sup_strict_in Js.t)
: calcul_age_sup_strict Js.t =
calcul_age_sup_strict_in
|> calcul_age_sup_strict_in_of_jsoo
|> calcul_age_sup_strict
|> calcul_age_sup_strict_to_jsoo
let smic (smic_in : smic_in Js.t)
: smic Js.t =
smic_in |> smic_in_of_jsoo |> smic |> smic_to_jsoo
@ -848,6 +938,12 @@ let _ =
method enfantLePlusAge : (enfant_le_plus_age_in Js.t -> enfant_le_plus_age Js.t) Js.callback =
Js.wrap_callback enfant_le_plus_age
method calculAgeInfEq : (calcul_age_inf_eq_in Js.t -> calcul_age_inf_eq Js.t) Js.callback =
Js.wrap_callback calcul_age_inf_eq
method calculAgeSupStrict : (calcul_age_sup_strict_in Js.t -> calcul_age_sup_strict Js.t) Js.callback =
Js.wrap_callback calcul_age_sup_strict
method smic : (smic_in Js.t -> smic Js.t) Js.callback =
Js.wrap_callback smic

View File

@ -19,6 +19,7 @@ type money = Z.t
type integer = Z.t
type decimal = Q.t
type date = Dates_calc.Dates.date
type date_rounding = Dates_calc.Dates.date_rounding
type duration = Dates_calc.Dates.period
type 'a eoption = ENone of unit | ESome of 'a
@ -637,7 +638,7 @@ module Oper = struct
let o_add_int_int i1 i2 = Z.add i1 i2
let o_add_rat_rat i1 i2 = Q.add i1 i2
let o_add_mon_mon m1 m2 = Z.add m1 m2
let o_add_dat_dur da du = Dates_calc.Dates.add_dates da du
let o_add_dat_dur r da du = Dates_calc.Dates.add_dates ~round:r da du
let o_add_dur_dur = Dates_calc.Dates.add_periods
let o_sub_int_int i1 i2 = Z.sub i1 i2
let o_sub_rat_rat i1 i2 = Q.sub i1 i2

View File

@ -23,6 +23,7 @@ type money
type integer
type decimal
type date
type date_rounding = Dates_calc.Dates.date_rounding
type duration
type source_position = {
@ -314,7 +315,7 @@ module Oper : sig
val o_add_int_int : integer -> integer -> integer
val o_add_rat_rat : decimal -> decimal -> decimal
val o_add_mon_mon : money -> money -> money
val o_add_dat_dur : date -> duration -> date
val o_add_dat_dur : date_rounding -> date -> duration -> date
val o_add_dur_dur : duration -> duration -> duration
val o_sub_int_int : integer -> integer -> integer
val o_sub_rat_rat : decimal -> decimal -> decimal