{-# LANGUAGE Safe #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE RecordWildCards #-}
module Cryptol.Parser.Position where
import Data.Text(Text)
import qualified Data.Text as T
import GHC.Generics (Generic)
import Control.DeepSeq
import Cryptol.Utils.PP
data Located a = Located { forall a. Located a -> Range
srcRange :: !Range, forall a. Located a -> a
thing :: !a }
deriving (Located a -> Located a -> Bool
forall a. Eq a => Located a -> Located a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Located a -> Located a -> Bool
$c/= :: forall a. Eq a => Located a -> Located a -> Bool
== :: Located a -> Located a -> Bool
$c== :: forall a. Eq a => Located a -> Located a -> Bool
Eq, Located a -> Located a -> Bool
Located a -> Located a -> Ordering
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
forall {a}. Ord a => Eq (Located a)
forall a. Ord a => Located a -> Located a -> Bool
forall a. Ord a => Located a -> Located a -> Ordering
forall a. Ord a => Located a -> Located a -> Located a
min :: Located a -> Located a -> Located a
$cmin :: forall a. Ord a => Located a -> Located a -> Located a
max :: Located a -> Located a -> Located a
$cmax :: forall a. Ord a => Located a -> Located a -> Located a
>= :: Located a -> Located a -> Bool
$c>= :: forall a. Ord a => Located a -> Located a -> Bool
> :: Located a -> Located a -> Bool
$c> :: forall a. Ord a => Located a -> Located a -> Bool
<= :: Located a -> Located a -> Bool
$c<= :: forall a. Ord a => Located a -> Located a -> Bool
< :: Located a -> Located a -> Bool
$c< :: forall a. Ord a => Located a -> Located a -> Bool
compare :: Located a -> Located a -> Ordering
$ccompare :: forall a. Ord a => Located a -> Located a -> Ordering
Ord, Int -> Located a -> ShowS
forall a. Show a => Int -> Located a -> ShowS
forall a. Show a => [Located a] -> ShowS
forall a. Show a => Located a -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Located a] -> ShowS
$cshowList :: forall a. Show a => [Located a] -> ShowS
show :: Located a -> FilePath
$cshow :: forall a. Show a => Located a -> FilePath
showsPrec :: Int -> Located a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Located a -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Located a) x -> Located a
forall a x. Located a -> Rep (Located a) x
$cto :: forall a x. Rep (Located a) x -> Located a
$cfrom :: forall a x. Located a -> Rep (Located a) x
Generic, forall a. NFData a => Located a -> ()
forall a. (a -> ()) -> NFData a
rnf :: Located a -> ()
$crnf :: forall a. NFData a => Located a -> ()
NFData
, forall a b. a -> Located b -> Located a
forall a b. (a -> b) -> Located a -> Located b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Located b -> Located a
$c<$ :: forall a b. a -> Located b -> Located a
fmap :: forall a b. (a -> b) -> Located a -> Located b
$cfmap :: forall a b. (a -> b) -> Located a -> Located b
Functor, forall a. Eq a => a -> Located a -> Bool
forall a. Num a => Located a -> a
forall a. Ord a => Located a -> a
forall m. Monoid m => Located m -> m
forall a. Located a -> Bool
forall a. Located a -> Int
forall a. Located a -> [a]
forall a. (a -> a -> a) -> Located a -> a
forall m a. Monoid m => (a -> m) -> Located a -> m
forall b a. (b -> a -> b) -> b -> Located a -> b
forall a b. (a -> b -> b) -> b -> Located a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => Located a -> a
$cproduct :: forall a. Num a => Located a -> a
sum :: forall a. Num a => Located a -> a
$csum :: forall a. Num a => Located a -> a
minimum :: forall a. Ord a => Located a -> a
$cminimum :: forall a. Ord a => Located a -> a
maximum :: forall a. Ord a => Located a -> a
$cmaximum :: forall a. Ord a => Located a -> a
elem :: forall a. Eq a => a -> Located a -> Bool
$celem :: forall a. Eq a => a -> Located a -> Bool
length :: forall a. Located a -> Int
$clength :: forall a. Located a -> Int
null :: forall a. Located a -> Bool
$cnull :: forall a. Located a -> Bool
toList :: forall a. Located a -> [a]
$ctoList :: forall a. Located a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Located a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Located a -> a
foldr1 :: forall a. (a -> a -> a) -> Located a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Located a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Located a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Located a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Located a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Located a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Located a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Located a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Located a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Located a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Located a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Located a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Located a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Located a -> m
fold :: forall m. Monoid m => Located m -> m
$cfold :: forall m. Monoid m => Located m -> m
Foldable, Functor Located
Foldable Located
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Located (m a) -> m (Located a)
forall (f :: * -> *) a.
Applicative f =>
Located (f a) -> f (Located a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Located a -> m (Located b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Located a -> f (Located b)
sequence :: forall (m :: * -> *) a. Monad m => Located (m a) -> m (Located a)
$csequence :: forall (m :: * -> *) a. Monad m => Located (m a) -> m (Located a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Located a -> m (Located b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Located a -> m (Located b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Located (f a) -> f (Located a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
Located (f a) -> f (Located a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Located a -> f (Located b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Located a -> f (Located b)
Traversable )
data Position = Position { Position -> Int
line :: !Int, Position -> Int
col :: !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, Int -> Position -> ShowS
[Position] -> ShowS
Position -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Position] -> ShowS
$cshowList :: [Position] -> ShowS
show :: Position -> FilePath
$cshow :: Position -> FilePath
showsPrec :: Int -> Position -> ShowS
$cshowsPrec :: Int -> Position -> ShowS
Show, forall x. Rep Position x -> Position
forall x. Position -> Rep Position x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Position x -> Position
$cfrom :: forall x. Position -> Rep Position x
Generic, Position -> ()
forall a. (a -> ()) -> NFData a
rnf :: Position -> ()
$crnf :: Position -> ()
NFData)
data Range = Range { Range -> Position
from :: !Position
, Range -> Position
to :: !Position
, Range -> FilePath
source :: FilePath }
deriving (Range -> Range -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Range -> Range -> Bool
$c/= :: Range -> Range -> Bool
== :: Range -> Range -> Bool
$c== :: Range -> Range -> Bool
Eq, Eq Range
Range -> Range -> Bool
Range -> Range -> Ordering
Range -> Range -> Range
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 :: Range -> Range -> Range
$cmin :: Range -> Range -> Range
max :: Range -> Range -> Range
$cmax :: Range -> Range -> Range
>= :: Range -> Range -> Bool
$c>= :: Range -> Range -> Bool
> :: Range -> Range -> Bool
$c> :: Range -> Range -> Bool
<= :: Range -> Range -> Bool
$c<= :: Range -> Range -> Bool
< :: Range -> Range -> Bool
$c< :: Range -> Range -> Bool
compare :: Range -> Range -> Ordering
$ccompare :: Range -> Range -> Ordering
Ord, Int -> Range -> ShowS
[Range] -> ShowS
Range -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Range] -> ShowS
$cshowList :: [Range] -> ShowS
show :: Range -> FilePath
$cshow :: Range -> FilePath
showsPrec :: Int -> Range -> ShowS
$cshowsPrec :: Int -> Range -> ShowS
Show, forall x. Rep Range x -> Range
forall x. Range -> Rep Range x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Range x -> Range
$cfrom :: forall x. Range -> Rep Range x
Generic, Range -> ()
forall a. (a -> ()) -> NFData a
rnf :: Range -> ()
$crnf :: Range -> ()
NFData)
rangeWithin :: Range -> Range -> Bool
Range
a rangeWithin :: Range -> Range -> Bool
`rangeWithin` Range
b =
Range -> FilePath
source Range
a forall a. Eq a => a -> a -> Bool
== Range -> FilePath
source Range
b Bool -> Bool -> Bool
&& Range -> Position
from Range
a forall a. Ord a => a -> a -> Bool
>= Range -> Position
from Range
b Bool -> Bool -> Bool
&& Range -> Position
to Range
a forall a. Ord a => a -> a -> Bool
<= Range -> Position
to Range
b
emptyRange :: Range
emptyRange :: Range
emptyRange = Range { from :: Position
from = Position
start, to :: Position
to = Position
start, source :: FilePath
source = FilePath
"" }
start :: Position
start :: Position
start = Position { line :: Int
line = Int
1, col :: Int
col = Int
1 }
move :: Position -> Char -> Position
move :: Position -> Char -> Position
move Position
p Char
c = case Char
c of
Char
'\t' -> Position
p { col :: Int
col = ((Position -> Int
col Position
p forall a. Num a => a -> a -> a
+ Int
7) forall a. Integral a => a -> a -> a
`div` Int
8) forall a. Num a => a -> a -> a
* Int
8 forall a. Num a => a -> a -> a
+ Int
1 }
Char
'\n' -> Position
p { col :: Int
col = Int
1, line :: Int
line = Int
1 forall a. Num a => a -> a -> a
+ Position -> Int
line Position
p }
Char
_ -> Position
p { col :: Int
col = Int
1 forall a. Num a => a -> a -> a
+ Position -> Int
col Position
p }
moves :: Position -> Text -> Position
moves :: Position -> Text -> Position
moves Position
p Text
cs = forall a. (a -> Char -> a) -> a -> Text -> a
T.foldl' Position -> Char -> Position
move Position
p Text
cs
rComb :: Range -> Range -> Range
rComb :: Range -> Range -> Range
rComb Range
r1 Range
r2 = Range { from :: Position
from = Position
rFrom, to :: Position
to = Position
rTo, source :: FilePath
source = Range -> FilePath
source Range
r1 }
where rFrom :: Position
rFrom = forall a. Ord a => a -> a -> a
min (Range -> Position
from Range
r1) (Range -> Position
from Range
r2)
rTo :: Position
rTo = forall a. Ord a => a -> a -> a
max (Range -> Position
to Range
r1) (Range -> Position
to Range
r2)
rCombMaybe :: Maybe Range -> Maybe Range -> Maybe Range
rCombMaybe :: Maybe Range -> Maybe Range -> Maybe Range
rCombMaybe Maybe Range
Nothing Maybe Range
y = Maybe Range
y
rCombMaybe Maybe Range
x Maybe Range
Nothing = Maybe Range
x
rCombMaybe (Just Range
x) (Just Range
y) = forall a. a -> Maybe a
Just (Range -> Range -> Range
rComb Range
x Range
y)
rCombs :: [Range] -> Range
rCombs :: [Range] -> Range
rCombs = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Range -> Range -> Range
rComb
instance PP Position where
ppPrec :: Int -> Position -> Doc
ppPrec Int
_ Position
p = Int -> Doc
int (Position -> Int
line Position
p) Doc -> Doc -> Doc
<.> Doc
colon Doc -> Doc -> Doc
<.> Int -> Doc
int (Position -> Int
col Position
p)
instance PP Range where
ppPrec :: Int -> Range -> Doc
ppPrec Int
_ Range
r = FilePath -> Doc
text (Range -> FilePath
source Range
r) Doc -> Doc -> Doc
<.> Char -> Doc
char Char
':'
Doc -> Doc -> Doc
<.> forall a. PP a => a -> Doc
pp (Range -> Position
from Range
r) Doc -> Doc -> Doc
<.> FilePath -> Doc
text FilePath
"--" Doc -> Doc -> Doc
<.> forall a. PP a => a -> Doc
pp (Range -> Position
to Range
r)
instance PP a => PP (Located a) where
ppPrec :: Int -> Located a -> Doc
ppPrec Int
_ Located a
l = Doc -> Doc
parens (FilePath -> Doc
text FilePath
"at" Doc -> Doc -> Doc
<+> forall a. PP a => a -> Doc
pp (forall a. Located a -> Range
srcRange Located a
l) Doc -> Doc -> Doc
<.> Doc
comma Doc -> Doc -> Doc
<+> forall a. PP a => a -> Doc
pp (forall a. Located a -> a
thing Located a
l))
instance PPName a => PPName (Located a) where
ppNameFixity :: Located a -> Maybe Fixity
ppNameFixity Located { a
Range
thing :: a
srcRange :: Range
thing :: forall a. Located a -> a
srcRange :: forall a. Located a -> Range
.. } = forall a. PPName a => a -> Maybe Fixity
ppNameFixity a
thing
ppPrefixName :: Located a -> Doc
ppPrefixName Located { a
Range
thing :: a
srcRange :: Range
thing :: forall a. Located a -> a
srcRange :: forall a. Located a -> Range
.. } = forall a. PPName a => a -> Doc
ppPrefixName a
thing
ppInfixName :: Located a -> Doc
ppInfixName Located { a
Range
thing :: a
srcRange :: Range
thing :: forall a. Located a -> a
srcRange :: forall a. Located a -> Range
.. } = forall a. PPName a => a -> Doc
ppInfixName a
thing
class HasLoc t where
getLoc :: t -> Maybe Range
instance HasLoc Range where
getLoc :: Range -> Maybe Range
getLoc Range
r = forall a. a -> Maybe a
Just Range
r
instance HasLoc (Located a) where
getLoc :: Located a -> Maybe Range
getLoc Located a
r = forall a. a -> Maybe a
Just (forall a. Located a -> Range
srcRange Located a
r)
instance (HasLoc a, HasLoc b) => HasLoc (a,b) where
getLoc :: (a, b) -> Maybe Range
getLoc (a
f,b
t) = case forall t. HasLoc t => t -> Maybe Range
getLoc a
f of
Maybe Range
Nothing -> forall t. HasLoc t => t -> Maybe Range
getLoc b
t
Just Range
l ->
case forall t. HasLoc t => t -> Maybe Range
getLoc b
t of
Maybe Range
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return Range
l
Just Range
l1 -> forall (m :: * -> *) a. Monad m => a -> m a
return (Range -> Range -> Range
rComb Range
l Range
l1)
instance HasLoc a => HasLoc [a] where
getLoc :: [a] -> Maybe Range
getLoc = forall {t}. HasLoc t => Maybe Range -> [t] -> Maybe Range
go forall a. Maybe a
Nothing
where
go :: Maybe Range -> [t] -> Maybe Range
go Maybe Range
x [] = Maybe Range
x
go Maybe Range
Nothing (t
x : [t]
xs) = Maybe Range -> [t] -> Maybe Range
go (forall t. HasLoc t => t -> Maybe Range
getLoc t
x) [t]
xs
go (Just Range
l) (t
x : [t]
xs) = case forall t. HasLoc t => t -> Maybe Range
getLoc t
x of
Maybe Range
Nothing -> Maybe Range -> [t] -> Maybe Range
go (forall a. a -> Maybe a
Just Range
l) [t]
xs
Just Range
l1 -> Maybe Range -> [t] -> Maybe Range
go (forall a. a -> Maybe a
Just (Range -> Range -> Range
rComb Range
l Range
l1)) [t]
xs
class HasLoc t => AddLoc t where
addLoc :: t -> Range -> t
dropLoc :: t -> t
instance AddLoc (Located a) where
addLoc :: Located a -> Range -> Located a
addLoc Located a
t Range
r = Located a
t { srcRange :: Range
srcRange = Range
r }
dropLoc :: Located a -> Located a
dropLoc Located a
r = Located a
r
at :: (HasLoc l, AddLoc t) => l -> t -> t
at :: forall l t. (HasLoc l, AddLoc t) => l -> t -> t
at l
l t
e = forall b a. b -> (a -> b) -> Maybe a -> b
maybe t
e (forall t. AddLoc t => t -> Range -> t
addLoc t
e) (forall t. HasLoc t => t -> Maybe Range
getLoc l
l)
combLoc :: (a -> b -> c) -> Located a -> Located b -> Located c
combLoc :: forall a b c. (a -> b -> c) -> Located a -> Located b -> Located c
combLoc a -> b -> c
f Located a
l1 Located b
l2 = Located { srcRange :: Range
srcRange = Range -> Range -> Range
rComb (forall a. Located a -> Range
srcRange Located a
l1) (forall a. Located a -> Range
srcRange Located b
l2)
, thing :: c
thing = a -> b -> c
f (forall a. Located a -> a
thing Located a
l1) (forall a. Located a -> a
thing Located b
l2)
}