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