| 6118 |      1 | (*  Title:      Pure/General/object.ML
 | 
| 5016 |      2 |     ID:         $Id$
 | 
|  |      3 |     Author:     Markus Wenzel, TU Muenchen
 | 
|  |      4 | 
 | 
|  |      5 | Generic objects of arbitrary type -- fool the ML type system via
 | 
|  |      6 | exception constructors.
 | 
|  |      7 | *)
 | 
|  |      8 | 
 | 
|  |      9 | signature OBJECT =
 | 
|  |     10 | sig
 | 
|  |     11 |   type T
 | 
|  |     12 |   type kind
 | 
|  |     13 |   val kind: string -> kind
 | 
|  |     14 |   val name_of_kind: kind -> string
 | 
|  |     15 |   val eq_kind: kind * kind -> bool
 | 
|  |     16 |   val kind_error: kind -> 'a
 | 
|  |     17 | end;
 | 
|  |     18 | 
 | 
|  |     19 | structure Object: OBJECT =
 | 
|  |     20 | struct
 | 
|  |     21 | 
 | 
|  |     22 | 
 | 
|  |     23 | (* anytype values *)
 | 
|  |     24 | 
 | 
|  |     25 | type T = exn;
 | 
|  |     26 | 
 | 
|  |     27 | 
 | 
|  |     28 | (* kinds *)
 | 
|  |     29 | 
 | 
|  |     30 | datatype kind = Kind of string * stamp;
 | 
|  |     31 | 
 | 
|  |     32 | fun kind name = Kind (name, stamp ());
 | 
|  |     33 | 
 | 
|  |     34 | fun name_of_kind (Kind (name, _)) = name;
 | 
|  |     35 | 
 | 
|  |     36 | fun eq_kind (Kind (_, s1), Kind (_, s2)) = s1 = s2;
 | 
|  |     37 | 
 | 
|  |     38 | fun kind_error k =
 | 
|  |     39 |   error ("## RUNTIME TYPE ERROR ##\nFailed to access " ^ quote (name_of_kind k) ^ " object");
 | 
|  |     40 | 
 | 
|  |     41 | 
 | 
|  |     42 | end;
 |