{-# LANGUAGE DeriveDataTypeable #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Language.C.Data.Ident
-- Copyright   :  (c) [1995..1999] Manuel M. T. Chakravarty
--                (c) 2008 Benedikt Huber
-- License     :  BSD-style
-- Maintainer  :  benedikt.huber@gmail.com
-- Stability   :  experimental
-- Portability :  ghc
--
-- This module provides the notion of identifiers in C, speed up using hashing.
-- Identifiers are associated optionally associated with a 'NodeInfo', i.e. with
-- a unique 'Name' and a source location ('Position'). The ordering relation on
-- identifiers is based on the hash and does not follow the lexical order.
-----------------------------------------------------------------------------
module Language.C.Data.Ident (
    Ident(..),
    SUERef(..), isAnonymousRef,
    mkIdent, builtinIdent, internalIdent, internalIdentAt, isInternalIdent,
    identToString, sueRefToString, dumpIdent)
where

-- TODO (comment from manuel):
--  * Hashing is not 8bit clean.

import Data.Char
import Language.C.Data.Position
import Language.C.Data.Node
import Language.C.Data.Name (Name)
import Data.Data (Data)
import Data.Typeable (Typeable)
import GHC.Generics (Generic)
import Control.DeepSeq (NFData)

-- | References uniquely determining a struct, union or enum type.
-- Those are either identified by an string identifier, or by a unique
-- name (anonymous types).
data SUERef =  AnonymousRef Name
             | NamedRef Ident
    deriving (Typeable, Typeable SUERef
SUERef -> DataType
SUERef -> Constr
(forall b. Data b => b -> b) -> SUERef -> SUERef
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> SUERef -> u
forall u. (forall d. Data d => d -> u) -> SUERef -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SUERef -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SUERef -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SUERef -> m SUERef
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SUERef -> m SUERef
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SUERef
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SUERef -> c SUERef
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SUERef)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SUERef)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SUERef -> m SUERef
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SUERef -> m SUERef
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SUERef -> m SUERef
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SUERef -> m SUERef
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SUERef -> m SUERef
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SUERef -> m SUERef
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SUERef -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SUERef -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> SUERef -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SUERef -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SUERef -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SUERef -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SUERef -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SUERef -> r
gmapT :: (forall b. Data b => b -> b) -> SUERef -> SUERef
$cgmapT :: (forall b. Data b => b -> b) -> SUERef -> SUERef
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SUERef)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SUERef)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SUERef)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SUERef)
dataTypeOf :: SUERef -> DataType
$cdataTypeOf :: SUERef -> DataType
toConstr :: SUERef -> Constr
$ctoConstr :: SUERef -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SUERef
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SUERef
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SUERef -> c SUERef
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SUERef -> c SUERef
Data, Eq SUERef
SUERef -> SUERef -> Bool
SUERef -> SUERef -> Ordering
SUERef -> SUERef -> SUERef
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SUERef -> SUERef -> SUERef
$cmin :: SUERef -> SUERef -> SUERef
max :: SUERef -> SUERef -> SUERef
$cmax :: SUERef -> SUERef -> SUERef
>= :: SUERef -> SUERef -> Bool
$c>= :: SUERef -> SUERef -> Bool
> :: SUERef -> SUERef -> Bool
$c> :: SUERef -> SUERef -> Bool
<= :: SUERef -> SUERef -> Bool
$c<= :: SUERef -> SUERef -> Bool
< :: SUERef -> SUERef -> Bool
$c< :: SUERef -> SUERef -> Bool
compare :: SUERef -> SUERef -> Ordering
$ccompare :: SUERef -> SUERef -> Ordering
Ord, SUERef -> SUERef -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SUERef -> SUERef -> Bool
$c/= :: SUERef -> SUERef -> Bool
== :: SUERef -> SUERef -> Bool
$c== :: SUERef -> SUERef -> Bool
Eq, Int -> SUERef -> ShowS
[SUERef] -> ShowS
SUERef -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SUERef] -> ShowS
$cshowList :: [SUERef] -> ShowS
show :: SUERef -> String
$cshow :: SUERef -> String
showsPrec :: Int -> SUERef -> ShowS
$cshowsPrec :: Int -> SUERef -> ShowS
Show, forall x. Rep SUERef x -> SUERef
forall x. SUERef -> Rep SUERef x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SUERef x -> SUERef
$cfrom :: forall x. SUERef -> Rep SUERef x
Generic) --, Read

instance NFData SUERef

