X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;ds=inline;f=helm%2FDEVEL%2Flablgtk%2Flablgtk_20000829-0.1.0%2Fgpointer.ml;fp=helm%2FDEVEL%2Flablgtk%2Flablgtk_20000829-0.1.0%2Fgpointer.ml;h=7d28a1f9d8a00ebf8a30d39fa8786809633db0c6;hb=2ee84a2a641938988703e329aef9fc3c5eb5aacf;hp=0000000000000000000000000000000000000000;hpb=34d83812af9b7064cc8f735c2a78169881140010;p=helm.git

diff --git a/helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/gpointer.ml b/helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/gpointer.ml
new file mode 100644
index 000000000..7d28a1f9d
--- /dev/null
+++ b/helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/gpointer.ml
@@ -0,0 +1,41 @@
+(* $Id$ *)
+
+(* marked pointers *)
+type 'a optaddr
+
+let optaddr : 'a option -> 'a optaddr =
+  function
+      None -> Obj.magic 0
+    | Some x -> Obj.magic x
+
+(* naked pointers *)
+type optstring
+
+external get_null : unit -> optstring = "ml_get_null"
+let raw_null = get_null ()
+
+let optstring : string option -> optstring =
+  function
+      None -> raw_null
+    | Some x -> Obj.magic x
+
+(* boxed pointers *)
+type boxed
+let boxed_null : boxed = Obj.magic (0, raw_null)
+
+type 'a optboxed
+
+let optboxed : 'a option -> 'a optboxed =
+  function
+      None -> Obj.magic boxed_null
+    | Some obj -> Obj.magic obj
+
+let may_box ~f obj : 'a optboxed =
+  match obj with
+    None -> Obj.magic boxed_null
+  | Some obj -> Obj.magic (f obj : 'a)
+
+(* Exceptions *)
+
+exception Null
+let _ =  Callback.register_exception "null_pointer" Null