|
1 (* Title: symtab |
|
2 ID: $Id$ |
|
3 Author: Lawrence C Paulson, Cambridge University Computer Laboratory |
|
4 Copyright 1989 University of Cambridge |
|
5 *) |
|
6 |
|
7 (*Unbalanced binary trees indexed by strings |
|
8 No way to delete an entry |
|
9 could generalize alist_of to a traversal functional |
|
10 *) |
|
11 |
|
12 signature SYMTAB = |
|
13 sig |
|
14 type 'a table |
|
15 val alist_of : 'a table -> (string*'a) list |
|
16 val balance : 'a table -> 'a table |
|
17 val lookup : 'a table * string -> 'a option |
|
18 val null : 'a table |
|
19 val is_null : 'a table -> bool |
|
20 val st_of_alist : (string*'a)list * 'a table -> 'a table |
|
21 val st_of_declist : (string list * 'a)list * 'a table -> 'a table |
|
22 val update : (string*'a) * 'a table -> 'a table |
|
23 val update_new : (string*'a) * 'a table -> 'a table |
|
24 exception DUPLICATE of string |
|
25 end; |
|
26 |
|
27 |
|
28 functor SymtabFun () : SYMTAB = |
|
29 struct |
|
30 |
|
31 (*symbol table errors, such as from update_new*) |
|
32 exception DUPLICATE of string; |
|
33 |
|
34 datatype 'a table = Tip | Branch of (string * 'a * 'a table * 'a table); |
|
35 |
|
36 |
|
37 val null = Tip; |
|
38 |
|
39 fun is_null Tip = true |
|
40 | is_null _ = false; |
|
41 |
|
42 |
|
43 fun lookup (symtab: 'a table, key: string) : 'a option = |
|
44 let fun look Tip = None |
|
45 | look (Branch (key',entry,left,right)) = |
|
46 if key < key' then look left |
|
47 else if key' < key then look right |
|
48 else Some entry |
|
49 in look symtab end; |
|
50 |
|
51 (*update, allows overwriting of an entry*) |
|
52 fun update ((key: string, entry: 'a), symtab : 'a table) |
|
53 : 'a table = |
|
54 let fun upd Tip = Branch (key,entry,Tip,Tip) |
|
55 | upd (Branch(key',entry',left,right)) = |
|
56 if key < key' then Branch (key',entry', upd left, right) |
|
57 else if key' < key then Branch (key',entry',left, upd right) |
|
58 else Branch (key,entry,left,right) |
|
59 in upd symtab end; |
|
60 |
|
61 (*Like update but fails if key is already defined in table. |
|
62 Allows st_of_alist, etc. to detect multiple definitions*) |
|
63 fun update_new ((key: string, entry: 'a), symtab : 'a table) |
|
64 : 'a table = |
|
65 let fun upd Tip = Branch (key,entry,Tip,Tip) |
|
66 | upd (Branch(key',entry',left,right)) = |
|
67 if key < key' then Branch (key',entry', upd left, right) |
|
68 else if key' < key then Branch (key',entry',left, upd right) |
|
69 else raise DUPLICATE(key) |
|
70 in upd symtab end; |
|
71 |
|
72 (*conversion of symbol table to sorted association list*) |
|
73 fun alist_of (symtab : 'a table) : (string * 'a) list = |
|
74 let fun ali (symtab,cont) = case symtab of |
|
75 Tip => cont |
|
76 | Branch (key,entry,left,right) => |
|
77 ali(left, (key,entry) :: ali(right,cont)) |
|
78 in ali (symtab,[]) end; |
|
79 |
|
80 |
|
81 (*Make a balanced tree of the first n members of the sorted alist (sal). |
|
82 Utility for the function balance.*) |
|
83 fun bal_of (sal, 0) = Tip |
|
84 | bal_of (sal, n) = |
|
85 let val mid = n div 2 |
|
86 in case drop (mid,sal) of |
|
87 [] => bal_of (sal, mid) (*should not occur*) |
|
88 | ((key,entry):: pairs) => |
|
89 Branch(key,entry, bal_of(sal,mid), bal_of(pairs, n-mid-1)) |
|
90 end; |
|
91 |
|
92 |
|
93 fun balance symtab = |
|
94 let val sal = alist_of symtab |
|
95 in bal_of (sal, length sal) end; |
|
96 |
|
97 |
|
98 (*Addition of association list to a symbol table*) |
|
99 fun st_of_alist (al, symtab) = |
|
100 foldr update_new (al, symtab); |
|
101 |
|
102 (*A "declaration" associates the same entry with a list of keys; |
|
103 does not allow overwriting of an entry*) |
|
104 fun decl_update_new ((keys : string list, entry: 'a), symtab) |
|
105 : 'a table = |
|
106 let fun decl (key,symtab) = update_new((key,entry), symtab) |
|
107 in foldr decl (keys, symtab) end; |
|
108 |
|
109 (*Addition of a list of declarations to a symbol table*) |
|
110 fun st_of_declist (dl, symtab) = |
|
111 balance (foldr decl_update_new (dl, symtab)) |
|
112 |
|
113 end; |
|
114 |