summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSon Ho2021-11-17 16:39:33 +0100
committerSon Ho2021-11-17 16:39:33 +0100
commit7586d9e28304fcbbeaa5cde904f5bd52125ba491 (patch)
treea166530e822b3d039a6a4af083cfca2f77c30ede
parentdabf9836f8bf59d4590e4bef126299492c9b53de (diff)
Make more progress on CfimOfJson
Diffstat (limited to '')
-rw-r--r--src/CfimOfJson.ml54
-rw-r--r--src/Types.ml4
2 files changed, 56 insertions, 2 deletions
diff --git a/src/CfimOfJson.ml b/src/CfimOfJson.ml
index 156cf42a..2ce70ea3 100644
--- a/src/CfimOfJson.ml
+++ b/src/CfimOfJson.ml
@@ -160,6 +160,60 @@ let rec ty_of_json (r_of_json : json -> ('r, string) result) (js : json) :
Ok (Assumed (assumed_ty, regions, types))
| _ -> Error ("ty_of_json failed on:" ^ show js)
+let rty_of_json (js : json) : (rty, string) result =
+ ty_of_json region_of_json js
+
+let ety_of_json (js : json) : (ety, string) result =
+ ty_of_json erased_region_of_json js
+
+let field_of_json (js : json) : (field, string) result =
+ match js with
+ | `Assoc [ ("name", name); ("ty", ty) ] ->
+ let* name = string_of_json name in
+ let* ty = rty_of_json ty in
+ Ok { field_name = name; field_ty = ty }
+ | _ -> Error ("field_of_json failed on:" ^ show js)
+
+let variant_of_json (js : json) : (variant, string) result =
+ match js with
+ | `Assoc [ ("name", name); ("fields", fields) ] ->
+ let* name = string_of_json name in
+ let* fields = FieldId.vector_of_json field_of_json fields in
+ Ok { variant_name = name; fields }
+ | _ -> Error ("variant_of_json failed on:" ^ show js)
+
+let type_def_kind_of_json (js : json) : (type_def_kind, string) result =
+ match js with
+ | `Variant ("Struct", Some fields) ->
+ let* fields = FieldId.vector_of_json field_of_json fields in
+ Ok (Struct fields)
+ | `Variant ("Enum", Some variants) ->
+ let* variants = VariantId.vector_of_json variant_of_json variants in
+ Ok (Enum variants)
+ | _ -> Error ("type_def_kind_of_json failed on:" ^ show js)
+
+let type_def_of_json (js : json) : (type_def, string) result =
+ match js with
+ | `Assoc
+ [
+ ("def_id", def_id);
+ ("name", name);
+ ("region_params", region_params);
+ ("type_params", type_params);
+ ("kind", kind);
+ ] ->
+ let* def_id = TypeDefId.id_of_json def_id in
+ let* name = name_of_json name in
+ let* region_params =
+ RegionVarId.vector_of_json region_var_of_json region_params
+ in
+ let* type_params =
+ TypeVarId.vector_of_json type_var_of_json type_params
+ in
+ let* kind = type_def_kind_of_json kind in
+ Ok { def_id; name; region_params; type_params; kind }
+ | _ -> Error ("type_def_of_json failed on:" ^ show js)
+
(*
open Values
open Expressions
diff --git a/src/Types.ml b/src/Types.ml
index cf416750..826531f6 100644
--- a/src/Types.ml
+++ b/src/Types.ml
@@ -85,9 +85,9 @@ type ety = erased_region ty [@@deriving yojson]
Used in function bodies, "general" value types, etc.
*)
-type field = { name : string; ty : rty } [@@deriving yojson]
+type field = { field_name : string; field_ty : rty } [@@deriving yojson]
-type variant = { name : string; fields : field FieldId.vector }
+type variant = { variant_name : string; fields : field FieldId.vector }
[@@deriving yojson]
type type_def_kind =