From dabf9836f8bf59d4590e4bef126299492c9b53de Mon Sep 17 00:00:00 2001
From: Son Ho
Date: Wed, 17 Nov 2021 16:30:57 +0100
Subject: Start implementing by hand the json deserializers

---
 src/CfimOfJson.ml  | 166 +++++++++++++++++++++++++++++++++++++++++++++++++++++
 src/Identifiers.ml |  11 ++++
 src/Types.ml       |  10 ++--
 src/main.ml        |   4 ++
 4 files changed, 186 insertions(+), 5 deletions(-)
 create mode 100644 src/CfimOfJson.ml

diff --git a/src/CfimOfJson.ml b/src/CfimOfJson.ml
new file mode 100644
index 00000000..156cf42a
--- /dev/null
+++ b/src/CfimOfJson.ml
@@ -0,0 +1,166 @@
+(** Functions to load CFIM ASTs from json.
+
+    Initially, we used `ppx_derive_yojson` to automate this.
+    However, `ppx_derive_yojson` expects formatting to be slightly
+    different from what `serde_rs` generates.
+
+    For instance, if you consider the following rust definition:
+    ```
+    enum t = | V
+    ```
+    Serializing `t::V` with `serde_rs` will generate: `"V"`.
+
+    However, if you consider the following OCaml definition:
+    ```
+    type t = V
+    ```
+    Serializing `V` will generate: `["V"]`.
+
+    As we consider that the `serde_rs` formatting is more logical, we decided
+    to implement our own deserializing functions. Moreover, it allows us to
+    generate a friendlier debugging output in case the deserialization functions
+    fail.
+ *)
+
+open Yojson.Safe
+open Identifiers
+open Types
+
+type json = t
+
+let ( let* ) o f = match o with Error e -> Error e | Ok x -> f x
+
+let rec of_json_list (a_of_json : json -> ('a, string) result) (jsl : json list)
+    : ('a list, string) result =
+  match jsl with
+  | [] -> Ok []
+  | x :: jsl' ->
+      let* x = a_of_json x in
+      let* jsl' = of_json_list a_of_json jsl' in
+      Ok (x :: jsl')
+
+let list_of_json (a_of_json : json -> ('a, string) result) (js : json) :
+    ('a list, string) result =
+  match js with
+  | `List jsl -> of_json_list a_of_json jsl
+  | _ -> Error ("list_of_json: not a list: " ^ show js)
+
+let string_of_json (js : json) : (string, string) result =
+  match js with
+  | `String str -> Ok str
+  | _ -> Error ("string_of_json: not a string: " ^ show js)
+
+let option_of_json (a_of_json : json -> ('a, string) result) (js : json) :
+    ('a option, string) result =
+  match js with
+  | `Variant ("Some", Some x) ->
+      let* x = a_of_json x in
+      Ok (Some x)
+  | `Variant ("None", None) -> Ok None
+  | _ -> Error ("option_of_json failed on: " ^ show js)
+
+let string_option_of_json (js : json) : (string option, string) result =
+  option_of_json string_of_json js
+
+let name_of_json (js : json) : (name, string) result =
+  list_of_json string_of_json js
+
+let type_var_of_json (js : json) : (type_var, string) result =
+  match js with
+  | `Assoc [ ("index", index); ("name", name) ] ->
+      let* index = TypeVarId.id_of_json index in
+      let* name = string_of_json name in
+      Ok { tv_index = index; tv_name = name }
+  | _ -> Error ("type_var_of_json failed on:" ^ show js)
+
+let region_var_of_json (js : json) : (region_var, string) result =
+  match js with
+  | `Assoc [ ("index", index); ("name", name) ] ->
+      let* index = RegionVarId.id_of_json index in
+      let* name = string_option_of_json name in
+      Ok { rv_index = index; rv_name = name }
+  | _ -> Error ("region_var_of_json failed on:" ^ show js)
+
+let region_of_json (js : json) : (RegionVarId.id region, string) result =
+  match js with
+  | `Variant ("Static", None) -> Ok Static
+  | `Variant ("Var", Some rid) ->
+      let* rid = RegionVarId.id_of_json rid in
+      Ok (Var rid)
+  | _ -> Error ("region_of_json failed on:" ^ show js)
+
+let erased_region_of_json (js : json) : (erased_region, string) result =
+  match js with
+  | `Variant ("Erased", None) -> Ok Erased
+  | _ -> Error ("erased_region_of_json failed on:" ^ show js)
+
+let integer_type_of_json (js : json) : (integer_type, string) result =
+  match js with
+  | `Variant ("Isize", None) -> Ok Isize
+  | `Variant ("I8", None) -> Ok I8
+  | `Variant ("I16", None) -> Ok I16
+  | `Variant ("I32", None) -> Ok I32
+  | `Variant ("I64", None) -> Ok I64
+  | `Variant ("I128", None) -> Ok I128
+  | `Variant ("Usize", None) -> Ok Usize
+  | `Variant ("U8", None) -> Ok U8
+  | `Variant ("U16", None) -> Ok U16
+  | `Variant ("U32", None) -> Ok U32
+  | `Variant ("U64", None) -> Ok U64
+  | `Variant ("U128", None) -> Ok U128
+  | _ -> Error ("integer_type_of_json failed on:" ^ show js)
+
+let ref_kind_of_json (js : json) : (ref_kind, string) result =
+  match js with
+  | `Variant ("Mut", None) -> Ok Mut
+  | `Variant ("Shared", None) -> Ok Shared
+  | _ -> Error ("ref_kind_of_json failed on:" ^ show js)
+
+let assumed_ty_of_json (js : json) : (assumed_ty, string) result =
+  match js with
+  | `Variant ("Box", None) -> Ok Box
+  | _ -> Error ("assumed_ty_of_json failed on:" ^ show js)
+
+let rec ty_of_json (r_of_json : json -> ('r, string) result) (js : json) :
+    ('r ty, string) result =
+  match js with
+  | `Variant ("Adt", Some (`Tuple [ id; regions; types ])) ->
+      let* id = TypeDefId.id_of_json id in
+      let* regions = list_of_json r_of_json regions in
+      let* types = list_of_json (ty_of_json r_of_json) types in
+      Ok (Adt (id, regions, types))
+  | `Variant ("TypeVar", Some id) ->
+      let* id = TypeVarId.id_of_json id in
+      Ok (TypeVar id)
+  | `Variant ("Bool", None) -> Ok Bool
+  | `Variant ("Char", None) -> Ok Char
+  | `Variant ("Never", None) -> Ok Never
+  | `Variant ("Integer", Some int_ty) ->
+      let* int_ty = integer_type_of_json int_ty in
+      Ok (Integer int_ty)
+  | `Variant ("Str", None) -> Ok Str
+  | `Variant ("Array", Some ty) ->
+      let* ty = ty_of_json r_of_json ty in
+      Ok (Array ty)
+  | `Variant ("Slice", Some ty) ->
+      let* ty = ty_of_json r_of_json ty in
+      Ok (Slice ty)
+  | `Variant ("Ref", Some (`Tuple [ region; ty; ref_kind ])) ->
+      let* region = r_of_json region in
+      let* ty = ty_of_json r_of_json ty in
+      let* ref_kind = ref_kind_of_json ref_kind in
+      Ok (Ref (region, ty, ref_kind))
+  | `Variant ("Tuple", Some types) ->
+      let* types = list_of_json (ty_of_json r_of_json) types in
+      Ok (Tuple types)
+  | `Variant ("Assumed", Some (`Tuple [ assumed_ty; regions; types ])) ->
+      let* assumed_ty = assumed_ty_of_json assumed_ty in
+      let* regions = list_of_json r_of_json regions in
+      let* types = list_of_json (ty_of_json r_of_json) types in
+      Ok (Assumed (assumed_ty, regions, types))
+  | _ -> Error ("ty_of_json failed on:" ^ show js)
+
+(*
+open Values
+open Expressions
+open CfimAst*)
diff --git a/src/Identifiers.ml b/src/Identifiers.ml
index 27ed2921..1b9e114c 100644
--- a/src/Identifiers.ml
+++ b/src/Identifiers.ml
@@ -19,6 +19,8 @@ module type Id = sig
 
   val id_of_yojson : Yojson.Safe.t -> (id, string) Result.result
 
+  val id_of_json : Yojson.Safe.t -> (id, string) Result.result
+
   val id_to_yojson : id -> Yojson.Safe.t
 
   val vector_of_yojson :
@@ -26,6 +28,11 @@ module type Id = sig
     Yojson.Safe.t ->
     ('a vector, string) Result.result
 
+  val vector_of_json :
+    (Yojson.Safe.t -> ('a, string) Result.result) ->
+    Yojson.Safe.t ->
+    ('a vector, string) Result.result
+
   val vector_to_yojson : ('a -> Yojson.Safe.t) -> 'a vector -> Yojson.Safe.t
 
   (* TODO: remove *)
@@ -52,6 +59,10 @@ module IdGen () : Id = struct
 
   let to_string = string_of_int
 
+  let id_of_json = id_of_yojson
+
+  let vector_of_json = vector_of_yojson
+
   (* TODO: how to make this work? *)
   (* (module Ord : Map.OrderedType = struct
        type t = id
diff --git a/src/Types.ml b/src/Types.ml
index c56f4b43..cf416750 100644
--- a/src/Types.ml
+++ b/src/Types.ml
@@ -11,14 +11,14 @@ module FieldId = IdGen ()
 module RegionVarId = IdGen ()
 
 type type_var = {
-  index : TypeVarId.id;  (** Unique index identifying the variable *)
-  name : string;  (** Variable name *)
+  tv_index : TypeVarId.id;  (** Unique index identifying the variable *)
+  tv_name : string;  (** Variable name *)
 }
 [@@deriving yojson]
 
 type region_var = {
-  index : RegionVarId.id;  (** Unique index identifying the region *)
-  name : string option;  (** Region name *)
+  rv_index : RegionVarId.id;  (** Unique index identifying the region *)
+  rv_name : string option;  (** Region name *)
 }
 [@@deriving yojson]
 
@@ -70,7 +70,7 @@ type 'r ty =
   | Slice of 'r ty
   | Ref of 'r * 'r ty * ref_kind
   | Tuple of 'r ty list
-  | Assumed of assumed_ty * 'r list * 'r ty
+  | Assumed of assumed_ty * 'r list * 'r ty list
 [@@deriving yojson]
 
 type rty = RegionVarId.id region ty [@@deriving yojson]
diff --git a/src/main.ml b/src/main.ml
index ce0a9269..7f130949 100644
--- a/src/main.ml
+++ b/src/main.ml
@@ -1,5 +1,6 @@
 open Types
 open CfimAst
+open CfimOfJson
 
 type declaration =
   | Type of TypeDefId.id
@@ -24,6 +25,9 @@ let () =
   let e1 = Statement Return in
   let e1_json = expression_to_yojson e1 in
   print_endline (Yojson.Safe.to_string e1_json);
+  let int_ty = Isize in
+  let int_ty_json = integer_type_to_yojson int_ty in
+  print_endline (Yojson.Safe.to_string int_ty_json);
   let json2 = Yojson.Safe.from_string "[\"Return\"]" in
   match statement_of_yojson json2 with
   | Error s -> Printf.printf "error: %s\n" s
-- 
cgit v1.2.3