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
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
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
Ord)
instance Show Position where
show :: Position -> String
show (Position String
fname Int
row Int
col) = forall a. Show a => a -> String
show (String
fname, Int
row, Int
col)
nopos :: Position
nopos :: Position
nopos = String -> Int -> Int -> Position
Position String
"<no file>" (-Int
1) (-Int
1)
isNopos :: Position -> Bool
isNopos :: Position -> Bool
isNopos (Position String
_ (-1) (-1)) = Bool
True
isNopos Position
_ = Bool
False
dontCarePos :: Position
dontCarePos :: Position
dontCarePos = String -> Int -> Int -> Position
Position String
"<invalid>" (-Int
2) (-Int
2)
isDontCarePos :: Position -> Bool
isDontCarePos :: Position -> Bool
isDontCarePos (Position String
_ (-2) (-2)) = Bool
True
isDontCarePos Position
_ = Bool
False
builtinPos :: Position
builtinPos :: Position
builtinPos = String -> Int -> Int -> Position
Position String
"<built into the compiler>" (-Int
3) (-Int
3)
isBuiltinPos :: Position -> Bool
isBuiltinPos :: Position -> Bool
isBuiltinPos (Position String
_ (-3) (-3)) = Bool
True
isBuiltinPos Position
_ = Bool
False
internalPos :: Position
internalPos :: Position
internalPos = String -> Int -> Int -> Position
Position String
"<internal error>" (-Int
4) (-Int
4)
isInternalPos :: Position -> Bool
isInternalPos :: Position -> Bool
isInternalPos (Position String
_ (-4) (-4)) = Bool
True
isInternalPos Position
_ = Bool
False
class Pos a where
posOf :: a -> Position
incPos :: Position -> Int -> Position
incPos :: Position -> Int -> Position
incPos (Position String
fname Int
row Int
col) Int
n = String -> Int -> Int -> Position
Position String
fname Int
row (Int
col forall a. Num a => a -> a -> a
+ Int
n)
tabPos :: Position -> Position
tabPos :: Position -> Position
tabPos (Position String
fname Int
row Int
col) =
String -> Int -> Int -> Position
Position String
fname Int
row (Int
col forall a. Num a => a -> a -> a
+ Int
8 forall a. Num a => a -> a -> a
- (Int
col forall a. Num a => a -> a -> a
- Int
1) forall a. Integral a => a -> a -> a
`mod` Int
8)
retPos :: Position -> Position
retPos :: Position -> Position
retPos (Position String
fname Int
row Int
col) = String -> Int -> Int -> Position
Position String
fname (Int
row forall a. Num a => a -> a -> a
+ Int
1) Int
1
instance Binary Position where
put_ :: BinHandle -> Position -> IO ()
put_ BinHandle
bh (Position String
fname Int
row Int
col) = do
BinHandle -> String -> IO ()
putSharedString BinHandle
bh String
fname
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Int
row
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Int
col
get :: BinHandle -> IO Position
get BinHandle
bh = do
String
fname <- BinHandle -> IO String
getSharedString BinHandle
bh
Int
row <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Int
col <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Int -> Int -> Position
Position String
fname Int
row Int
col)