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