added object.ML;
authorwenzelm
Fri, 05 Jun 1998 14:21:11 +0200
changeset 4991 d7d525466221
parent 4990 25da60d0a20b
child 4992 c63a93b8577c
added object.ML;
src/Pure/IsaMakefile
src/Pure/ROOT.ML
src/Pure/object.ML
--- a/src/Pure/IsaMakefile	Tue Jun 02 15:08:42 1998 +0200
+++ b/src/Pure/IsaMakefile	Fri Jun 05 14:21:11 1998 +0200
@@ -34,9 +34,9 @@
   Thy/thy_parse.ML Thy/thy_read.ML Thy/thy_scan.ML Thy/thy_syn.ML \
   Thy/use.ML attribute.ML axclass.ML basis.ML deriv.ML display.ML \
   drule.ML envir.ML goals.ML install_pp.ML library.ML logic.ML \
-  name_space.ML net.ML pattern.ML pure_thy.ML search.ML seq.ML sign.ML \
-  sorts.ML table.ML tactic.ML tctical.ML term.ML theory.ML thm.ML \
-  type.ML type_infer.ML unify.ML
+  name_space.ML net.ML object.ML pattern.ML pure_thy.ML search.ML \
+  seq.ML sign.ML sorts.ML table.ML tactic.ML tctical.ML term.ML \
+  theory.ML thm.ML type.ML type_infer.ML unify.ML
 	@./mk
 
 
--- a/src/Pure/ROOT.ML	Tue Jun 02 15:08:42 1998 +0200
+++ b/src/Pure/ROOT.ML	Fri Jun 05 14:21:11 1998 +0200
@@ -16,6 +16,7 @@
 (*basic utils*)
 use "library.ML";
 use "table.ML";
+use "object.ML";
 use "seq.ML";
 use "name_space.ML";
 use "term.ML";
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/Pure/object.ML	Fri Jun 05 14:21:11 1998 +0200
@@ -0,0 +1,42 @@
+(*  Title:      Pure/object.ML
+    ID:         $Id$
+    Author:     Markus Wenzel, TU Muenchen
+
+Generic objects of arbitrary type -- fool the ML type system via
+exception constructors.
+*)
+
+signature OBJECT =
+sig
+  type T
+  type kind
+  val kind: string -> kind
+  val name_of_kind: kind -> string
+  val eq_kind: kind * kind -> bool
+  val kind_error: kind -> 'a
+end;
+
+structure Object: OBJECT =
+struct
+
+
+(* anytype values *)
+
+type T = exn;
+
+
+(* kinds *)
+
+datatype kind = Kind of string * stamp;
+
+fun kind name = Kind (name, stamp ());
+
+fun name_of_kind (Kind (name, _)) = name;
+
+fun eq_kind (Kind (_, s1), Kind (_, s2)) = s1 = s2;
+
+fun kind_error k =
+  error ("## RUNTIME TYPE ERROR ##\nFailed to access " ^ quote (name_of_kind k) ^ " object");
+
+
+end;