1-----------------------------------------------------------------------------
2-- |
3-- Module      :  SymTab
4-- Copyright   :  2000-2004 Malcolm Wallace
5-- Licence     :  LGPL
6--
7-- Maintainer  :  Malcolm Wallace <Malcolm.Wallace@cs.york.ac.uk>
8-- Stability   :  Stable
9-- Portability :  All
10--
11-- Symbol Table, based on index trees using a hash on the key.
12--   Keys are always Strings.  Stored values can be any type.
13-----------------------------------------------------------------------------
14
15module Language.Preprocessor.Cpphs.SymTab
16  ( SymTab
17  , emptyST
18  , insertST
19  , deleteST
20  , lookupST
21  , definedST
22  , flattenST
23  , IndTree
24  ) where
25
26-- | Symbol Table.  Stored values are polymorphic, but the keys are
27--   always strings.
28type SymTab v = IndTree [(String,v)]
29
30emptyST   :: SymTab v
31insertST  :: (String,v) -> SymTab v -> SymTab v
32deleteST  :: String -> SymTab v -> SymTab v
33lookupST  :: String -> SymTab v -> Maybe v
34definedST :: String -> SymTab v -> Bool
35flattenST :: SymTab v -> [v]
36
37emptyST           = itgen maxHash []
38insertST (s,v) ss = itiap (hash s) ((s,v):)    ss id
39deleteST  s    ss = itiap (hash s) (filter ((/=s).fst)) ss id
40lookupST  s    ss = let vs = filter ((==s).fst) ((itind (hash s)) ss)
41                    in if null vs then Nothing
42                       else (Just . snd . head) vs
43definedST s    ss = let vs = filter ((==s).fst) ((itind (hash s)) ss)
44                    in (not . null) vs
45flattenST      ss = itfold (map snd) (++) ss
46
47
48----
49-- | Index Trees (storing indexes at nodes).
50
51data IndTree t = Leaf t | Fork Int (IndTree t) (IndTree t)
52     deriving Show
53
54itgen :: Int -> a -> IndTree a
55itgen 1 x = Leaf x
56itgen n x =
57  let n' = n `div` 2
58  in Fork n' (itgen n' x) (itgen (n-n') x)
59
60itiap :: --Eval a =>
61         Int -> (a->a) -> IndTree a -> (IndTree a -> b) -> b
62itiap _ f (Leaf x)       k = let fx = f x in {-seq fx-} (k (Leaf fx))
63itiap i f (Fork n lt rt) k =
64  if i<n then
65       itiap i f lt $ \lt' -> k (Fork n lt' rt)
66  else itiap (i-n) f rt $ \rt' -> k (Fork n lt rt')
67
68itind :: Int -> IndTree a -> a
69itind _ (Leaf x) = x
70itind i (Fork n lt rt) = if i<n then itind i lt else itind (i-n) rt
71
72itfold :: (a->b) -> (b->b->b) -> IndTree a -> b
73itfold leaf _fork (Leaf x) = leaf x
74itfold leaf  fork (Fork _ l r) = fork (itfold leaf fork l) (itfold leaf fork r)
75
76----
77-- Hash values
78
79maxHash :: Int -- should be prime
80maxHash = 101
81
82class Hashable a where
83    hashWithMax :: Int -> a -> Int
84    hash        :: a -> Int
85    hash = hashWithMax maxHash
86
87instance Enum a => Hashable [a] where
88    hashWithMax m = h 0
89        where h a []     = a
90              h a (c:cs) = h ((17*(fromEnum c)+19*a)`rem`m) cs
91
92----
93