add support for duration multiplication

Signed-off-by: Jonathan Protzenko <protz@microsoft.com>

compiler/dcalc/interpreter.ml

@@ -119,6 +119,8 @@ let rec evaluate_operator
               "Cannot divide durations that cannot be converted to a precise \
                number of days")
         op
+    | A.Binop (A.Mult KDuration), [ELit (LDuration d1); ELit (LInt i1)] ->
+      A.ELit (LDuration Runtime.(d1 *^ i1))
     | A.Binop (A.Lt KInt), [ELit (LInt i1); ELit (LInt i2)] ->
       A.ELit (LBool Runtime.(i1 <! i2))
     | A.Binop (A.Lte KInt), [ELit (LInt i1); ELit (LInt i2)] ->

compiler/dcalc/typing.ml

@@ -169,6 +169,7 @@ let op_type (op : A.operator Pos.marked) : typ Pos.marked UnionFind.elem =
   | A.Binop (A.Sub KDate) -> arr dat (arr dat dut)
   | A.Binop (A.Add KDate) -> arr dat (arr dut dat)
   | A.Binop (A.Div KDuration) -> arr dut (arr dut rt)
+  | A.Binop (A.Mult KDuration) -> arr dut (arr it dut)
   | A.Binop (A.Div KMoney) -> arr mt (arr mt rt)
   | A.Binop (A.Mult KMoney) -> arr mt (arr rt mt)
   | A.Binop (A.Lt KInt | A.Lte KInt | A.Gt KInt | A.Gte KInt) ->
@@ -200,7 +201,7 @@ let op_type (op : A.operator Pos.marked) : typ Pos.marked UnionFind.elem =
   | A.Unop A.RoundMoney -> arr mt mt
   | A.Unop A.RoundDecimal -> arr rt rt
   | A.Unop A.IntToRat -> arr it rt
-  | Binop (Mult (KDate | KDuration)) | Binop (Div KDate) | Unop (Minus KDate) ->
+  | Binop (Mult KDate) | Binop (Div KDate) | Unop (Minus KDate) ->
     Errors.raise_spanned_error pos "This operator is not available!"
 
 let rec ast_to_typ (ty : A.typ) : typ =

compiler/runtime.ml

@@ -291,6 +291,10 @@ let ( /^ ) (d1 : duration) (d2 : duration) : decimal =
     if 0 = nb_day2 then raise Division_by_zero else Q.(nb_day1 // nb_day2)
   with CalendarLib.Date.Period.Not_computable -> raise IndivisableDurations
 
+let ( *^ ) (d1 : duration) (i1 : integer) : duration =
+  let nb_day = CalendarLib.Date.Period.nb_days d1 in
+  CalendarLib.Date.Period.make 0 0 (nb_day * integer_to_int i1)
+
 let ( <=$ ) (m1 : money) (m2 : money) : bool = Z.compare m1 m2 <= 0
 let ( >=$ ) (m1 : money) (m2 : money) : bool = Z.compare m1 m2 >= 0
 let ( <$ ) (m1 : money) (m2 : money) : bool = Z.compare m1 m2 < 0

compiler/runtime.mli

@@ -214,6 +214,7 @@ val ( /^ ) : duration -> duration -> decimal
 (** @raise Division_by_zero
     @raise IndivisableDurations *)
 
+val ( *^ ) : duration -> integer -> duration
 val ( ~-^ ) : duration -> duration
 val ( =^ ) : duration -> duration -> bool
 

compiler/surface/lexer.cppo.ml

@@ -622,6 +622,9 @@ let rec lex_code (lexbuf : lexbuf) : token =
   | "/^" ->
       L.update_acc lexbuf;
       DIVDURATION
+  | "*^" ->
+      L.update_acc lexbuf;
+      MULDURATION
   | "<=", MR_MONEY_OP_SUFFIX ->
       L.update_acc lexbuf;
       LESSER_EQUAL_MONEY

compiler/surface/parser.mly

@@ -230,6 +230,7 @@ mult_op:
 | MULTMONEY { (Mult KMoney, Pos.from_lpos $sloc) }
 | DIVMONEY { (Div KMoney, Pos.from_lpos $sloc) }
 | DIVDURATION { (Div KDuration, Pos.from_lpos $sloc) }
+| MULDURATION { (Mult KDuration, Pos.from_lpos $sloc) }
 
 mult_expression:
 | e =  unop_expression { e }

compiler/surface/tokens.mly

@@ -50,7 +50,7 @@
 %token PLUS MINUS MULT DIV
 %token PLUSDEC MINUSDEC MULTDEC DIVDEC
 %token PLUSMONEY MINUSMONEY MULTMONEY DIVMONEY
-%token MINUSDATE PLUSDATE PLUSDURATION MINUSDURATION DIVDURATION
+%token MINUSDATE PLUSDATE PLUSDURATION MINUSDURATION DIVDURATION MULDURATION
 %token PLUSPLUS
 %token MATCH WITH VARIES WITH_V WILDCARD
 %token FOR ALL WE_HAVE INCREASING DECREASING

tests/test_date/good/durations.catala_en

@@ -9,6 +9,7 @@ declaration scope A:
   context output z3 content duration
   context output d content decimal
   context output d2 content decimal
+  context output m content duration
 
 scope A:
   definition x equals |2019-01-01|
@@ -20,4 +21,6 @@ scope A:
 
   definition d equals z3 /^ z3
   definition d2 equals z3 /^ 2 day
+
+  definition m equals z3 *^ 2
 ```

tests/test_date/good/output/durations.catala_en.A.Interpret

@@ -1,6 +1,7 @@
 [RESULT] Computation successful! Results:
 [RESULT] d = 1.
 [RESULT] d2 = 2968.5
+[RESULT] m = 11874 days
 [RESULT] x = 2019-01-01
 [RESULT] y = 2002-09-30
 [RESULT] z = true