diff options
Diffstat (limited to 'src/CfimOfJson.ml')
| -rw-r--r-- | src/CfimOfJson.ml | 93 |
1 files changed, 60 insertions, 33 deletions
diff --git a/src/CfimOfJson.ml b/src/CfimOfJson.ml index a1dd0ad1..dddfbd58 100644 --- a/src/CfimOfJson.ml +++ b/src/CfimOfJson.ml @@ -159,6 +159,21 @@ let type_def_kind_of_json (js : json) : (T.type_def_kind, string) result = Ok (T.Enum variants) | _ -> Error "") +let region_var_group_of_json (js : json) : (T.region_var_group, string) result = + combine_error_msgs js "region_var_group_of_json" + (match js with + | `Assoc [ ("id", id); ("regions", regions); ("parents", parents) ] -> + let* id = T.RegionGroupId.id_of_json id in + let* regions = list_of_json T.RegionVarId.id_of_json regions in + let* parents = list_of_json T.RegionGroupId.id_of_json parents in + Ok { T.id; regions; parents } + | _ -> Error "") + +let region_var_groups_of_json (js : json) : (T.region_var_groups, string) result + = + combine_error_msgs js "region_var_group_of_json" + (list_of_json region_var_group_of_json js) + let type_def_of_json (js : json) : (T.type_def, string) result = combine_error_msgs js "type_def_of_json" (match js with @@ -169,13 +184,23 @@ let type_def_of_json (js : json) : (T.type_def, string) result = ("region_params", region_params); ("type_params", type_params); ("kind", kind); + ("regions_hierarchy", regions_hierarchy); ] -> let* def_id = T.TypeDefId.id_of_json def_id in let* name = name_of_json name in let* region_params = list_of_json region_var_of_json region_params in let* type_params = list_of_json type_var_of_json type_params in let* kind = type_def_kind_of_json kind in - Ok { T.def_id; name; region_params; type_params; kind } + let* regions_hierarchy = region_var_groups_of_json regions_hierarchy in + Ok + { + T.def_id; + name; + region_params; + type_params; + kind; + regions_hierarchy; + } | _ -> Error "") let var_of_json (js : json) : (A.var, string) result = @@ -436,21 +461,6 @@ let assertion_of_json (js : json) : (A.assertion, string) result = Ok { A.cond; expected } | _ -> Error "") -let region_var_group_of_json (js : json) : (A.region_var_group, string) result = - combine_error_msgs js "region_var_group_of_json" - (match js with - | `Assoc [ ("id", id); ("regions", regions); ("parents", parents) ] -> - let* id = A.RegionGroupId.id_of_json id in - let* regions = list_of_json T.RegionVarId.id_of_json regions in - let* parents = list_of_json A.RegionGroupId.id_of_json parents in - Ok { A.id; regions; parents } - | _ -> Error "") - -let region_var_groups_of_json (js : json) : (A.region_var_groups, string) result - = - combine_error_msgs js "region_var_group_of_json" - (list_of_json region_var_group_of_json js) - let fun_sig_of_json (js : json) : (A.fun_sig, string) result = combine_error_msgs js "fun_sig_of_json" (match js with @@ -570,7 +580,6 @@ let fun_def_of_json (js : json) : (A.fun_def, string) result = ("def_id", def_id); ("name", name); ("signature", signature); - ("divergent", divergent); ("arg_count", arg_count); ("locals", locals); ("body", body); @@ -578,28 +587,44 @@ let fun_def_of_json (js : json) : (A.fun_def, string) result = let* def_id = A.FunDefId.id_of_json def_id in let* name = name_of_json name in let* signature = fun_sig_of_json signature in - let* divergent = bool_of_json divergent in let* arg_count = int_of_json arg_count in let* locals = list_of_json var_of_json locals in let* body = statement_of_json body in - Ok { A.def_id; name; signature; divergent; arg_count; locals; body } + Ok { A.def_id; name; signature; arg_count; locals; body } | _ -> Error "") -let declaration_of_json (js : json) : (M.declaration, string) result = +let g_declaration_group_of_json (id_of_json : json -> ('id, string) result) + (js : json) : ('id M.g_declaration_group, string) result = + combine_error_msgs js "g_declaration_group_of_json" + (match js with + | `Assoc [ ("NonRec", `List [ id ]) ] -> + let* id = id_of_json id in + Ok (M.NonRec id) + | `Assoc [ ("Rec", `List [ ids ]) ] -> + let* ids = list_of_json id_of_json ids in + Ok (M.Rec ids) + | _ -> Error "") + +let type_declaration_group_of_json (js : json) : + (M.type_declaration_group, string) result = + combine_error_msgs js "type_declaration_group_of_json" + (g_declaration_group_of_json T.TypeDefId.id_of_json js) + +let fun_declaration_group_of_json (js : json) : + (M.fun_declaration_group, string) result = + combine_error_msgs js "fun_declaration_group_of_json" + (g_declaration_group_of_json A.FunDefId.id_of_json js) + +let declaration_group_of_json (js : json) : (M.declaration_group, string) result + = combine_error_msgs js "declaration_of_json" (match js with - | `Assoc [ ("Type", id) ] -> - let* id = T.TypeDefId.id_of_json id in - Ok (M.Type id) - | `Assoc [ ("Fun", id) ] -> - let* id = A.FunDefId.id_of_json id in - Ok (M.Fun id) - | `Assoc [ ("RecTypes", ids) ] -> - let* ids = list_of_json T.TypeDefId.id_of_json ids in - Ok (M.RecTypes ids) - | `Assoc [ ("RecFuns", ids) ] -> - let* ids = list_of_json A.FunDefId.id_of_json ids in - Ok (M.RecFuns ids) + | `Assoc [ ("Type", `List [ decl ]) ] -> + let* decl = type_declaration_group_of_json decl in + Ok (M.Type decl) + | `Assoc [ ("Fun", `List [ decl ]) ] -> + let* decl = fun_declaration_group_of_json decl in + Ok (M.Fun decl) | _ -> Error "") let cfim_module_of_json (js : json) : (M.cfim_module, string) result = @@ -611,7 +636,9 @@ let cfim_module_of_json (js : json) : (M.cfim_module, string) result = ("types", types); ("functions", functions); ] -> - let* declarations = list_of_json declaration_of_json declarations in + let* declarations = + list_of_json declaration_group_of_json declarations + in let* types = list_of_json type_def_of_json types in let* functions = list_of_json fun_def_of_json functions in Ok { M.declarations; types; functions } |