diff options
| -rw-r--r-- | src/ExpressionsUtils.ml | 10 | ||||
| -rw-r--r-- | src/FunsAnalysis.ml | 8 | ||||
| -rw-r--r-- | src/PureUtils.ml | 18 | ||||
| -rw-r--r-- | src/SymbolicToPure.ml | 5 |
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; } |