From 12b82a418f43d9f73265ec28c5bb728f4f5f802b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?David=20B=C3=BChler?= <david.buhler@cea.fr>
Date: Tue, 28 May 2024 12:11:36 +0200
Subject: [PATCH] [Eva] Minor change in value_product.
In backward_binop, avoids using left/right for the left/right modules and for
the lelt/right arguments at the same time.
In most functions, restores symmetry by using let+/and+ bindings instead of
let*/let+ bindings.
---
src/plugins/eva/values/value_product.ml | 63 ++++++++++++-------------
1 file changed, 30 insertions(+), 33 deletions(-)
diff --git a/src/plugins/eva/values/value_product.ml b/src/plugins/eva/values/value_product.ml
index c313e18ef28..0cfbe6e78b6 100644
--- a/src/plugins/eva/values/value_product.ml
+++ b/src/plugins/eva/values/value_product.ml
@@ -67,8 +67,8 @@ module Make
Left.join l1 l2, Right.join r1 r2
let narrow (l1, r1) (l2, r2) =
- let* left = Left.narrow l1 l2 in
- let+ right = Right.narrow r1 r2 in
+ let+ left = Left.narrow l1 l2
+ and+ right = Right.narrow r1 r2 in
left, right
let zero = Left.zero, Right.zero
@@ -77,53 +77,53 @@ module Make
let inject_int typ i = Left.inject_int typ i, Right.inject_int typ i
let assume_non_zero (left, right) =
- let left_truth = Left.assume_non_zero left in
- let right_truth = Right.assume_non_zero right in
+ let left_truth = Left.assume_non_zero left
+ and right_truth = Right.assume_non_zero right in
narrow_truth (left, left_truth) (right, right_truth)
let assume_bounded kind bound (left, right) =
- let left_truth = Left.assume_bounded kind bound left in
- let right_truth = Right.assume_bounded kind bound right in
+ let left_truth = Left.assume_bounded kind bound left
+ and right_truth = Right.assume_bounded kind bound right in
narrow_truth (left, left_truth) (right, right_truth)
let assume_not_nan ~assume_finite fkind (left, right) =
- let left_truth = Left.assume_not_nan ~assume_finite fkind left in
- let right_truth = Right.assume_not_nan ~assume_finite fkind right in
+ let left_truth = Left.assume_not_nan ~assume_finite fkind left
+ and right_truth = Right.assume_not_nan ~assume_finite fkind right in
narrow_truth (left, left_truth) (right, right_truth)
let assume_pointer (left, right) =
- let left_truth = Left.assume_pointer left in
- let right_truth = Right.assume_pointer right in
+ let left_truth = Left.assume_pointer left
+ and right_truth = Right.assume_pointer right in
narrow_truth (left, left_truth) (right, right_truth)
let assume_comparable op (l1, r1) (l2, r2) =
- let left_truth = Left.assume_comparable op l1 l2 in
- let right_truth = Right.assume_comparable op r1 r2 in
+ let left_truth = Left.assume_comparable op l1 l2
+ and right_truth = Right.assume_comparable op r1 r2 in
narrow_truth_pair ((l1, l2), left_truth) ((r1, r2), right_truth)
let constant context expr constant =
- let left = Left.constant context expr constant in
- let right = Right.constant context expr constant in
+ let left = Left.constant context expr constant
+ and right = Right.constant context expr constant in
left, right
let forward_unop context typ unop (left, right) =
- let* left = Left.forward_unop context typ unop left in
- let+ right = Right.forward_unop context typ unop right in
+ let+ left = Left.forward_unop context typ unop left
+ and+ right = Right.forward_unop context typ unop right in
left, right
let forward_binop context typ binop (l1, r1) (l2, r2) =
- let* left = Left.forward_binop context typ binop l1 l2 in
- let+ right = Right.forward_binop context typ binop r1 r2 in
+ let+ left = Left.forward_binop context typ binop l1 l2
+ and+ right = Right.forward_binop context typ binop r1 r2 in
left, right
let rewrap_integer context range (left, right) =
- let left = Left.rewrap_integer context range left in
- let right = Right.rewrap_integer context range right in
+ let left = Left.rewrap_integer context range left
+ and right = Right.rewrap_integer context range right in
left, right
let forward_cast context ~src_type ~dst_type (left, right) =
- let* left = Left.forward_cast context ~src_type ~dst_type left in
- let+ right = Right.forward_cast context ~src_type ~dst_type right in
+ let+ left = Left.forward_cast context ~src_type ~dst_type left
+ and+ right = Right.forward_cast context ~src_type ~dst_type right in
left, right
let resolve_functions (left, right) =
@@ -145,28 +145,25 @@ module Make
| None, Some right -> Some (orig_left, right)
| Some left, Some right -> Some (left, right)
- let left (value : t) : Left.t = fst value
- let right (value : t) : Right.t = snd value
-
let backward_unop context ~typ_arg unop ~arg ~res =
let on_left = Left.backward_unop context ~typ_arg unop in
let on_right = Right.backward_unop context ~typ_arg unop in
- let* left = on_left ~arg:(left arg) ~res:(left res) in
- let+ right = on_right ~arg:(right arg) ~res:(right res) in
+ let+ left = on_left ~arg:(fst arg) ~res:(fst res)
+ and+ right = on_right ~arg:(snd arg) ~res:(snd res) in
reduce arg left right
- let backward_binop ctx ~input_type ~resulting_type binop ~left:l ~right:r ~result:res =
+ let backward_binop ctx ~input_type ~resulting_type binop ~left ~right ~result:res =
let on_left = Left.backward_binop ctx ~input_type ~resulting_type binop in
let on_right = Right.backward_binop ctx ~input_type ~resulting_type binop in
- let* l1, l2 = on_left ~left:(left l) ~right:(left r) ~result:(left res) in
- let+ r1, r2 = on_right ~left:(right l) ~right:(right r) ~result:(right res) in
- reduce l l1 r1, reduce r l2 r2
+ let+ l1, l2 = on_left ~left:(fst left) ~right:(fst right) ~result:(fst res)
+ and+ r1, r2 = on_right ~left:(snd left) ~right:(snd right) ~result:(snd res) in
+ reduce left l1 r1, reduce right l2 r2
let backward_cast context ~src_typ ~dst_typ ~src_val ~dst_val =
let on_left = Left.backward_cast context ~src_typ ~dst_typ in
let on_right = Right.backward_cast context ~src_typ ~dst_typ in
- let* left = on_left ~src_val:(left src_val) ~dst_val:(left dst_val) in
- let+ right = on_right ~src_val:(right src_val) ~dst_val:(right dst_val) in
+ let+ left = on_left ~src_val:(fst src_val) ~dst_val:(fst dst_val)
+ and+ right = on_right ~src_val:(snd src_val) ~dst_val:(snd dst_val) in
reduce src_val left right
end
--
GitLab