summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSon Ho2022-06-30 06:46:52 +0200
committerSon Ho2022-06-30 06:46:52 +0200
commit4f33892c81cdaf6aefaad9b7cef1456dcfead67c (patch)
tree5cfe38e3cea5518179f3655d22171620287817aa
parent775b2473976075aa6458a51682f3beeee75dc17a (diff)
Take failing rvalues into account in FunsAnalysis.analyze_fun_decls
-rw-r--r--src/ExpressionsUtils.ml10
-rw-r--r--src/FunsAnalysis.ml8
-rw-r--r--src/PureUtils.ml18
-rw-r--r--src/SymbolicToPure.ml5
4 files changed, 22 insertions, 19 deletions
diff --git a/src/ExpressionsUtils.ml b/src/ExpressionsUtils.ml
new file mode 100644
index 00000000..c3ccfb15
--- /dev/null
+++ b/src/ExpressionsUtils.ml
@@ -0,0 +1,10 @@
+module E = Expressions
+
+let unop_can_fail (unop : E.unop) : bool =
+ match unop with Neg | Cast _ -> true | Not -> false
+
+let binop_can_fail (binop : E.binop) : bool =
+ match binop with
+ | BitXor | BitAnd | BitOr | Eq | Lt | Le | Ne | Ge | Gt -> false
+ | Div | Rem | Add | Sub | Mul -> true
+ | Shl | Shr -> raise Errors.Unimplemented
diff --git a/src/FunsAnalysis.ml b/src/FunsAnalysis.ml
index dc205eb9..b8dd17d8 100644
--- a/src/FunsAnalysis.ml
+++ b/src/FunsAnalysis.ml
@@ -9,6 +9,7 @@
open LlbcAst
open Modules
+module EU = ExpressionsUtils
type fun_info = {
can_fail : bool;
@@ -57,6 +58,13 @@ let analyze_module (m : llbc_module) (funs_map : fun_decl FunDeclId.Map.t)
can_fail := true;
super#visit_Assert env a
+ method! visit_rvalue _env rv =
+ match rv with
+ | Use _ | Ref _ | Discriminant _ | Aggregate _ -> ()
+ | UnaryOp (uop, _) -> can_fail := EU.unop_can_fail uop || !can_fail
+ | BinaryOp (bop, _, _) ->
+ can_fail := EU.binop_can_fail bop || !can_fail
+
method! visit_Call env call =
(match call.func with
| Regular id ->
diff --git a/src/PureUtils.ml b/src/PureUtils.ml
index 992b8cb8..8d3b5258 100644
--- a/src/PureUtils.ml
+++ b/src/PureUtils.ml
@@ -11,11 +11,8 @@ module RegularFunIdOrderedType = struct
type t = regular_fun_id
let compare = compare_regular_fun_id
-
let to_string = show_regular_fun_id
-
let pp_t = pp_regular_fun_id
-
let show_t = show_regular_fun_id
end
@@ -25,26 +22,14 @@ module FunIdOrderedType = struct
type t = fun_id
let compare = compare_fun_id
-
let to_string = show_fun_id
-
let pp_t = pp_fun_id
-
let show_t = show_fun_id
end
module FunIdMap = Collections.MakeMap (FunIdOrderedType)
module FunIdSet = Collections.MakeSet (FunIdOrderedType)
-(* TODO : move *)
-let binop_can_fail (binop : E.binop) : bool =
- match binop with
- | BitXor | BitAnd | BitOr | Eq | Lt | Le | Ne | Ge | Gt -> false
- | Div | Rem | Add | Sub | Mul -> true
- | Shl | Shr -> raise Errors.Unimplemented
-
-(*let mk_arrow_ty (arg_ty : ty) (ret_ty : ty) : ty = Arrow (arg_ty, ret_ty)*)
-
let dest_arrow_ty (ty : ty) : ty * ty =
match ty with
| Arrow (arg_ty, ret_ty) -> (arg_ty, ret_ty)
@@ -72,7 +57,6 @@ let ty_substitute (tsubst : TypeVarId.id -> ty) (ty : ty) : ty =
let obj =
object
inherit [_] map_ty
-
method! visit_TypeVar _ var_id = tsubst var_id
end
in
@@ -198,7 +182,6 @@ let remove_meta (e : texpression) : texpression =
let obj =
object
inherit [_] map_expression as super
-
method! visit_Meta env _ e = super#visit_expression env e.e
end
in
@@ -414,7 +397,6 @@ let type_decl_is_enum (def : T.type_decl) : bool =
match def.kind with T.Struct _ -> false | Enum _ -> true | Opaque -> false
let mk_state_ty : ty = Adt (Assumed State, [])
-
let mk_result_ty (ty : ty) : ty = Adt (Assumed Result, [ ty ])
let mk_result_fail_texpression (ty : ty) : texpression =
diff --git a/src/SymbolicToPure.ml b/src/SymbolicToPure.ml
index 42479a6e..4c2ba4c8 100644
--- a/src/SymbolicToPure.ml
+++ b/src/SymbolicToPure.ml
@@ -478,6 +478,9 @@ let get_fun_effect_info (fun_infos : FA.fun_info FunDeclId.Map.t)
let info = FunDeclId.Map.find fid fun_infos in
let input_state = info.stateful in
let output_state = input_state && gid = None in
+ (* We ignore on purpose info.can_fail: the result of the analysis is not
+ * used yet to adjust the translation so that the functions which syntactically
+ * can't fail don't use an error monad. *)
{ can_fail = true; input_state; output_state }
| A.Assumed aid ->
{
@@ -1191,7 +1194,7 @@ and translate_function_call (config : config) (call : S.call) (e : S.expression)
assert (int_ty0 = int_ty1);
let effect_info =
{
- can_fail = binop_can_fail binop;
+ can_fail = ExpressionsUtils.binop_can_fail binop;
input_state = false;
output_state = false;
}