{-# LANGUAGE DeriveDataTypeable #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Language.C.Syntax.Attributes
-- Copyright   :  (c) [1995..1999] Manuel M. T. Chakravarty
--                (c) 2008 Benedikt Huber (stripped radically)
-- License     :  BSD-style
-- Maintainer  :  benedikt.huber@gmail.com
-- Stability   :  experimental
-- Portability :  ghc
--
-- source position and unqiue name
-----------------------------------------------------------------------------
module Language.C.Data.Node (
   NodeInfo(..), undefNode, isUndefNode,
   mkNodeInfoOnlyPos,mkNodeInfoPosLen, mkNodeInfo,mkNodeInfo',
   internalNode, -- deprecated, use undefNode
   CNode(nodeInfo), fileOfNode,
   posOfNode, nameOfNode, getLastTokenPos, lengthOfNode,
   eqByName,
) where
import Language.C.Data.Position
import Language.C.Data.Name     (Name)
import Data.Data (Data)
import Data.Typeable (Typeable)
import GHC.Generics (Generic)
import Control.DeepSeq (NFData)

-- | Parsed entity attribute
data NodeInfo = OnlyPos  Position {-# UNPACK #-} !PosLength        -- only pos and last token (for internal stuff only)
              | NodeInfo Position {-# UNPACK #-} !PosLength !Name  -- pos, last token and unique name
           deriving (Typeable NodeInfo
Typeable NodeInfo =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> NodeInfo -> c NodeInfo)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c NodeInfo)
-> (NodeInfo -> Constr)
-> (NodeInfo -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c NodeInfo))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c NodeInfo))
-> ((forall b. Data b => b -> b) -> NodeInfo -> NodeInfo)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> NodeInfo -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> NodeInfo -> r)
-> (forall u. (forall d. Data d => d -> u) -> NodeInfo -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> NodeInfo -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> NodeInfo -> m NodeInfo)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> NodeInfo -> m NodeInfo)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> NodeInfo -> m NodeInfo)
-> Data NodeInfo
NodeInfo -> Constr
NodeInfo -> DataType
(forall b. Data b => b -> b) -> NodeInfo -> NodeInfo
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) -> NodeInfo -> u
forall u. (forall d. Data d => d -> u) -> NodeInfo -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> NodeInfo -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> NodeInfo -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> NodeInfo -> m NodeInfo
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NodeInfo -> m NodeInfo
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NodeInfo
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NodeInfo -> c NodeInfo
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c NodeInfo)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c NodeInfo)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NodeInfo -> c NodeInfo
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NodeInfo -> c NodeInfo
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NodeInfo
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NodeInfo
$ctoConstr :: NodeInfo -> Constr
toConstr :: NodeInfo -> Constr
$cdataTypeOf :: NodeInfo -> DataType
dataTypeOf :: NodeInfo -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c NodeInfo)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c NodeInfo)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c NodeInfo)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c NodeInfo)
$cgmapT :: (forall b. Data b => b -> b) -> NodeInfo -> NodeInfo
gmapT :: (forall b. Data b => b -> b) -> NodeInfo -> NodeInfo
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> NodeInfo -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> NodeInfo -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> NodeInfo -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> NodeInfo -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> NodeInfo -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> NodeInfo -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> NodeInfo -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> NodeInfo -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> NodeInfo -> m NodeInfo
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> NodeInfo -> m NodeInfo
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NodeInfo -> m NodeInfo
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NodeInfo -> m NodeInfo
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NodeInfo -> m NodeInfo
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NodeInfo -> m NodeInfo
Data,Typeable,NodeInfo -> NodeInfo -> Bool
(NodeInfo -> NodeInfo -> Bool)
-> (NodeInfo -> NodeInfo -> Bool) -> Eq NodeInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NodeInfo -> NodeInfo -> Bool
== :: NodeInfo -> NodeInfo -> Bool
$c/= :: NodeInfo -> NodeInfo -> Bool
/= :: NodeInfo -> NodeInfo -> Bool
Eq,Eq NodeInfo
Eq NodeInfo =>
(NodeInfo -> NodeInfo -> Ordering)
-> (NodeInfo -> NodeInfo -> Bool)
-> (NodeInfo -> NodeInfo -> Bool)
-> (NodeInfo -> NodeInfo -> Bool)
-> (NodeInfo -> NodeInfo -> Bool)
-> (NodeInfo -> NodeInfo -> NodeInfo)
-> (NodeInfo -> NodeInfo -> NodeInfo)
-> Ord NodeInfo
NodeInfo -> NodeInfo -> Bool
NodeInfo -> NodeInfo -> Ordering
NodeInfo -> NodeInfo -> NodeInfo
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
$ccompare :: NodeInfo -> NodeInfo -> Ordering
compare :: NodeInfo -> NodeInfo -> Ordering
$c< :: NodeInfo -> NodeInfo -> Bool
< :: NodeInfo -> NodeInfo -> Bool
$c<= :: NodeInfo -> NodeInfo -> Bool
<= :: NodeInfo -> NodeInfo -> Bool
$c> :: NodeInfo -> NodeInfo -> Bool
> :: NodeInfo -> NodeInfo -> Bool
$c>= :: NodeInfo -> NodeInfo -> Bool
>= :: NodeInfo -> NodeInfo -> Bool
$cmax :: NodeInfo -> NodeInfo -> NodeInfo
max :: NodeInfo -> NodeInfo -> NodeInfo
$cmin :: NodeInfo -> NodeInfo -> NodeInfo
min :: NodeInfo -> NodeInfo -> NodeInfo
Ord, (forall x. NodeInfo -> Rep NodeInfo x)
-> (forall x. Rep NodeInfo x -> NodeInfo) -> Generic NodeInfo
forall x. Rep NodeInfo x -> NodeInfo
forall x. NodeInfo -> Rep NodeInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NodeInfo -> Rep NodeInfo x
from :: forall x. NodeInfo -> Rep NodeInfo x
$cto :: forall x. Rep NodeInfo x -> NodeInfo
to :: forall x. Rep NodeInfo x -> NodeInfo
Generic)

