Implement deserialization for Expressions

2 files changed, 150 insertions, 7 deletions

diff --git a/src/CfimOfJson.ml b/src/CfimOfJson.ml
index 79e1798a..7a3bd910 100644
--- a/src/CfimOfJson.ml
+++ b/src/CfimOfJson.ml
@@ -20,6 +20,8 @@
     to implement our own deserializing functions. Moreover, it allows us to
     generate a friendlier debugging output in case the deserialization functions
     fail.
+
+    TODO: we should check that the integer values are in the proper range
  *)
 
 open Yojson.Safe
@@ -35,6 +37,11 @@ let bool_of_json (js : json) : (bool, string) result =
   | `Bool b -> Ok b
   | _ -> Error ("bool_of_json: not a bool: " ^ show js)
 
+let int_of_json (js : json) : (int, string) result =
+  match js with
+  | `Int i -> Ok i
+  | _ -> Error ("int_of_json: not an int: " ^ show js)
+
 let char_of_json (_js : json) : (char, string) result =
   (* TODO: implement *)
   Error "char_of_json: unimplemented"
@@ -294,8 +301,142 @@ let constant_value_of_json (js : json) : (constant_value, string) result =
   | `Variant ("String", Some v) ->
       let* v = string_of_json v in
       Ok (String v)
-  | _ -> Error ("scalar_value_of_json failed on:" ^ show js)
-(*
+  | _ -> Error ("constant_value_of_json failed on:" ^ show js)
 
 open Expressions
-open CfimAst*)
+
+let field_proj_kind_of_json (js : json) : (field_proj_kind, string) result =
+  match js with
+  | `Variant ("ProjAdt", Some (`Tuple [ def_id; opt_variant_id ])) ->
+      let* def_id = TypeDefId.id_of_json def_id in
+      let* opt_variant_id =
+        option_of_json VariantId.id_of_json opt_variant_id
+      in
+      Ok (ProjAdt (def_id, opt_variant_id))
+  | `Variant ("ProjTuple", Some i) ->
+      let* i = int_of_json i in
+      Ok (ProjTuple i)
+  | _ -> Error ("field_proj_kind_of_json failed on:" ^ show js)
+
+let projection_elem_of_json (js : json) : (projection_elem, string) result =
+  match js with
+  | `Variant ("Deref", None) -> Ok Deref
+  | `Variant ("DerefBox", None) -> Ok DerefBox
+  | `Variant ("Field", Some (`Tuple [ proj_kind; field_id ])) ->
+      let* proj_kind = field_proj_kind_of_json proj_kind in
+      let* field_id = FieldId.id_of_json field_id in
+      Ok (Field (proj_kind, field_id))
+  | `Variant ("Downcast", Some variant_id) ->
+      let* variant_id = VariantId.id_of_json variant_id in
+      Ok (Downcast variant_id)
+  | _ -> Error ("projection_elem_of_json failed on:" ^ show js)
+
+let projection_of_json (js : json) : (projection, string) result =
+  list_of_json projection_elem_of_json js
+
+let place_of_json (js : json) : (place, string) result =
+  match js with
+  | `Assoc [ ("var_id", var_id); ("projection", projection) ] ->
+      let* var_id = VarId.id_of_json var_id in
+      let* projection = projection_of_json projection in
+      Ok { var_id; projection }
+  | _ -> Error ("place_of_json failed on:" ^ show js)
+
+let borrow_kind_of_json (js : json) : (borrow_kind, string) result =
+  match js with
+  | `Variant ("Shared", None) -> Ok Shared
+  | `Variant ("Mut", None) -> Ok Mut
+  | `Variant ("TwoPhaseMut", None) -> Ok TwoPhaseMut
+  | _ -> Error ("borrow_kind_of_json failed on:" ^ show js)
+
+let unop_of_json (js : json) : (unop, string) result =
+  match js with
+  | `Variant ("Not", None) -> Ok Not
+  | `Variant ("Neg", None) -> Ok Neg
+  | _ -> Error ("unop_of_json failed on:" ^ show js)
+
+let binop_of_json (js : json) : (binop, string) result =
+  match js with
+  | `Variant ("BitXor", None) -> Ok BitXor
+  | `Variant ("BitAnd", None) -> Ok BitAnd
+  | `Variant ("BitOr", None) -> Ok BitOr
+  | `Variant ("Eq", None) -> Ok Eq
+  | `Variant ("Lt", None) -> Ok Lt
+  | `Variant ("Le", None) -> Ok Le
+  | `Variant ("Ne", None) -> Ok Ne
+  | `Variant ("Ge", None) -> Ok Ge
+  | `Variant ("Gt", None) -> Ok Gt
+  | `Variant ("Div", None) -> Ok Div
+  | `Variant ("Rem", None) -> Ok Rem
+  | `Variant ("Add", None) -> Ok Add
+  | `Variant ("Sub", None) -> Ok Sub
+  | `Variant ("Mul", None) -> Ok Mul
+  | `Variant ("Shl", None) -> Ok Shl
+  | `Variant ("Shr", None) -> Ok Shr
+  | _ -> Error ("binop_of_json failed on:" ^ show js)
+
+let operand_constant_value_of_json (js : json) :
+    (operand_constant_value, string) result =
+  match js with
+  | `Variant ("ConstantValue", Some cv) ->
+      let* cv = constant_value_of_json cv in
+      Ok (ConstantValue cv)
+  | `Variant ("ConstantAdt", Some id) ->
+      let* id = TypeDefId.id_of_json id in
+      Ok (ConstantAdt id)
+  | `Variant ("Unit", None) -> Ok Unit
+  | _ -> Error ("operand_constant_value_of_json failed on:" ^ show js)
+
+let operand_of_json (js : json) : (operand, string) result =
+  match js with
+  | `Variant ("Copy", Some place) ->
+      let* place = place_of_json place in
+      Ok (Copy place)
+  | `Variant ("Move", Some place) ->
+      let* place = place_of_json place in
+      Ok (Move place)
+  | `Variant ("Constant", Some (`Tuple [ ty; cv ])) ->
+      let* ty = ety_of_json ty in
+      let* cv = operand_constant_value_of_json cv in
+      Ok (Constant (ty, cv))
+  | _ -> Error ("operand_of_json failed on:" ^ show js)
+
+let aggregate_kind_of_json (js : json) : (aggregate_kind, string) result =
+  match js with
+  | `Variant ("AggregatedTuple", None) -> Ok AggregatedTuple
+  | `Variant ("AggregatedAdt", Some (`Tuple [ id; opt_variant_id ])) ->
+      let* id = TypeDefId.id_of_json id in
+      let* opt_variant_id =
+        option_of_json VariantId.id_of_json opt_variant_id
+      in
+      Ok (AggregatedAdt (id, opt_variant_id))
+  | _ -> Error ("aggregate_kind_of_json failed on:" ^ show js)
+
+let rvalue_kind_of_json (js : json) : (rvalue, string) result =
+  match js with
+  | `Variant ("Use", Some op) ->
+      let* op = operand_of_json op in
+      Ok (Use op)
+  | `Variant ("Ref", Some (`Tuple [ place; borrow_kind ])) ->
+      let* place = place_of_json place in
+      let* borrow_kind = borrow_kind_of_json borrow_kind in
+      Ok (Ref (place, borrow_kind))
+  | `Variant ("UnaryOp", Some (`Tuple [ unop; op ])) ->
+      let* unop = unop_of_json unop in
+      let* op = operand_of_json op in
+      Ok (UnaryOp (unop, op))
+  | `Variant ("BinaryOp", Some (`Tuple [ binop; op1; op2 ])) ->
+      let* binop = binop_of_json binop in
+      let* op1 = operand_of_json op1 in
+      let* op2 = operand_of_json op2 in
+      Ok (BinaryOp (binop, op1, op2))
+  | `Variant ("Discriminant", Some place) ->
+      let* place = place_of_json place in
+      Ok (Discriminant place)
+  | `Variant ("Aggregate", Some (`Tuple [ aggregate_kind; ops ])) ->
+      let* aggregate_kind = aggregate_kind_of_json aggregate_kind in
+      let* ops = list_of_json operand_of_json ops in
+      Ok (Aggregate (aggregate_kind, ops))
+  | _ -> Error ("rvalue_of_json failed on:" ^ show js)
+
+(*open CfimAst*)
diff --git a/src/Expressions.ml b/src/Expressions.ml
index cd0a08ab..0a8c9d35 100644
--- a/src/Expressions.ml
+++ b/src/Expressions.ml
@@ -2,8 +2,8 @@ open Types
 open Values
 
 type field_proj_kind =
-  | Adt of TypeDefId.id * VariantId.id option
-  | Tuple of int
+  | ProjAdt of TypeDefId.id * VariantId.id option
+  | ProjTuple of int
 [@@deriving yojson]
 
 type projection_elem =
@@ -62,7 +62,7 @@ type binop =
  *)
 type operand_constant_value =
   | ConstantValue of constant_value
-  | Adt of TypeDefId.id
+  | ConstantAdt of TypeDefId.id
   | Unit
 [@@deriving yojson]
 
@@ -72,7 +72,9 @@ type operand =
   | Constant of ety * operand_constant_value
 [@@deriving yojson]
 
-type aggregate_kind = Tuple | Adt of TypeDefId.id * VariantId.id list
+type aggregate_kind =
+  | AggregatedTuple
+  | AggregatedAdt of TypeDefId.id * VariantId.id option
 [@@deriving yojson]
 
 type rvalue =