summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--src/Interpreter.ml8
-rw-r--r--src/SymbolicAst.ml8
-rw-r--r--src/SymbolicToPure.ml20
3 files changed, 25 insertions, 11 deletions
diff --git a/src/Interpreter.ml b/src/Interpreter.ml
index c7cdc329..bcfb9a78 100644
--- a/src/Interpreter.ml
+++ b/src/Interpreter.ml
@@ -43,7 +43,7 @@ let initialize_context (m : M.cfim_module) (type_vars : T.type_var list) :
signature.
*)
let initialize_symbolic_context_for_fun (m : M.cfim_module) (fdef : A.fun_def) :
- C.eval_ctx =
+ C.eval_ctx * A.inst_fun_sig =
(* The abstractions are not initialized the same way as for function
* calls: they contain *loan* projectors, because they "provide" us
* with the input values (which behave as if they had been returned
@@ -93,7 +93,7 @@ let initialize_symbolic_context_for_fun (m : M.cfim_module) (fdef : A.fun_def) :
(* Push the remaining local variables (initialized with ⊥) *)
let ctx = C.ctx_push_uninitialized_vars ctx local_vars in
(* Return *)
- ctx
+ (ctx, inst_sg)
(** Small helper.
@@ -184,7 +184,7 @@ let evaluate_function_symbolic (config : C.partial_config) (synthesize : bool)
log#ldebug (lazy ("evaluate_function_symbolic: " ^ name_to_string ()));
(* Create the evaluation context *)
- let ctx = initialize_symbolic_context_for_fun m fdef in
+ let ctx, inst_sg = initialize_symbolic_context_for_fun m fdef in
(* Create the continuation to finish the evaluation *)
let config = C.config_of_partial C.SymbolicMode config in
@@ -205,7 +205,7 @@ let evaluate_function_symbolic (config : C.partial_config) (synthesize : bool)
let cf_move = move_return_value config in
(* Generate the Return node *)
let cf_return ret_value : m_fun =
- fun _ -> Some (SA.Return ret_value)
+ fun _ -> Some (SA.Return (Some ret_value))
in
(* Apply *)
cf_move cf_return ctx
diff --git a/src/SymbolicAst.ml b/src/SymbolicAst.ml
index 9dc20468..f0873aa3 100644
--- a/src/SymbolicAst.ml
+++ b/src/SymbolicAst.ml
@@ -28,9 +28,11 @@ type call = {
used in CFIM: they are a first step towards lambda-calculus expressions.
*)
type expression =
- | Return of V.typed_value
- (** The typed value stored in [Return] is the value contained in the return
- variable upon returning
+ | Return of V.typed_value option
+ (** There are two cases:
+ - the AST is for a forward function: the typed value should contain
+ the value which was in the return variable
+ - the AST is for a backward function: the typed value should be `None`
*)
| Panic
| FunCall of call * expression
diff --git a/src/SymbolicToPure.ml b/src/SymbolicToPure.ml
index 51d3c170..67d5cc45 100644
--- a/src/SymbolicToPure.ml
+++ b/src/SymbolicToPure.ml
@@ -190,7 +190,7 @@ type call_info = {
type bs_ctx = {
type_context : type_context;
fun_context : fun_context;
- bid : T.RegionGroupId.id option;
+ bid : T.RegionGroupId.id option; (** TODO: rename *)
sv_to_var : var V.SymbolicValueId.Map.t;
(** Whenever we encounter a new symbolic value (introduced because of
a symbolic expansion or upon ending an abstraction, for instance)
@@ -834,9 +834,7 @@ let get_abs_ancestors (ctx : bs_ctx) (abs : V.abs) : S.call * V.abs list =
let rec translate_expression (e : S.expression) (ctx : bs_ctx) : expression =
match e with
- | S.Return v ->
- let v = typed_value_to_rvalue ctx v in
- Return v
+ | S.Return opt_v -> translate_return opt_v ctx
| Panic -> Panic
| FunCall (call, e) -> translate_function_call call e ctx
| EndAbstraction (abs, e) -> translate_end_abstraction abs e ctx
@@ -845,6 +843,20 @@ let rec translate_expression (e : S.expression) (ctx : bs_ctx) : expression =
(* We ignore the meta information *)
translate_expression e ctx
+and translate_return (opt_v : V.typed_value option) (ctx : bs_ctx) : expression
+ =
+ (* There are two cases:
+ - either we are translating a forward function, in which case the optional
+ value should be `Some` (it is the returned value)
+ - or we are translating a backward function, in which case it should be `None`
+ *)
+ match ctx.bid with
+ | None ->
+ let v = Option.get opt_v in
+ let v = typed_value_to_rvalue ctx v in
+ Return v
+ | Some bid -> raise Unimplemented
+
and translate_function_call (call : S.call) (e : S.expression) (ctx : bs_ctx) :
expression =
(* Translate the function call *)