instance NFData NodeInfo

instance Show NodeInfo where
    showsPrec :: Int -> NodeInfo -> ShowS
showsPrec Int
d (OnlyPos Position
p PosLength
l) =
      (String -> ShowS
showString String
"(OnlyPos ") ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Position -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d Position
p) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> ShowS
showString String
" ") ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> PosLength -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d PosLength
l) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> ShowS
showString String
")")
    showsPrec Int
d (NodeInfo Position
p PosLength
l Name
n) =
      (String -> ShowS
showString String
"(NodeInfo ") ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Position -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d Position
p) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> ShowS
showString String
" ") ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> PosLength -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d PosLength
l) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> ShowS
showString String
" ") ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Name -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d Name
n) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> ShowS
showString String
")")

-- name equality of attributes, used to define (name) equality of objects
--instance Eq NodeInfo where
--  (NodeInfo   _ _ id1) == (NodeInfo   _ _ id2) = id1 == id2
--  _               == _               =
--    error "Attributes: Attempt to compare `OnlyPos' attributes!"

-- attribute ordering
--instance Ord NodeInfo where
--  (NodeInfo   _ _ id1) <= (NodeInfo   _ _ id2) = id1 <= id2
--  _               <= _               =
--    error "Attributes: Attempt to compare `OnlyPos' attributes!"

instance Pos NodeInfo where
  posOf :: NodeInfo -> Position
posOf (OnlyPos Position
pos PosLength
_) = Position
pos
  posOf (NodeInfo Position
pos PosLength
_ Name
_) = Position
pos

-- | get the number of characters an AST node spans
lengthOfNode :: NodeInfo -> Maybe Int
lengthOfNode :: NodeInfo -> Maybe Int
lengthOfNode NodeInfo
ni = Maybe Int
len
    where
    len :: Maybe Int
len = case NodeInfo
ni of NodeInfo Position
firstPos PosLength
lastTok Name
_ -> Position -> PosLength -> Maybe Int
computeLength Position
firstPos PosLength
lastTok
                     OnlyPos Position
firstPos PosLength
lastTok -> Position -> PosLength -> Maybe Int
computeLength Position
firstPos PosLength
lastTok
    computeLength :: Position -> PosLength -> Maybe Int
computeLength Position
pos (Position
lastPos,Int
lastTokLen) | Int
lastTokLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0   = Maybe Int
forall a. Maybe a
Nothing
                                           | Bool
otherwise = Int -> Maybe Int
forall a. a -> Maybe a
Just (Position -> Int
posOffset Position
lastPos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lastTokLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Position -> Int
posOffset Position
pos)

-- | get the position and length of the last token
getLastTokenPos :: NodeInfo -> PosLength
getLastTokenPos :: NodeInfo -> PosLength
getLastTokenPos (NodeInfo Position
_ PosLength
lastTok Name
_) = PosLength
lastTok
getLastTokenPos (OnlyPos Position
_ PosLength
lastTok) = PosLength
lastTok

-- | a class for convenient access to the attributes of an attributed object
class CNode a where
  nodeInfo :: a -> NodeInfo
instance CNode NodeInfo where
  nodeInfo :: NodeInfo -> NodeInfo
nodeInfo = NodeInfo -> NodeInfo
forall a. a -> a
id
instance (CNode a, CNode b) => CNode (Either a b) where
  nodeInfo :: Either a b -> NodeInfo
