-- | -- Module : Cryptol.Parser.Position -- Copyright : (c) 2013-2016 Galois, Inc. -- License : BSD3 -- Maintainer : cryptol@galois.com -- Stability : provisional -- Portability : portable {-# LANGUAGE Safe #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# 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 { Located a -> Range srcRange :: !Range, Located a -> a thing :: !a } deriving (Located a -> Located a -> Bool (Located a -> Located a -> Bool) -> (Located a -> Located a -> Bool) -> Eq (Located a) 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, Eq (Located a) Eq (Located a) -> (Located a -> Located a -> Ordering) -> (Located a -> Located a -> Bool) -> (Located a -> Located a -> Bool) -> (Located a -> Located a -> Bool) -> (Located a -> Located a -> Bool) -> (Located a -> Located a -> Located a) -> (Located a -> Located a -> Located a) -> Ord (Located a) Located a -> Located a -> Bool Located a -> Located a -> Ordering Located a -> Located a -> Located a 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 $cp1Ord :: forall a. Ord a => Eq (Located a) Ord, Int -> Located a -> ShowS [Located a] -> ShowS Located a -> String (Int -> Located a -> ShowS) -> (Located a -> String) -> ([Located a] -> ShowS) -> Show (Located a) forall a. Show a => Int -> Located a -> ShowS forall a. Show a => [Located a] -> ShowS forall a. Show a => Located a -> String forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [Located a] -> ShowS $cshowList :: forall a. Show a => [Located a] -> ShowS show :: Located a -> String $cshow :: forall a. Show a => Located a -> String showsPrec :: Int -> Located a -> ShowS $cshowsPrec :: forall a. Show a => Int -> Located a -> ShowS Show, (forall x. Located a -> Rep (Located a) x) -> (forall x. Rep (Located a) x -> Located a) -> Generic (Located a) forall x. Rep (Located a) x -> Located a forall x. Located a -> Rep (Located a) x 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, Located a -> () (Located a -> ()) -> NFData (Located a) forall a. NFData a => Located a -> () forall a. (a -> ()) -> NFData a rnf :: Located a -> () $crnf :: forall a. NFData a => Located a -> () NFData) data Position = Position { Position -> Int line :: !Int, Position -> Int col :: !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, Int -> Position -> ShowS [Position] -> ShowS Position -> String (Int -> Position -> ShowS) -> (Position -> String) -> ([Position] -> ShowS) -> Show Position forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [Position] -> ShowS $cshowList :: [Position] -> ShowS show :: Position -> String $cshow :: Position -> String showsPrec :: Int -> Position -> ShowS $cshowsPrec :: Int -> Position -> ShowS Show, (forall x. Position -> Rep Position x) -> (forall x. Rep Position x -> Position) -> Generic Position 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 -> () (Position -> ()) -> NFData Position forall a. (a -> ()) -> NFData a rnf :: Position -> () $crnf :: Position -> () NFData) data Range = Range { Range -> Position from :: !Position , Range -> Position to :: !Position , Range -> String source :: FilePath } deriving (Range -> Range -> Bool (Range -> Range -> Bool) -> (Range -> Range -> Bool) -> Eq Range 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 Eq Range -> (Range -> Range -> Ordering) -> (Range -> Range -> Bool) -> (Range -> Range -> Bool) -> (Range -> Range -> Bool) -> (Range -> Range -> Bool) -> (Range -> Range -> Range) -> (Range -> Range -> Range) -> Ord 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 $cp1Ord :: Eq Range Ord, Int -> Range -> ShowS [Range] -> ShowS Range -> String (Int -> Range -> ShowS) -> (Range -> String) -> ([Range] -> ShowS) -> Show Range forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [Range] -> ShowS $cshowList :: [Range] -> ShowS show :: Range -> String $cshow :: Range -> String showsPrec :: Int -> Range -> ShowS $cshowsPrec :: Int -> Range -> ShowS Show, (forall x. Range -> Rep Range x) -> (forall x. Rep Range x -> Range) -> Generic Range 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 -> () (Range -> ()) -> NFData Range forall a. (a -> ()) -> NFData a rnf :: Range -> () $crnf :: Range -> () NFData) -- | An empty range. -- -- Caution: using this on the LHS of a use of rComb will cause the empty source -- to propagate. emptyRange :: Range emptyRange :: Range emptyRange = Range :: Position -> Position -> String -> Range Range { from :: Position from = Position start, to :: Position to = Position start, source :: String source = String "" } start :: Position start :: Position start = Position :: Int -> Int -> Position 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 Int -> Int -> Int forall a. Num a => a -> a -> a + Int 7) Int -> Int -> Int forall a. Integral a => a -> a -> a `div` Int 8) Int -> Int -> Int forall a. Num a => a -> a -> a * Int 8 Int -> Int -> Int forall a. Num a => a -> a -> a + Int 1 } Char '\n' -> Position p { col :: Int col = Int 1, line :: Int line = Int 1 Int -> Int -> Int forall a. Num a => a -> a -> a + Position -> Int line Position p } Char _ -> Position p { col :: Int col = Int 1 Int -> Int -> Int 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 = (Position -> Char -> Position) -> Position -> Text -> Position 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 :: Position -> Position -> String -> Range Range { from :: Position from = Position rFrom, to :: Position to = Position rTo, source :: String source = Range -> String source Range r1 } where rFrom :: Position rFrom = Position -> Position -> Position forall a. Ord a => a -> a -> a min (Range -> Position from Range r1) (Range -> Position from Range r2) rTo :: Position rTo = Position -> Position -> Position forall a. Ord a => a -> a -> a max (Range -> Position to Range r1) (Range -> Position to Range r2) rCombs :: [Range] -> Range rCombs :: [Range] -> Range rCombs = (Range -> Range -> Range) -> [Range] -> Range forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a foldl1 Range -> Range -> Range rComb instance Functor Located where fmap :: (a -> b) -> Located a -> Located b fmap a -> b f Located a l = Located a l { thing :: b thing = a -> b f (Located a -> a forall a. Located a -> a thing Located a l) } -------------------------------------------------------------------------------- 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 = String -> Doc text (Range -> String source Range r) Doc -> Doc -> Doc <.> Char -> Doc char Char ':' Doc -> Doc -> Doc <.> Position -> Doc forall a. PP a => a -> Doc pp (Range -> Position from Range r) Doc -> Doc -> Doc <.> String -> Doc text String "--" Doc -> Doc -> Doc <.> Position -> 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 (String -> Doc text String "at" Doc -> Doc -> Doc <+> Range -> Doc forall a. PP a => a -> Doc pp (Located a -> Range forall a. Located a -> Range srcRange Located a l) Doc -> Doc -> Doc <.> Doc comma Doc -> Doc -> Doc <+> a -> Doc forall a. PP a => a -> Doc pp (Located a -> a 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 .. } = a -> Maybe Fixity 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 .. } = a -> Doc 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 .. } = a -> Doc 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 = Range -> Maybe Range forall a. a -> Maybe a Just Range r instance HasLoc (Located a) where getLoc :: Located a -> Maybe Range getLoc Located a r = Range -> Maybe Range forall a. a -> Maybe a Just (Located a -> Range 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 a -> Maybe Range forall t. HasLoc t => t -> Maybe Range getLoc a f of Maybe Range Nothing -> b -> Maybe Range forall t. HasLoc t => t -> Maybe Range getLoc b t Just Range l -> case b -> Maybe Range forall t. HasLoc t => t -> Maybe Range getLoc b t of Maybe Range Nothing -> Range -> Maybe Range forall (m :: * -> *) a. Monad m => a -> m a return Range l Just Range l1 -> Range -> Maybe Range 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 = Maybe Range -> [a] -> Maybe Range forall t. HasLoc t => Maybe Range -> [t] -> Maybe Range go Maybe Range 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 (t -> Maybe Range forall t. HasLoc t => t -> Maybe Range getLoc t x) [t] xs go (Just Range l) (t x : [t] xs) = case t -> Maybe Range forall t. HasLoc t => t -> Maybe Range getLoc t x of Maybe Range Nothing -> Maybe Range -> [t] -> Maybe Range go (Range -> Maybe Range forall a. a -> Maybe a Just Range l) [t] xs Just Range l1 -> Maybe Range -> [t] -> Maybe Range go (Range -> Maybe Range 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 :: l -> t -> t at l l t e = t -> (Range -> t) -> Maybe Range -> t forall b a. b -> (a -> b) -> Maybe a -> b maybe t e (t -> Range -> t forall t. AddLoc t => t -> Range -> t addLoc t e) (l -> Maybe Range forall t. HasLoc t => t -> Maybe Range getLoc l l) combLoc :: (a -> b -> c) -> Located a -> Located b -> Located c combLoc :: (a -> b -> c) -> Located a -> Located b -> Located c combLoc a -> b -> c f Located a l1 Located b l2 = Located :: forall a. Range -> a -> Located a Located { srcRange :: Range srcRange = Range -> Range -> Range rComb (Located a -> Range forall a. Located a -> Range srcRange Located a l1) (Located b -> Range forall a. Located a -> Range srcRange Located b l2) , thing :: c thing = a -> b -> c f (Located a -> a forall a. Located a -> a thing Located a l1) (Located b -> b forall a. Located a -> a thing Located b l2) }