module Language.Preprocessor.Cpphs.SymTab
( SymTab
, emptyST
, insertST
, deleteST
, lookupST
, definedST
, flattenST
, IndTree
) where
type SymTab v = IndTree [(String,v)]
emptyST :: SymTab v
insertST :: (String,v) -> SymTab v -> SymTab v
deleteST :: String -> SymTab v -> SymTab v
lookupST :: String -> SymTab v -> Maybe v
definedST :: String -> SymTab v -> Bool
flattenST :: SymTab v -> [v]
emptyST :: SymTab v
emptyST = Int -> [(String, v)] -> SymTab v
forall a. Int -> a -> IndTree a
itgen Int
maxHash []
insertST :: (String, v) -> SymTab v -> SymTab v
insertST (String
s,v
v) SymTab v
ss = Int
-> ([(String, v)] -> [(String, v)])
-> SymTab v
-> (SymTab v -> SymTab v)
-> SymTab v
forall a b. Int -> (a -> a) -> IndTree a -> (IndTree a -> b) -> b
itiap (String -> Int
forall a. Hashable a => a -> Int
hash String
s) ((String
s,v
v)(String, v) -> [(String, v)] -> [(String, v)]
forall a. a -> [a] -> [a]
:) SymTab v
ss SymTab v -> SymTab v
forall a. a -> a
id
deleteST :: String -> SymTab v -> SymTab v
deleteST String
s SymTab v
ss = Int
-> ([(String, v)] -> [(String, v)])
-> SymTab v
-> (SymTab v -> SymTab v)
-> SymTab v
forall a b. Int -> (a -> a) -> IndTree a -> (IndTree a -> b) -> b
itiap (String -> Int
forall a. Hashable a => a -> Int
hash String
s) (((String, v) -> Bool) -> [(String, v)] -> [(String, v)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/=String
s)(String -> Bool) -> ((String, v) -> String) -> (String, v) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(String, v) -> String
forall a b. (a, b) -> a
fst)) SymTab v
ss SymTab v -> SymTab v
forall a. a -> a
id
lookupST :: String -> SymTab v -> Maybe v
lookupST String
s SymTab v
ss = let vs :: [(String, v)]
vs = ((String, v) -> Bool) -> [(String, v)] -> [(String, v)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
s)(String -> Bool) -> ((String, v) -> String) -> (String, v) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(String, v) -> String
forall a b. (a, b) -> a
fst) ((Int -> SymTab v -> [(String, v)]
forall a. Int -> IndTree a -> a
itind (String -> Int
forall a. Hashable a => a -> Int
hash String
s)) SymTab v
ss)
in if [(String, v)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(String, v)]
vs then Maybe v
forall a. Maybe a
Nothing
else (v -> Maybe v
forall a. a -> Maybe a
Just (v -> Maybe v) -> ([(String, v)] -> v) -> [(String, v)] -> Maybe v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, v) -> v
forall a b. (a, b) -> b
snd ((String, v) -> v)
-> ([(String, v)] -> (String, v)) -> [(String, v)] -> v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, v)] -> (String, v)
forall a. [a] -> a
head) [(String, v)]
vs
definedST :: String -> SymTab v -> Bool
definedST String
s SymTab v
ss = let vs :: [(String, v)]
vs = ((String, v) -> Bool) -> [(String, v)] -> [(String, v)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
s)(String -> Bool) -> ((String, v) -> String) -> (String, v) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(String, v) -> String
forall a b. (a, b) -> a
fst) ((Int -> SymTab v -> [(String, v)]
forall a. Int -> IndTree a -> a
itind (String -> Int
forall a. Hashable a => a -> Int
hash String
s)) SymTab v
ss)
in (Bool -> Bool
not (Bool -> Bool) -> ([(String, v)] -> Bool) -> [(String, v)] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, v)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [(String, v)]
vs
flattenST :: SymTab v -> [v]
flattenST SymTab v
ss = ([(String, v)] -> [v]) -> ([v] -> [v] -> [v]) -> SymTab v -> [v]
forall a b. (a -> b) -> (b -> b -> b) -> IndTree a -> b
itfold (((String, v) -> v) -> [(String, v)] -> [v]
forall a b. (a -> b) -> [a] -> [b]
map (String, v) -> v
forall a b. (a, b) -> b
snd) [v] -> [v] -> [v]
forall a. [a] -> [a] -> [a]
(++) SymTab v
ss
data IndTree t = Leaf t | Fork Int (IndTree t) (IndTree t)
deriving Int -> IndTree t -> ShowS
[IndTree t] -> ShowS
IndTree t -> String
(Int -> IndTree t -> ShowS)
-> (IndTree t -> String)
-> ([IndTree t] -> ShowS)
-> Show (IndTree t)
forall t. Show t => Int -> IndTree t -> ShowS
forall t. Show t => [IndTree t] -> ShowS
forall t. Show t => IndTree t -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IndTree t] -> ShowS
$cshowList :: forall t. Show t => [IndTree t] -> ShowS
show :: IndTree t -> String
$cshow :: forall t. Show t => IndTree t -> String
showsPrec :: Int -> IndTree t -> ShowS
$cshowsPrec :: forall t. Show t => Int -> IndTree t -> ShowS
Show
itgen :: Int -> a -> IndTree a
itgen :: Int -> a -> IndTree a
itgen Int
1 a
x = a -> IndTree a
forall t. t -> IndTree t
Leaf a
x
itgen Int
n a
x =
let n' :: Int
n' = Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
in Int -> IndTree a -> IndTree a -> IndTree a
forall t. Int -> IndTree t -> IndTree t -> IndTree t
Fork Int
n' (Int -> a -> IndTree a
forall a. Int -> a -> IndTree a
itgen Int
n' a
x) (Int -> a -> IndTree a
forall a. Int -> a -> IndTree a
itgen (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
n') a
x)
itiap ::
Int -> (a->a) -> IndTree a -> (IndTree a -> b) -> b
itiap :: Int -> (a -> a) -> IndTree a -> (IndTree a -> b) -> b
itiap Int
_ a -> a
f (Leaf a
x) IndTree a -> b
k = let fx :: a
fx = a -> a
f a
x in (IndTree a -> b
k (a -> IndTree a
forall t. t -> IndTree t
Leaf a
fx))
itiap Int
i a -> a
f (Fork Int
n IndTree a
lt IndTree a
rt) IndTree a -> b
k =
if Int
iInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
n then
Int -> (a -> a) -> IndTree a -> (IndTree a -> b) -> b
forall a b. Int -> (a -> a) -> IndTree a -> (IndTree a -> b) -> b
itiap Int
i a -> a
f IndTree a
lt ((IndTree a -> b) -> b) -> (IndTree a -> b) -> b
forall a b. (a -> b) -> a -> b
$ \IndTree a
lt' -> IndTree a -> b
k (Int -> IndTree a -> IndTree a -> IndTree a
forall t. Int -> IndTree t -> IndTree t -> IndTree t
Fork Int
n IndTree a
lt' IndTree a
rt)
else Int -> (a -> a) -> IndTree a -> (IndTree a -> b) -> b
forall a b. Int -> (a -> a) -> IndTree a -> (IndTree a -> b) -> b
itiap (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
n) a -> a
f IndTree a
rt ((IndTree a -> b) -> b) -> (IndTree a -> b) -> b
forall a b. (a -> b) -> a -> b
$ \IndTree a
rt' -> IndTree a -> b
k (Int -> IndTree a -> IndTree a -> IndTree a
forall t. Int -> IndTree t -> IndTree t -> IndTree t
Fork Int
n IndTree a
lt IndTree a
rt')
itind :: Int -> IndTree a -> a
itind :: Int -> IndTree a -> a
itind Int
_ (Leaf a
x) = a
x
itind Int
i (Fork Int
n IndTree a
lt IndTree a
rt) = if Int
iInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
n then Int -> IndTree a -> a
forall a. Int -> IndTree a -> a
itind Int
i IndTree a
lt else Int -> IndTree a -> a
forall a. Int -> IndTree a -> a
itind (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
n) IndTree a
rt
itfold :: (a->b) -> (b->b->b) -> IndTree a -> b
itfold :: (a -> b) -> (b -> b -> b) -> IndTree a -> b
itfold a -> b
leaf b -> b -> b
_fork (Leaf a
x) = a -> b
leaf a
x
itfold a -> b
leaf b -> b -> b
fork (Fork Int
_ IndTree a
l IndTree a
r) = b -> b -> b
fork ((a -> b) -> (b -> b -> b) -> IndTree a -> b
forall a b. (a -> b) -> (b -> b -> b) -> IndTree a -> b
itfold a -> b
leaf b -> b -> b
fork IndTree a
l) ((a -> b) -> (b -> b -> b) -> IndTree a -> b
forall a b. (a -> b) -> (b -> b -> b) -> IndTree a -> b
itfold a -> b
leaf b -> b -> b
fork IndTree a
r)
maxHash :: Int
maxHash :: Int
maxHash = Int
101
class Hashable a where
hashWithMax :: Int -> a -> Int
hash :: a -> Int
hash = Int -> a -> Int
forall a. Hashable a => Int -> a -> Int
hashWithMax Int
maxHash
instance Enum a => Hashable [a] where
hashWithMax :: Int -> [a] -> Int
hashWithMax Int
m = Int -> [a] -> Int
forall a. Enum a => Int -> [a] -> Int
h Int
0
where h :: Int -> [a] -> Int
h Int
a [] = Int
a
h Int
a (a
c:[a]
cs) = Int -> [a] -> Int
h ((Int
17Int -> Int -> Int
forall a. Num a => a -> a -> a
*(a -> Int
forall a. Enum a => a -> Int
fromEnum a
c)Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
19Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
a)Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem`Int
m) [a]
cs