    -----------------------------------------------------------------------------
    -- |
    -- Module      :  SymTab
    -- Copyright   :  2000-2004 Malcolm Wallace
    -- Licence     :  LGPL
    --
    -- Maintainer  :  Malcolm Wallace <Malcolm.Wallace@cs.york.ac.uk>
    -- Stability   :  Stable
    -- Portability :  All
    --
    -- Symbol Table, based on index trees using a hash on the key.
    --   Keys are always Strings.  Stored values can be any type.
    -----------------------------------------------------------------------------

    module Language.Preprocessor.Cpphs.SymTab
      ( SymTab
      , emptyST
      , insertST
      , deleteST
      , lookupST
      , definedST
      , flattenST
      , IndTree
      ) where

    -- | Symbol Table.  Stored values are polymorphic, but the keys are
    --   always strings.
    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 :: forall v. SymTab v
    emptyST           = Int -> [(String, v)] -> IndTree [(String, v)]
    forall a. Int -> a -> IndTree a
    itgen Int
    maxHash []
    insertST :: forall v. (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 :: forall v. 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 :: forall v. 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 a. [a] -> 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. HasCallStack => [a] -> a
    head) [(String, v)]
    vs
    definedST :: forall v. 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 a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null) [(String, v)]
    vs
    flattenST :: forall v. 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

    ----
    -- | Index Trees (storing indexes at nodes).

    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
    $cshowsPrec :: forall t. Show t => Int -> IndTree t -> ShowS
    showsPrec :: Int -> IndTree t -> ShowS
    $cshow :: forall t. Show t => IndTree t -> String
    show :: IndTree t -> String
    $cshowList :: forall t. Show t => [IndTree t] -> ShowS
    showList :: [IndTree t] -> ShowS
    Show

    itgen :: Int -> a -> IndTree a
    itgen :: forall a. 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 :: --Eval a =>
             Int -> (a->a) -> IndTree a -> (IndTree a -> b) -> b
    itiap :: forall a b. 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 {-seq fx-} (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 :: forall a. 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 :: forall a b. (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)

    ----
    -- Hash values

    maxHash :: Int -- should be prime
    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

    ----