aboutsummaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
-rw-r--r--checker/check.mllib1
-rw-r--r--dev/printers.mllib1
-rw-r--r--grammar/grammar.mllib1
-rw-r--r--lib/canary.ml26
-rw-r--r--lib/canary.mli25
-rw-r--r--lib/clib.mllib1
6 files changed, 55 insertions, 0 deletions
diff --git a/checker/check.mllib b/checker/check.mllib
index 80c7ac7e6..bb2146f38 100644
--- a/checker/check.mllib
+++ b/checker/check.mllib
@@ -1,6 +1,7 @@
Coq_config
Hook
+Canary
Hashset
Hashcons
CSet
diff --git a/dev/printers.mllib b/dev/printers.mllib
index 71c88bc21..1dfca3435 100644
--- a/dev/printers.mllib
+++ b/dev/printers.mllib
@@ -1,6 +1,7 @@
Coq_config
Hook
+Canary
Hashset
Hashcons
CSet
diff --git a/grammar/grammar.mllib b/grammar/grammar.mllib
index c2f39deed..338d44fbf 100644
--- a/grammar/grammar.mllib
+++ b/grammar/grammar.mllib
@@ -1,6 +1,7 @@
Coq_config
Hook
+Canary
Hashset
Hashcons
CSet
diff --git a/lib/canary.ml b/lib/canary.ml
new file mode 100644
index 000000000..f27890c16
--- /dev/null
+++ b/lib/canary.ml
@@ -0,0 +1,26 @@
+(************************************************************************)
+(* v * The Coq Proof Assistant / The Coq Development Team *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
+(* \VV/ **************************************************************)
+(* // * This file is distributed under the terms of the *)
+(* * GNU Lesser General Public License Version 2.1 *)
+(************************************************************************)
+
+type t = Obj.t
+
+let obj = Obj.new_block Obj.closure_tag 0
+ (** This is an empty closure block. In the current implementation, it is
+ sufficient to allow marshalling but forbid equality. Sadly still allows
+ hash. *)
+ (** FIXME : use custom blocks somehow. *)
+
+module type Obj = sig type t end
+
+module Make(M : Obj) =
+struct
+ type canary = t
+ type t = (canary * M.t)
+
+ let prj (_, x) = x
+ let inj x = (obj, x)
+end
diff --git a/lib/canary.mli b/lib/canary.mli
new file mode 100644
index 000000000..fd65cb84c
--- /dev/null
+++ b/lib/canary.mli
@@ -0,0 +1,25 @@
+(************************************************************************)
+(* v * The Coq Proof Assistant / The Coq Development Team *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
+(* \VV/ **************************************************************)
+(* // * This file is distributed under the terms of the *)
+(* * GNU Lesser General Public License Version 2.1 *)
+(************************************************************************)
+
+type t
+(** Type of canaries. Canaries are used to ensure that an object does not use
+ generic operations. *)
+
+val obj : t
+(** Canary. In the current implementation, this object is marshallable,
+ forbids generic comparison but still allows generic hashes. *)
+
+module type Obj = sig type t end
+
+module Make(M : Obj) :
+sig
+ type t
+ val prj : t -> M.t
+ val inj : M.t -> t
+end
+(** Adds a canary to any type. *)
diff --git a/lib/clib.mllib b/lib/clib.mllib
index 2547ed229..1dc540b9a 100644
--- a/lib/clib.mllib
+++ b/lib/clib.mllib
@@ -1,5 +1,6 @@
Coq_config
+Canary
Hook
Hashset
Hashcons