CatalaLang/catala
1
1
Fork 0
mirror of https://github.com/CatalaLang/catala.git synced 2024-11-08 07:51:43 +03:00
Code Issues Projects Releases Wiki Activity

Add a duration / duration overload

Browse Source 
Interstingly enough, it was already implemented in the Python backend.

Required to implement *pro rata temporis*, which the US tax section 121 does
make use of.

Only allowed for durations expressed in days (as returned by `<date> - <date>`),
of course.
This commit is contained in:
Louis Gesbert 2023-03-06 10:54:51 +01:00
parent 56ac72f57e
commit 42b8adb968
6 changed files with 35 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
compiler/dcalc/interpreter.ml
View File

@ -260,6 +260,8 @@ and evaluate_operator :
LRat (protect o_div_mon_mon x y)
| Div_mon_rat, [LMoney x; LRat y] ->
LMoney (protect o_div_mon_rat x y)
| Div_dur_dur, [LDuration x; LDuration y] ->
LRat (protect o_div_dur_dur x y)
| Lt_int_int, [LInt x; LInt y] -> LBool (o_lt_int_int x y)
| Lt_rat_rat, [LRat x; LRat y] -> LBool (o_lt_rat_rat x y)
| Lt_mon_mon, [LMoney x; LMoney y] -> LBool (o_lt_mon_mon x y)
@ -296,13 +298,13 @@ and evaluate_operator :
| 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 | Lt_int_int | Lt_rat_rat | Lt_mon_mon
| Lt_dat_dat | Lt_dur_dur | Lte_int_int | Lte_rat_rat
| Lte_mon_mon | Lte_dat_dat | Lte_dur_dur | Gt_int_int
| Gt_rat_rat | Gt_mon_mon | Gt_dat_dat | Gt_dur_dur | Gte_int_int
| Gte_rat_rat | Gte_mon_mon | Gte_dat_dat | Gte_dur_dur
| Eq_int_int | Eq_rat_rat | Eq_mon_mon | Eq_dat_dat | Eq_dur_dur
),
| Div_mon_mon | Div_mon_rat | Div_dur_dur | Lt_int_int
| Lt_rat_rat | Lt_mon_mon | Lt_dat_dat | Lt_dur_dur | Lte_int_int
| Lte_rat_rat | Lte_mon_mon | Lte_dat_dat | Lte_dur_dur
| Gt_int_int | Gt_rat_rat | Gt_mon_mon | Gt_dat_dat | Gt_dur_dur
| Gte_int_int | Gte_rat_rat | Gte_mon_mon | Gte_dat_dat
| Gte_dur_dur | Eq_int_int | Eq_rat_rat | Eq_mon_mon | Eq_dat_dat
| Eq_dur_dur ),
_ ) ->
err ()
in

1
compiler/shared_ast/definitions.ml
View File

@ -181,6 +181,7 @@ module Op = struct
| Div_rat_rat : ([< scopelang | dcalc | lcalc ], resolved) t
| Div_mon_rat : ([< scopelang | dcalc | lcalc ], resolved) t
| Div_mon_mon : ([< scopelang | dcalc | lcalc ], resolved) t
| Div_dur_dur : ([< scopelang | dcalc | lcalc ], resolved) t
| Lt : (desugared, overloaded) t
| Lt_int_int : ([< scopelang | dcalc | lcalc ], resolved) t
| Lt_rat_rat : ([< scopelang | dcalc | lcalc ], resolved) t

18
compiler/shared_ast/operator.ml
View File

