1(* 2 Copyright (c) 2000 3 Cambridge University Technical Services Limited 4 5 This library is free software; you can redistribute it and/or 6 modify it under the terms of the GNU Lesser General Public 7 License as published by the Free Software Foundation; either 8 version 2.1 of the License, or (at your option) any later version. 9 10 This library is distributed in the hope that it will be useful, 11 but WITHOUT ANY WARRANTY; without even the implied warranty of 12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 13 Lesser General Public License for more details. 14 15 You should have received a copy of the GNU Lesser General Public 16 License along with this library; if not, write to the Free Software 17 Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA 18*) 19 20structure UniversalTable : 21sig 22 type universal; 23 type 'a tag; 24 type univTable; 25 26 val makeUnivTable: unit -> univTable; 27 28 val univEnter: univTable * 'a tag * string * 'a -> unit; 29 val univLookup: univTable * 'a tag * string -> 'a option; 30 val univDelete: univTable * 'a tag * string -> unit; 31 32 val fold: (string * universal * 'a -> 'a) -> 'a -> univTable -> 'a 33 val app: (string * universal -> unit) -> univTable -> unit 34 35 val univFold: univTable * (string * universal * 'a -> 'a) * 'a -> 'a 36 37 (* Freeze a mutable table so it is immutable. *) 38 val univFreeze: univTable -> univTable 39 40end = 41 42struct 43 open Misc; 44 open HashTable; 45 open Universal; 46 47 type universal = universal 48 49 datatype univTable = Table of universal list hash 50 51 fun makeUnivTable() = Table (hashMake 10); (* Choose a number. *) 52 53 fun univLookup (Table tab, t:'a tag, name:string) : 'a option = 54 let 55 fun search [] = NONE 56 | search (H::T) = if tagIs t H then SOME (tagProject t H) else search T; 57 in 58 case hashSub (tab, name) of 59 NONE => NONE 60 | SOME t => search t 61 end 62 63 fun univEnter (Table tab, t:'a tag, name:string, v:'a) : unit = 64 let 65 val u = tagInject t v; 66 67 (* If there is already an entry we add it to the list, 68 otherwise we start a new list. *) 69 70 fun search [] = [u] 71 | search (H::T) = if tagIs t H then u :: T else H :: search T; 72 73 val newList = 74 case hashSub (tab, name) of 75 SOME v => search v 76 | NONE => [u] 77 in 78 hashSet (tab, name, newList) 79 end; 80 81 fun univDelete (Table tab, t:'a tag, name:string) : unit = 82 let 83 fun search [] = [] 84 | search (H::T) = if tagIs t H then T else H :: search T; 85 in 86 case hashSub (tab, name) of 87 SOME l => hashSet (tab, name, search l) 88 | NONE => () 89 end; 90 91 92 fun fold f acc (Table table) = 93 let 94 fun foldHashEntry (s, l, acc) = 95 List.foldl (fn (c, a) => f (s, c, a)) acc l 96 in 97 HashTable.fold foldHashEntry acc table 98 end 99 100 fun app f = fold (fn (s, c, ()) => f (s, c)) () 101 102 (* Backwards compatibility. *) 103 fun univFold (t, f, acc) = fold f acc t 104 105 fun univFreeze (Table h) = Table(hashFreeze h) 106 107end (* UniversalTable *); 108