-- | Return true if the struct\/union\/enum reference is anonymous.
isAnonymousRef :: SUERef -> Bool
isAnonymousRef :: SUERef -> Bool
isAnonymousRef (AnonymousRef Name
_) = Bool
True
isAnonymousRef SUERef
_ = Bool
False

-- | C identifiers
data Ident = Ident String       -- lexeme
                   {-# UNPACK #-}   !Int     -- hash to speed up equality check
                   NodeInfo                   -- attributes of this ident. incl. position
             deriving (Typeable Ident
Ident -> DataType
Ident -> Constr
(forall b. Data b => b -> b) -> Ident -> Ident
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Ident -> u
forall u. (forall d. Data d => d -> u) -> Ident -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Ident -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Ident -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Ident -> m Ident
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Ident -> m Ident
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Ident
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Ident -> c Ident
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Ident)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Ident)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Ident -> m Ident
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Ident -> m Ident
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Ident -> m Ident
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Ident -> m Ident
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Ident -> m Ident
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Ident -> m Ident
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Ident -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Ident -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Ident -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Ident -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Ident -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Ident -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Ident -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Ident -> r
gmapT :: (forall b. Data b => b -> b) -> Ident -> Ident
$cgmapT :: (forall b. Data b => b -> b) -> Ident -> Ident
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Ident)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Ident)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Ident)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Ident)
dataTypeOf :: Ident -> DataType
$cdataTypeOf :: Ident -> DataType
toConstr :: Ident -> Constr
$ctoConstr :: Ident -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Ident
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Ident
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Ident -> c Ident
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Ident -> c Ident
Data,Typeable,Int -> Ident -> ShowS
[Ident] -> ShowS
Ident -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ident] -> ShowS
$cshowList :: [Ident] -> ShowS
show :: Ident -> String
$cshow :: Ident -> String
showsPrec :: Int -> Ident -> ShowS
$cshowsPrec :: Int -> Ident -> ShowS
Show, forall x. Rep Ident x -> Ident
forall x. Ident -> Rep Ident x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Ident x -> Ident
$cfrom :: forall x. Ident -> Rep Ident x
Generic) -- Read

instance NFData Ident

