summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/CfimOfJson.ml166
-rw-r--r--src/Identifiers.ml11
-rw-r--r--src/Types.ml10
-rw-r--r--src/main.ml4
4 files changed, 186 insertions, 5 deletions
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
generated by cgit v1.2.3 (git 2.25.1) at 2024-10-19 11:32:07 +0000