{-# LANGUAGE DeriveDataTypeable #-}
module Language.C.Data.Position (
Position(),
position,
PosLength,
posFile,posRow,posColumn,posOffset,posParent,
initPos, isSourcePos,
nopos, isNoPos,
builtinPos, isBuiltinPos,
internalPos, isInternalPos,
incPos, retPos,
incOffset,
Pos(..),
) where
import Data.Generics hiding (Generic)
import GHC.Generics (Generic)
import Control.DeepSeq (NFData)
data FilePosition = FilePosition { posSrcFile :: String,
posParentFile :: (Maybe Position)
}
deriving (Eq, Ord, Typeable, Data, Generic)
instance NFData FilePosition
data Position = Position { posOffset :: {-# UNPACK #-} !Int
, posRow :: {-# UNPACK #-} !Int
, posColumn :: {-# UNPACK #-} !Int
, posFileInfo :: FilePosition
}
| NoPosition
| BuiltinPosition
| InternalPosition
deriving (Eq, Ord, Typeable, Data, Generic)
instance NFData Position
posFile :: Position -> String
posFile = posSrcFile . posFileInfo
posParent :: Position -> (Maybe Position)
posParent = posParentFile . posFileInfo
type PosLength = (Position,Int)
instance Show Position where
showsPrec _ (Position _ row _ (FilePosition fname mparent)) =
showString "(" . showsPrec 0 fname . showString ": line " . showsPrec 0 row .
maybe id (\p -> showString ", in file included from " . showsPrec 0 p) mparent .
showString ")"
showsPrec _ NoPosition = showString "<no file>"
showsPrec _ BuiltinPosition = showString "<builtin>"
showsPrec _ InternalPosition = showString "<internal>"
position :: Int -> String -> Int -> Int -> Maybe Position -> Position
position offset fname row col mparent = Position offset row col (FilePosition fname mparent)
class Pos a where
posOf :: a -> Position
initPos :: FilePath -> Position
initPos file = Position 0 1 1 (FilePosition file Nothing)
isSourcePos :: Position -> Bool
isSourcePos (Position _ _ _ _) = True
isSourcePos _ = False
nopos :: Position
nopos = NoPosition
isNoPos :: Position -> Bool
isNoPos NoPosition = True
isNoPos _ = False
builtinPos :: Position
builtinPos = BuiltinPosition
isBuiltinPos :: Position -> Bool
isBuiltinPos BuiltinPosition = True
isBuiltinPos _ = False
internalPos :: Position
internalPos = InternalPosition
isInternalPos :: Position -> Bool
isInternalPos InternalPosition = True
isInternalPos _ = False
{-# INLINE incPos #-}
incPos :: Position -> Int -> Position
incPos (Position offs row col fpos) n = Position (offs + n) row (col + n) fpos
incPos p _ = p
{-# INLINE retPos #-}
retPos :: Position -> Position
retPos (Position offs row _ fpos) = Position (offs+1) (row + 1) 1 fpos
retPos p = p
{-# INLINE incOffset #-}
incOffset :: Position -> Int -> Position
incOffset (Position o r c f) n = Position (o + n) r c f
incOffset pos _ = pos