module Language.C.Data.Position (
Position(Position),
posFile,posRow,posColumn,isSourcePos,
nopos, isNoPos,
builtinPos, isBuiltinPos,
internalPos, isInternalPos,
incPos, tabPos, retPos,
Pos(..),
) where
import Data.Generics
data Position = Position String
!Int
!Int
deriving (Eq, Ord, Typeable, Data)
instance Show Position where
show pos@(Position fname row col)
| isNoPos pos = "<no file>"
| isBuiltinPos pos = "<builtin>"
| isInternalPos pos = "<internal>"
| otherwise = show (fname, row, col)
instance Read Position where
readsPrec p s = case s of
'<' : _ -> readInternal s
_ -> map (\((file,row,pos),r) -> (Position file row pos,r)) . readsPrec p $ s
readInternal :: ReadS Position
readInternal s | (Just rest) <- readString "<no file>" s = [(nopos,rest)]
| (Just rest) <- readString "<builtin>" s = [(builtinPos,rest)]
| (Just rest) <- readString "<internal>" s = [(internalPos,rest)]
| otherwise = []
where readString [] r = return r
readString (c:cs) (c':cs') | c == c' = readString cs cs'
| otherwise = Nothing
readString (_:_) [] = Nothing
posFile :: Position -> String
posFile (Position fname _ _) = fname
posRow :: Position -> Int
posRow (Position _ row _) = row
posColumn :: Position -> Int
posColumn (Position _ _ col) = col
class Pos a where
posOf :: a -> Position
isSourcePos :: Position -> Bool
isSourcePos (Position _ row col) = row >= 0 && col >= 0
nopos :: Position
nopos = Position "<no file>" (1) 0
isNoPos :: Position -> Bool
isNoPos (Position _ (1) 0) = True
isNoPos _ = False
builtinPos :: Position
builtinPos = Position "<built into the parser>" (1) 1
isBuiltinPos :: Position -> Bool
isBuiltinPos (Position _ (1) 1) = True
isBuiltinPos _ = False
internalPos :: Position
internalPos = Position "<internal error>" (1) 2
isInternalPos :: Position -> Bool
isInternalPos (Position _ (1) 2) = True
isInternalPos _ = False
incPos :: Position -> Int -> Position
incPos (Position fname row col) n = Position fname row (col + n)
tabPos :: Position -> Position
tabPos (Position fname row col) =
Position fname row (col + 8 (col 1) `mod` 8)
retPos :: Position -> Position
retPos (Position fname row _col) = Position fname (row + 1) 1