refactor(compiler): rename operand names according their types

This commit is contained in:
EmileRolley 2021-05-31 10:56:13 +02:00
parent be90d61dc1
commit c718095b2d
2 changed files with 59 additions and 59 deletions

View File

@ -49,6 +49,9 @@ let rec evaluate_operator (ctx : Ast.decl_ctx) (op : A.operator Pos.marked)
(Some "The null denominator:", Pos.get_position (List.nth args 1));
]
in
let get_binop_args_pos (args : (A.expr * Pos.t) list) : (string option * Pos.t) list =
[ (None, Pos.get_position (List.nth args 0)); (None, Pos.get_position (List.nth args 1)) ]
in
(* Try to apply [cmp] and if a [UncomparableDurations] exceptions is catched, use [args] to raise
multispanned errors. *)
let apply_cmp_or_raise_err (cmp : unit -> A.expr) (args : (A.expr * Pos.t) list) : A.expr =
@ -56,7 +59,7 @@ let rec evaluate_operator (ctx : Ast.decl_ctx) (op : A.operator Pos.marked)
with Runtime.UncomparableDurations ->
Errors.raise_multispanned_error
"Cannot compare together durations that cannot be converted to a precise number of days"
[ (None, Pos.get_position (List.nth args 0)); (None, Pos.get_position (List.nth args 1)) ]
(get_binop_args_pos args)
in
Pos.same_pos_as
(match (Pos.unmark op, List.map Pos.unmark args) with
@ -79,33 +82,30 @@ let rec evaluate_operator (ctx : Ast.decl_ctx) (op : A.operator Pos.marked)
| A.Binop (A.Mult KRat), [ ELit (LRat i1); ELit (LRat i2) ] -> A.ELit (LRat Runtime.(i1 *& i2))
| A.Binop (A.Div KRat), [ ELit (LRat i1); ELit (LRat i2) ] ->
apply_div_or_raise_err (fun _ -> A.ELit (LRat Runtime.(i1 /& i2))) op
| A.Binop (A.Add KMoney), [ ELit (LMoney i1); ELit (LMoney i2) ] ->
A.ELit (LMoney Runtime.(i1 +$ i2))
| A.Binop (A.Sub KMoney), [ ELit (LMoney i1); ELit (LMoney i2) ] ->
A.ELit (LMoney Runtime.(i1 -$ i2))
| A.Binop (A.Mult KMoney), [ ELit (LMoney i1); ELit (LRat i2) ] ->
A.ELit (LMoney Runtime.(i1 *$ i2))
| A.Binop (A.Div KMoney), [ ELit (LMoney i1); ELit (LMoney i2) ] ->
apply_div_or_raise_err (fun _ -> A.ELit (LRat Runtime.(i1 /$ i2))) op
| A.Binop (A.Add KDuration), [ ELit (LDuration i1); ELit (LDuration i2) ] ->
A.ELit (LDuration Runtime.(i1 +^ i2))
| A.Binop (A.Sub KDuration), [ ELit (LDuration i1); ELit (LDuration i2) ] ->
A.ELit (LDuration Runtime.(i1 -^ i2))
| A.Binop (A.Sub KDate), [ ELit (LDate i1); ELit (LDate i2) ] ->
A.ELit (LDuration Runtime.(i1 -@ i2))
| A.Binop (A.Add KDate), [ ELit (LDate i1); ELit (LDuration i2) ] ->
A.ELit (LDate Runtime.(i1 +@ i2))
| A.Binop (A.Div KDuration), [ ELit (LDuration i1); ELit (LDuration i2) ] ->
| A.Binop (A.Add KMoney), [ ELit (LMoney m1); ELit (LMoney m2) ] ->
A.ELit (LMoney Runtime.(m1 +$ m2))
| A.Binop (A.Sub KMoney), [ ELit (LMoney m1); ELit (LMoney m2) ] ->
A.ELit (LMoney Runtime.(m1 -$ m2))
| A.Binop (A.Mult KMoney), [ ELit (LMoney m1); ELit (LRat m2) ] ->
A.ELit (LMoney Runtime.(m1 *$ m2))
| A.Binop (A.Div KMoney), [ ELit (LMoney m1); ELit (LMoney m2) ] ->
apply_div_or_raise_err (fun _ -> A.ELit (LRat Runtime.(m1 /$ m2))) op
| A.Binop (A.Add KDuration), [ ELit (LDuration d1); ELit (LDuration d2) ] ->
A.ELit (LDuration Runtime.(d1 +^ d2))
| A.Binop (A.Sub KDuration), [ ELit (LDuration d1); ELit (LDuration d2) ] ->
A.ELit (LDuration Runtime.(d1 -^ d2))
| A.Binop (A.Sub KDate), [ ELit (LDate d1); ELit (LDate d2) ] ->
A.ELit (LDuration Runtime.(d1 -@ d2))
| A.Binop (A.Add KDate), [ ELit (LDate d1); ELit (LDuration d2) ] ->
A.ELit (LDate Runtime.(d1 +@ d2))
| A.Binop (A.Div KDuration), [ ELit (LDuration d1); ELit (LDuration d2) ] ->
apply_div_or_raise_err
(fun _ ->
try A.ELit (LRat Runtime.(i1 /^ i2))
try A.ELit (LRat Runtime.(d1 /^ d2))
with Runtime.IndivisableDurations ->
Errors.raise_multispanned_error
"Cannot divide durations that cannot be converted to a precise number of days"
[
(None, Pos.get_position (List.nth args 0));
(None, Pos.get_position (List.nth args 1));
])
(get_binop_args_pos args))
op
| 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) ] -> A.ELit (LBool Runtime.(i1 <=! i2))
@ -115,35 +115,35 @@ let rec evaluate_operator (ctx : Ast.decl_ctx) (op : A.operator Pos.marked)
| A.Binop (A.Lte KRat), [ ELit (LRat i1); ELit (LRat i2) ] -> A.ELit (LBool Runtime.(i1 <=& i2))
| A.Binop (A.Gt KRat), [ ELit (LRat i1); ELit (LRat i2) ] -> A.ELit (LBool Runtime.(i1 >& i2))
| A.Binop (A.Gte KRat), [ ELit (LRat i1); ELit (LRat i2) ] -> A.ELit (LBool Runtime.(i1 >=& i2))
| A.Binop (A.Lt KMoney), [ ELit (LMoney i1); ELit (LMoney i2) ] ->
A.ELit (LBool Runtime.(i1 <$ i2))
| A.Binop (A.Lte KMoney), [ ELit (LMoney i1); ELit (LMoney i2) ] ->
A.ELit (LBool Runtime.(i1 <=$ i2))
| A.Binop (A.Gt KMoney), [ ELit (LMoney i1); ELit (LMoney i2) ] ->
A.ELit (LBool Runtime.(i1 >$ i2))
| A.Binop (A.Gte KMoney), [ ELit (LMoney i1); ELit (LMoney i2) ] ->
A.ELit (LBool Runtime.(i1 >=$ i2))
| A.Binop (A.Lt KDuration), [ ELit (LDuration i1); ELit (LDuration i2) ] ->
apply_cmp_or_raise_err (fun _ -> A.ELit (LBool Runtime.(i1 <^ i2))) args
| A.Binop (A.Lte KDuration), [ ELit (LDuration i1); ELit (LDuration i2) ] ->
apply_cmp_or_raise_err (fun _ -> A.ELit (LBool Runtime.(i1 <=^ i2))) args
| A.Binop (A.Gt KDuration), [ ELit (LDuration i1); ELit (LDuration i2) ] ->
apply_cmp_or_raise_err (fun _ -> A.ELit (LBool Runtime.(i1 >^ i2))) args
| A.Binop (A.Gte KDuration), [ ELit (LDuration i1); ELit (LDuration i2) ] ->
apply_cmp_or_raise_err (fun _ -> A.ELit (LBool Runtime.(i1 >=^ i2))) args
| A.Binop (A.Lt KDate), [ ELit (LDate i1); ELit (LDate i2) ] ->
A.ELit (LBool Runtime.(i1 <@ i2))
| A.Binop (A.Lte KDate), [ ELit (LDate i1); ELit (LDate i2) ] ->
A.ELit (LBool Runtime.(i1 <=@ i2))
| A.Binop (A.Gt KDate), [ ELit (LDate i1); ELit (LDate i2) ] ->
A.ELit (LBool Runtime.(i1 >@ i2))
| A.Binop (A.Gte KDate), [ ELit (LDate i1); ELit (LDate i2) ] ->
A.ELit (LBool Runtime.(i1 >=@ i2))
| A.Binop (A.Lt KMoney), [ ELit (LMoney m1); ELit (LMoney m2) ] ->
A.ELit (LBool Runtime.(m1 <$ m2))
| A.Binop (A.Lte KMoney), [ ELit (LMoney m1); ELit (LMoney m2) ] ->
A.ELit (LBool Runtime.(m1 <=$ m2))
| A.Binop (A.Gt KMoney), [ ELit (LMoney m1); ELit (LMoney m2) ] ->
A.ELit (LBool Runtime.(m1 >$ m2))
| A.Binop (A.Gte KMoney), [ ELit (LMoney m1); ELit (LMoney m2) ] ->
A.ELit (LBool Runtime.(m1 >=$ m2))
| A.Binop (A.Lt KDuration), [ ELit (LDuration d1); ELit (LDuration d2) ] ->
apply_cmp_or_raise_err (fun _ -> A.ELit (LBool Runtime.(d1 <^ d2))) args
| A.Binop (A.Lte KDuration), [ ELit (LDuration d1); ELit (LDuration d2) ] ->
apply_cmp_or_raise_err (fun _ -> A.ELit (LBool Runtime.(d1 <=^ d2))) args
| A.Binop (A.Gt KDuration), [ ELit (LDuration d1); ELit (LDuration d2) ] ->
apply_cmp_or_raise_err (fun _ -> A.ELit (LBool Runtime.(d1 >^ d2))) args
| A.Binop (A.Gte KDuration), [ ELit (LDuration d1); ELit (LDuration d2) ] ->
apply_cmp_or_raise_err (fun _ -> A.ELit (LBool Runtime.(d1 >=^ d2))) args
| A.Binop (A.Lt KDate), [ ELit (LDate d1); ELit (LDate d2) ] ->
A.ELit (LBool Runtime.(d1 <@ d2))
| A.Binop (A.Lte KDate), [ ELit (LDate d1); ELit (LDate d2) ] ->
A.ELit (LBool Runtime.(d1 <=@ d2))
| A.Binop (A.Gt KDate), [ ELit (LDate d1); ELit (LDate d2) ] ->
A.ELit (LBool Runtime.(d1 >@ d2))
| A.Binop (A.Gte KDate), [ ELit (LDate d1); ELit (LDate d2) ] ->
A.ELit (LBool Runtime.(d1 >=@ d2))
| A.Binop A.Eq, [ ELit LUnit; ELit LUnit ] -> A.ELit (LBool true)
| A.Binop A.Eq, [ ELit (LDuration i1); ELit (LDuration i2) ] ->
A.ELit (LBool Runtime.(i1 =^ i2))
| A.Binop A.Eq, [ ELit (LDate i1); ELit (LDate i2) ] -> A.ELit (LBool Runtime.(i1 =@ i2))
| A.Binop A.Eq, [ ELit (LMoney i1); ELit (LMoney i2) ] -> A.ELit (LBool Runtime.(i1 =$ i2))
| A.Binop A.Eq, [ ELit (LDuration d1); ELit (LDuration d2) ] ->
A.ELit (LBool Runtime.(d1 =^ d2))
| A.Binop A.Eq, [ ELit (LDate d1); ELit (LDate d2) ] -> A.ELit (LBool Runtime.(d1 =@ d2))
| A.Binop A.Eq, [ ELit (LMoney m1); ELit (LMoney m2) ] -> A.ELit (LBool Runtime.(m1 =$ m2))
| A.Binop A.Eq, [ ELit (LRat i1); ELit (LRat i2) ] -> A.ELit (LBool Runtime.(i1 =& i2))
| A.Binop A.Eq, [ ELit (LInt i1); ELit (LInt i2) ] -> A.ELit (LBool Runtime.(i1 =! i2))
| A.Binop A.Eq, [ ELit (LBool b1); ELit (LBool b2) ] -> A.ELit (LBool (b1 = b2))

