module Position (
Position(Position), Pos (posOf),
nopos, isNopos,
dontCarePos, isDontCarePos,
builtinPos, isBuiltinPos,
internalPos, isInternalPos,
incPos, tabPos, retPos,
) where
import Binary (Binary(..), putSharedString, getSharedString)
data Position = Position String
{-# UNPACK #-} !Int
{-# UNPACK #-} !Int
deriving (Position -> Position -> Bool
(Position -> Position -> Bool)
-> (Position -> Position -> Bool) -> Eq Position
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Position -> Position -> Bool
$c/= :: Position -> Position -> Bool
== :: Position -> Position -> Bool
$c== :: Position -> Position -> Bool
Eq, Eq Position
Eq Position =>
(Position -> Position -> Ordering)
-> (Position -> Position -> Bool)
-> (Position -> Position -> Bool)
-> (Position -> Position -> Bool)
-> (Position -> Position -> Bool)
-> (Position -> Position -> Position)
-> (Position -> Position -> Position)
-> Ord Position
Position -> Position -> Bool
Position -> Position -> Ordering
Position -> Position -> Position
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 :: Position -> Position -> Position
$cmin :: Position -> Position -> Position
max :: Position -> Position -> Position
$cmax :: Position -> Position -> Position
>= :: Position -> Position -> Bool
$c>= :: Position -> Position -> Bool
> :: Position -> Position -> Bool
$c> :: Position -> Position -> Bool
<= :: Position -> Position -> Bool
$c<= :: Position -> Position -> Bool
< :: Position -> Position -> Bool
$c< :: Position -> Position -> Bool
compare :: Position -> Position -> Ordering
$ccompare :: Position -> Position -> Ordering
$cp1Ord :: Eq Position
Ord)
instance Show Position where
show :: Position -> String
show (Position fname :: String
fname row :: Int
row col :: Int
col) = (String, Int, Int) -> String
forall a. Show a => a -> String
show (String
fname, Int
row, Int
col)
nopos :: Position
nopos :: Position
nopos = String -> Int -> Int -> Position
Position "<no file>" (-1) (-1)
isNopos :: Position -> Bool
isNopos :: Position -> Bool
isNopos (Position _ (-1) (-1)) = Bool
True
isNopos _ = Bool
False
dontCarePos :: Position
dontCarePos :: Position
dontCarePos = String -> Int -> Int -> Position
Position "<invalid>" (-2) (-2)
isDontCarePos :: Position -> Bool
isDontCarePos :: Position -> Bool
isDontCarePos (Position _ (-2) (-2)) = Bool
True
isDontCarePos _ = Bool
False
builtinPos :: Position
builtinPos :: Position
builtinPos = String -> Int -> Int -> Position
Position "<built into the compiler>" (-3) (-3)
isBuiltinPos :: Position -> Bool
isBuiltinPos :: Position -> Bool
isBuiltinPos (Position _ (-3) (-3)) = Bool
True
isBuiltinPos _ = Bool
False
internalPos :: Position
internalPos :: Position
internalPos = String -> Int -> Int -> Position
Position "<internal error>" (-4) (-4)
isInternalPos :: Position -> Bool
isInternalPos :: Position -> Bool
isInternalPos (Position _ (-4) (-4)) = Bool
True
isInternalPos _ = Bool
False
class Pos a where
posOf :: a -> Position
incPos :: Position -> Int -> Position
incPos :: Position -> Int -> Position
incPos (Position fname :: String
fname row :: Int
row col :: Int
col) n :: Int
n = String -> Int -> Int -> Position
Position String
fname Int
row (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n)
tabPos :: Position -> Position
tabPos :: Position -> Position
tabPos (Position fname :: String
fname row :: Int
row col :: Int
col) =
String -> Int -> Int -> Position
Position String
fname Int
row (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 8 Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` 8)
retPos :: Position -> Position
retPos :: Position -> Position
retPos (Position fname :: String
fname row :: Int
row col :: Int
col) = String -> Int -> Int -> Position
Position String
fname (Int
row Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) 1
instance Binary Position where
put_ :: BinHandle -> Position -> IO ()
put_ bh :: BinHandle
bh (Position fname :: String
fname row :: Int
row col :: Int
col) = do
BinHandle -> String -> IO ()
putSharedString BinHandle
bh String
fname
BinHandle -> Int -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Int
row
BinHandle -> Int -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Int
col
get :: BinHandle -> IO Position
get bh :: BinHandle
bh = do
String
fname <- BinHandle -> IO String
getSharedString BinHandle
bh
Int
row <- BinHandle -> IO Int
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Int
col <- BinHandle -> IO Int
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Position -> IO Position
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Int -> Int -> Position
Position String
fname Int
row Int
col)