From d924c8699e95971fbc09d1f12299930a6fd9b5e2 Mon Sep 17 00:00:00 2001
From: Valentin Perrelle <valentin.perrelle@cea.fr>
Date: Thu, 30 Jan 2025 16:34:13 +0100
Subject: [PATCH] [kernel] allow registering a type twice if the digest is the
same
- Type.register returns the first registered type instead of a new one
---
src/libraries/datatype/type.ml | 16 ++++++++++++----
1 file changed, 12 insertions(+), 4 deletions(-)
diff --git a/src/libraries/datatype/type.ml b/src/libraries/datatype/type.ml
index 69d76d23ce..333102e77d 100644
--- a/src/libraries/datatype/type.ml
+++ b/src/libraries/datatype/type.ml
@@ -84,7 +84,6 @@ let register ?(closure=false) ~name structural_descr reprs =
thus that is correct to check only the first one *)
error ()
| _ ->
- if Hashtbl.mem types name then raise (AlreadyExists name);
let digest = match structural_descr with
| Structural_descr.Unknown ->
(* unserializable type: weakest digest *)
@@ -98,9 +97,18 @@ let register ?(closure=false) ~name structural_descr reprs =
digest = digest;
structural_descr = structural_descr }
in
- let full_ty = { ty = ty; reprs = List.map Obj.repr reprs } in
- Hashtbl.add types name full_ty;
- ty
+ match Hashtbl.find_opt types name with
+ (* Either the type is already registered *)
+ | Some full_ty ->
+ (* then check that the new type is the same as the old one *)
+ if equal ty full_ty.ty
+ then full_ty.ty
+ else raise (AlreadyExists name)
+ (* or this is a brand new type *)
+ | None ->
+ let full_ty = { ty = ty; reprs = List.map Obj.repr reprs } in
+ Hashtbl.add types name full_ty;
+ ty
let add_abstract_types = ref (fun _ _ -> ())
--
GitLab