View File

@ -158,7 +158,7 @@ let decimal_to_string ~(max_prec_digits : int) (i : decimal) : string =
(List.rev !digits)
(if List.length !digits - leading_zeroes !digits = max_prec_digits then "" else "")
let integer_of_string (i : string) : integer = Z.of_string i
let integer_of_string (s : string) : integer = Z.of_string s
let integer_to_string (i : integer) : string = Z.to_string i
@ -221,14 +221,14 @@ let ( *$ ) (i1 : money) (i2 : decimal) : money =
(* we perform nearest rounding when multiplying an amount of money by a decimal !*)
if Z.(of_int 2 * remainder >= Q.den rat_result) then Z.add res (Z.of_int 1) else res
let ( /$ ) (i1 : money) (i2 : money) : decimal =
if i2 <> Z.zero then Q.div (Q.of_bigint i1) (Q.of_bigint i2) else raise Division_by_zero
let ( /$ ) (m1 : money) (m2 : money) : decimal =
if Z.zero = m2 then raise Division_by_zero else Q.div (Q.of_bigint m1) (Q.of_bigint m2)
let ( +$ ) (i1 : money) (i2 : money) : money = Z.add i1 i2
let ( +$ ) (m1 : money) (m2 : money) : money = Z.add m1 m2
let ( -$ ) (i1 : money) (i2 : money) : money = Z.sub i1 i2
let ( -$ ) (m1 : money) (m2 : money) : money = Z.sub m1 m2
let ( ~-$ ) (i1 : money) : money = Z.sub Z.zero i1
let ( ~-$ ) (m1 : money) : money = Z.sub Z.zero m1
let ( +! ) (i1 : integer) (i2 : integer) : integer = Z.add i1 i2
@ -239,7 +239,7 @@ let ( ~-! ) (i1 : integer) : integer = Z.sub Z.zero i1
let ( *! ) (i1 : integer) (i2 : integer) : integer = Z.mul i1 i2
let ( /! ) (i1 : integer) (i2 : integer) : integer =
if i2 <> Z.zero then Z.div i1 i2 else raise Division_by_zero
if Z.zero = i2 then raise Division_by_zero else Z.div i1 i2
let ( +& ) (i1 : decimal) (i2 : decimal) : decimal = Q.add i1 i2
@ -250,7 +250,7 @@ let ( ~-& ) (i1 : decimal) : decimal = Q.sub Q.zero i1
let ( *& ) (i1 : decimal) (i2 : decimal) : decimal = Q.mul i1 i2
let ( /& ) (i1 : decimal) (i2 : decimal) : decimal =
if i2 <> Q.zero then Q.div i1 i2 else raise Division_by_zero
if Q.zero = i2 then raise Division_by_zero else Q.div i1 i2
let ( +@ ) (d1 : date) (d2 : duration) : date = CalendarLib.Date.add d1 d2