-- the definition of the equality allows identifiers to be equal that are
-- defined at different source text positions, and aims at speeding up the
-- equality test, by comparing the lexemes only if the two numbers are equal
--
instance Eq Ident where
  (Ident String
s Int
h NodeInfo
_) == :: Ident -> Ident -> Bool
== (Ident String
s' Int
h' NodeInfo
_) = (Int
h forall a. Eq a => a -> a -> Bool
== Int
h') Bool -> Bool -> Bool
&& (String
s forall a. Eq a => a -> a -> Bool
== String
s')

-- this does *not* follow the alphanumerical ordering of the lexemes
--
instance Ord Ident where
  compare :: Ident -> Ident -> Ordering
compare (Ident String
s Int
h NodeInfo
_) (Ident String
s' Int
h' NodeInfo
_) = forall a. Ord a => a -> a -> Ordering
compare (Int
h, String
s) (Int
h', String
s')

-- identifiers are attributed
instance CNode Ident where
  nodeInfo :: Ident -> NodeInfo
nodeInfo (Ident String
_ Int
_ NodeInfo
at) = NodeInfo
at
instance Pos Ident where
  posOf :: Ident -> Position
posOf = NodeInfo -> Position
posOfNode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CNode a => a -> NodeInfo
nodeInfo
-- to speed up the equality test we compute some hash-like value for each
-- identifiers lexeme and store it in the identifiers representation

-- hash function from the dragon book pp437; assumes 7 bit characters and needs
-- the (nearly) full range of values guaranteed for `Int' by the Haskell
-- language definition; can handle 8 bit characters provided we have 29 bit
-- for the `Int's without sign
--
quad                 :: String -> Int
quad :: String -> Int
quad (Char
c1:Char
c2:Char
c3:Char
c4:String
s)  = ((Char -> Int
ord Char
c4 forall a. Num a => a -> a -> a
* Int
bits21
                          forall a. Num a => a -> a -> a
+ Char -> Int
ord Char
c3 forall a. Num a => a -> a -> a
* Int
bits14
                          forall a. Num a => a -> a -> a
+ Char -> Int
ord Char
c2 forall a. Num a => a -> a -> a
* Int
bits7
                          forall a. Num a => a -> a -> a
+ Char -> Int
ord Char
c1)
                         forall a. Integral a => a -> a -> a
`mod` Int
bits28)
                        forall a. Num a => a -> a -> a
+ (String -> Int
quad String
s forall a. Integral a => a -> a -> a
`mod` Int
bits28)
quad (Char
c1:Char
c2:Char
c3:[]  )  = Char -> Int
ord Char
c3 forall a. Num a => a -> a -> a
* Int
bits14 forall a. Num a => a -> a -> a
+ Char -> Int
ord Char
c2 forall a. Num a => a -> a -> a
* Int
bits7 forall a. Num a => a -> a -> a
+ Char -> Int
ord Char
c1
quad (Char
c1:Char
c2:[]     )  = Char -> Int
ord Char
c2 forall a. Num a => a -> a -> a
* Int
bits7 forall a. Num a => a -> a -> a
+ Char -> Int
ord Char
c1
quad (Char
c1:[]        )  = Char -> Int
ord Char
c1
quad ([]           )  = Int
0

bits7 :: Int
bits7 :: Int
bits7  = Int
2forall a b. (Num a, Integral b) => a -> b -> a
^(Int
7::Int)
bits14 :: Int
bits14 :: Int
bits14 = Int
2forall a b. (Num a, Integral b) => a -> b -> a
^(Int
14::Int)
bits21 :: Int
bits21 :: Int
bits21 = Int
2forall a b. (Num a, Integral b) => a -> b -> a
^(Int
21::Int)
bits28 :: Int
bits28 :: Int
bits28 = Int
2forall a b. (Num a, Integral b) => a -> b -> a
^(Int
28::Int)

-- | build an identifier from a string.
--
-- * only minimal error checking, e.g., the characters of the identifier are
--   not checked for being alphanumerical only; the correct lexis of the
--   identifier should be ensured by the caller, e.g., the scanner.
--
-- * for reasons of simplicity the complete lexeme is hashed.
mkIdent            :: Position -> String -> Name -> Ident
mkIdent :: Position -> String -> Name -> Ident
mkIdent Position
pos String
s Name
name  = String -> Int -> NodeInfo -> Ident
Ident String
s (String -> Int
quad String
s) (Position -> PosLength -> Name -> NodeInfo
mkNodeInfo' Position
pos (Position
pos,forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s) Name
name)

-- | returns an /internal/ identifier (has internal position and no unique name)
internalIdent   :: String -> Ident
internalIdent :: String -> Ident
internalIdent String
s  = String -> Int -> NodeInfo -> Ident
Ident String
s (String -> Int
quad String
s) (Position -> NodeInfo
mkNodeInfoOnlyPos Position
internalPos)

-- | return an /internal/ identifier with position info
internalIdentAt :: Position -> String -> Ident
internalIdentAt :: Position -> String -> Ident
internalIdentAt Position
pos String
s = String -> Int -> NodeInfo -> Ident
Ident String
s (String -> Int
quad String
s) (Position -> PosLength -> NodeInfo
mkNodeInfoPosLen Position
pos (Position
pos, forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s))

-- | returns a /builtin/ identifier (has builtin position and no unique name)
builtinIdent   :: String -> Ident
builtinIdent :: String -> Ident
builtinIdent String
s  = String -> Int -> NodeInfo -> Ident
Ident String
s (String -> Int
quad String
s) (Position -> NodeInfo
mkNodeInfoOnlyPos Position
builtinPos)

-- | return @True@ if the given identifier is /internal/
isInternalIdent :: Ident -> Bool
isInternalIdent :: Ident -> Bool
isInternalIdent (Ident String
_ Int
_ NodeInfo
nodeinfo) = Position -> Bool
isInternalPos (NodeInfo -> Position
posOfNode NodeInfo
nodeinfo)

-- | string of an identifier
identToString               :: Ident -> String
identToString :: Ident -> String
identToString (Ident String
s Int
_ NodeInfo
_)  = String
s

-- | string of a SUE ref (empty if anonymous)
sueRefToString                 :: SUERef -> String
sueRefToString :: SUERef -> String
sueRefToString (AnonymousRef Name
_) = String
""
sueRefToString (NamedRef Ident
ident) = Ident -> String
identToString Ident
ident

-- | dump the identifier string and its positions for debugging purposes
dumpIdent     :: Ident -> String
dumpIdent :: Ident -> String
dumpIdent Ident
ide  = Ident -> String
identToString Ident
ide forall a. [a] -> [a] -> [a]
++ String
" at " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a. CNode a => a -> NodeInfo
nodeInfo Ident
ide)