nodeInfo = (a -> NodeInfo) -> (b -> NodeInfo) -> Either a b -> NodeInfo
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> NodeInfo
forall a. CNode a => a -> NodeInfo
nodeInfo b -> NodeInfo
forall a. CNode a => a -> NodeInfo
nodeInfo

nameOfNode :: NodeInfo -> Maybe Name
nameOfNode :: NodeInfo -> Maybe Name
nameOfNode (OnlyPos Position
_ PosLength
_) = Maybe Name
forall a. Maybe a
Nothing
nameOfNode (NodeInfo Position
_ PosLength
_ Name
name) = Name -> Maybe Name
forall a. a -> Maybe a
Just Name
name
posOfNode :: NodeInfo -> Position
posOfNode :: NodeInfo -> Position
posOfNode NodeInfo
ni = case NodeInfo
ni of (OnlyPos Position
pos PosLength
_) -> Position
pos; (NodeInfo Position
pos PosLength
_ Name
_) -> Position
pos
fileOfNode :: (CNode a) => a -> Maybe FilePath
fileOfNode :: forall a. CNode a => a -> Maybe String
fileOfNode = (Position -> String) -> Maybe Position -> Maybe String
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Position -> String
posFile (Maybe Position -> Maybe String)
-> (a -> Maybe Position) -> a -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Position -> Bool) -> Position -> Maybe Position
forall {a}. (a -> Bool) -> a -> Maybe a
justIf Position -> Bool
isSourcePos (Position -> Maybe Position)
-> (a -> Position) -> a -> Maybe Position
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeInfo -> Position
posOfNode (NodeInfo -> Position) -> (a -> NodeInfo) -> a -> Position
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> NodeInfo
forall a. CNode a => a -> NodeInfo
nodeInfo where
    justIf :: (a -> Bool) -> a -> Maybe a
justIf a -> Bool
predicate a
x | a -> Bool
predicate a
x = a -> Maybe a
forall a. a -> Maybe a
Just a
x
                       | Bool
otherwise   = Maybe a
forall a. Maybe a
Nothing

-- | equality by name
eqByName           :: CNode a => a -> a -> Bool
eqByName :: forall a. CNode a => a -> a -> Bool
eqByName a
obj1 a
obj2  = (a -> NodeInfo
forall a. CNode a => a -> NodeInfo
nodeInfo a
obj1) NodeInfo -> NodeInfo -> Bool
forall a. Eq a => a -> a -> Bool
== (a -> NodeInfo
forall a. CNode a => a -> NodeInfo
nodeInfo a
obj2)


-- attribute identifier creation
-- -----------------------------
{-# DEPRECATED internalNode "use undefNode instead" #-}
internalNode :: NodeInfo
internalNode :: NodeInfo
internalNode = NodeInfo
undefNode

-- | create a node with neither name nor positional information
undefNode :: NodeInfo
undefNode :: NodeInfo
undefNode = Position -> PosLength -> NodeInfo
OnlyPos Position
nopos (Position
nopos,-Int
1)

-- | return True if the node carries neither name nor positional information
isUndefNode :: NodeInfo -> Bool
isUndefNode :: NodeInfo -> Bool
isUndefNode (OnlyPos Position
p PosLength
_) | Position -> Bool
isNoPos Position
p = Bool
True
                          | Bool
otherwise = Bool
False
isUndefNode NodeInfo
_ = Bool
False

-- |
-- | Given only a source position, create a new node attribute
mkNodeInfoOnlyPos :: Position -> NodeInfo
mkNodeInfoOnlyPos :: Position -> NodeInfo
mkNodeInfoOnlyPos Position
pos  = Position -> PosLength -> NodeInfo
OnlyPos Position
pos (Position
nopos,-Int
1)

-- | Given a source position and the position and length of the last token, create a new node attribute
mkNodeInfoPosLen :: Position -> PosLength -> NodeInfo
mkNodeInfoPosLen :: Position -> PosLength -> NodeInfo
mkNodeInfoPosLen = Position -> PosLength -> NodeInfo
OnlyPos

-- | Given a source position and a unique name, create a new attribute
-- identifier
mkNodeInfo :: Position -> Name -> NodeInfo
mkNodeInfo :: Position -> Name -> NodeInfo
mkNodeInfo Position
pos Name
name  = Position -> PosLength -> Name -> NodeInfo
NodeInfo Position
pos (Position
nopos,-Int
1) Name
name

-- | Given a source position, the position and length of the last token and a unique name, create a new attribute
-- identifier. Strict in
mkNodeInfo' :: Position -> PosLength -> Name -> NodeInfo
mkNodeInfo' :: Position -> PosLength -> Name -> NodeInfo
mkNodeInfo' Position
pos PosLength
lasttok Name
name = Position -> PosLength -> Name -> NodeInfo
NodeInfo Position
pos PosLength
lasttok Name
name