@ -71,6 +71,7 @@ let name : type a k. (a, k) t -> string = function
| Div_rat_rat -> "o_div_rat_rat"
| Div_mon_mon -> "o_div_mon_mon"
| Div_mon_rat -> "o_div_mon_mon"
| Div_dur_dur -> "o_div_dur_dur"
| Lt -> "o_lt"
| Lt_int_int -> "o_lt_int_int"
| Lt_rat_rat -> "o_lt_rat_rat"
@ -175,6 +176,7 @@ let compare (type a k a2 k2) (t1 : (a, k) t) (t2 : (a2, k2) t) =
| Div_rat_rat, Div_rat_rat
| Div_mon_mon, Div_mon_mon
| Div_mon_rat, Div_mon_rat
| Div_dur_dur, Div_dur_dur
| Lt, Lt
| Lt_int_int, Lt_int_int
| Lt_rat_rat, Lt_rat_rat
@ -257,6 +259,7 @@ let compare (type a k a2 k2) (t1 : (a, k) t) (t2 : (a2, k2) t) =
| Div_rat_rat, _ -> -1 | _, Div_rat_rat -> 1
| Div_mon_mon, _ -> -1 | _, Div_mon_mon -> 1
| Div_mon_rat, _ -> -1 | _, Div_mon_rat -> 1
| Div_dur_dur, _ -> -1 | _, Div_dur_dur -> 1
| Lt, _ -> -1 | _, Lt -> 1
| Lt_int_int, _ -> -1 | _, Lt_int_int -> 1
| Lt_rat_rat, _ -> -1 | _, Lt_rat_rat -> 1
@ -316,12 +319,12 @@ let kind_dispatch :
| 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 | Lt_int_int | Lt_rat_rat | Lt_mon_mon
| Lt_dat_dat | Lt_dur_dur | Lte_int_int | Lte_rat_rat | Lte_mon_mon
| Lte_dat_dat | Lte_dur_dur | Gt_int_int | Gt_rat_rat | Gt_mon_mon
| Gt_dat_dat | Gt_dur_dur | Gte_int_int | Gte_rat_rat | Gte_mon_mon
| Gte_dat_dat | Gte_dur_dur | Eq_int_int | Eq_rat_rat | Eq_mon_mon
| Eq_dat_dat | Eq_dur_dur ) as op ->
| Div_mon_mon | Div_mon_rat | Div_dur_dur | Lt_int_int | Lt_rat_rat
| Lt_mon_mon | Lt_dat_dat | Lt_dur_dur | Lte_int_int | Lte_rat_rat
| Lte_mon_mon | Lte_dat_dat | Lte_dur_dur | Gt_int_int | Gt_rat_rat
| Gt_mon_mon | Gt_dat_dat | Gt_dur_dur | Gte_int_int | Gte_rat_rat
| Gte_mon_mon | Gte_dat_dat | Gte_dur_dur | Eq_int_int | Eq_rat_rat
| Eq_mon_mon | Eq_dat_dat | Eq_dur_dur ) as op ->
resolved op
(* Glorified identity... allowed operators are the same in scopelang, dcalc,
@ -377,6 +380,7 @@ let translate :
| Div_rat_rat -> Div_rat_rat
| Div_mon_mon -> Div_mon_mon
| Div_mon_rat -> Div_mon_rat
| Div_dur_dur -> Div_dur_dur
| Lt_int_int -> Lt_int_int
| Lt_rat_rat -> Lt_rat_rat
| Lt_mon_mon -> Lt_mon_mon
@ -462,6 +466,7 @@ let resolved_type (op, pos) =
| Div_rat_rat -> [TRat; TRat], TRat
| Div_mon_mon -> [TMoney; TMoney], TRat
| Div_mon_rat -> [TMoney; TRat], TMoney
| Div_dur_dur -> [TDuration; TDuration], TRat
| Lt_int_int -> [TInt; TInt], TBool
| Lt_rat_rat -> [TRat; TRat], TBool
| Lt_mon_mon -> [TMoney; TMoney], TBool
@ -524,6 +529,7 @@ let resolve_overload_aux (op : ('a, overloaded) t) (operands : typ_lit list) :
| Div, [TRat; TRat] -> Div_rat_rat, `Straight
| Div, [TMoney; TMoney] -> Div_mon_mon, `Straight
| Div, [TMoney; TRat] -> Div_mon_rat, `Straight
| Div, [TDuration; TDuration] -> Div_dur_dur, `Straight
| Lt, [TInt; TInt] -> Lt_int_int, `Straight
| Lt, [TRat; TRat] -> Lt_rat_rat, `Straight
| Lt, [TMoney; TMoney] -> Lt_mon_mon, `Straight

1
compiler/shared_ast/print.ml
View File

@ -207,6 +207,7 @@ let operator_to_string : type a k. (a, k) Op.t -> string = function
| Div_rat_rat -> "/."
| Div_mon_mon -> "/$"
| Div_mon_rat -> "/$."
| Div_dur_dur -> "/^"
| Lt -> "<"
| Lt_int_int -> "<!"
| Lt_rat_rat -> "<."

11
runtimes/ocaml/runtime.ml
View File

@ -36,7 +36,7 @@ exception EmptyError
exception AssertionFailed of source_position
exception ConflictError of source_position
exception UncomparableDurations
exception IndivisableDurations
exception IndivisibleDurations
exception ImpossibleDate
exception NoValueProvided of source_position
@ -677,6 +677,15 @@ module Oper = struct
let o_div_mon_rat m1 r1 =
if Q.zero = r1 then raise Division_by_zero else o_mult_mon_rat m1 (Q.inv r1)
let o_div_dur_dur d1 d2 =
let i1, i2 =
try
( integer_of_int (Dates_calc.Dates.period_to_days d1),
integer_of_int (Dates_calc.Dates.period_to_days d2) )
with Dates_calc.Dates.AmbiguousComputation -> raise IndivisibleDurations
in
o_div_int_int i1 i2
let o_lt_int_int i1 i2 = Z.compare i1 i2 < 0
let o_lt_rat_rat i1 i2 = Q.compare i1 i2 < 0
let o_lt_mon_mon m1 m2 = Z.compare m1 m2 < 0

3
runtimes/ocaml/runtime.mli
View File

@ -43,7 +43,7 @@ exception EmptyError
exception AssertionFailed of source_position
exception ConflictError of source_position
exception UncomparableDurations
exception IndivisableDurations
exception IndivisibleDurations
exception ImpossibleDate
exception NoValueProvided of source_position
@ -330,6 +330,7 @@ module Oper : sig
val o_div_rat_rat : decimal -> decimal -> decimal
val o_div_mon_mon : money -> money -> decimal
val o_div_mon_rat : money -> decimal -> money
val o_div_dur_dur : duration -> duration -> decimal
val o_lt_int_int : integer -> integer -> bool
val o_lt_rat_rat : decimal -> decimal -> bool
val o_lt_mon_mon : money -> money -> bool