{-# LANGUAGE FlexibleInstances #-}
-- This corresponds to src/comp/Position.hs in bsc.
module Language.Bluespec.Classic.AST.Position
  ( Position(..)
  , bestPosition
  , noPosition
  , updatePosStdlib
  , HasPosition(..)
  ) where

import Text.PrettyPrint.HughesPJClass

import Language.Bluespec.Prelude

-- For now, we don't track positions, although we may do so in the future.
data Position = NoPos
  deriving (Position -> Position -> Bool
(Position -> Position -> Bool)
-> (Position -> Position -> Bool) -> Eq Position
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Position -> Position -> Bool
== :: Position -> Position -> Bool
$c/= :: Position -> Position -> Bool
/= :: 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
$ccompare :: Position -> Position -> Ordering
compare :: Position -> Position -> Ordering
$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
>= :: Position -> Position -> Bool
$cmax :: Position -> Position -> Position
max :: Position -> Position -> Position
$cmin :: Position -> Position -> Position
min :: Position -> Position -> 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
$cshowsPrec :: Int -> Position -> ShowS
showsPrec :: Int -> Position -> ShowS
$cshow :: Position -> String
show :: Position -> String
$cshowList :: [Position] -> ShowS
showList :: [Position] -> ShowS
Show)

instance Pretty Position where
    pPrintPrec :: PrettyLevel -> Rational -> Position -> Doc
pPrintPrec PrettyLevel
_ Rational
_ Position
NoPos = String -> Doc
text String
"<NoPos>"

bestPosition :: Position -> Position -> Position
bestPosition :: Position -> Position -> Position
bestPosition Position
p1 Position
p2 = if Position
p1 Position -> Position -> Bool
forall a. Eq a => a -> a -> Bool
== Position
noPosition then Position
p2 else Position
p1

noPosition :: Position
noPosition :: Position
noPosition = Position
NoPos

updatePosStdlib :: Position -> Bool -> Position
updatePosStdlib :: Position -> Bool -> Position
updatePosStdlib Position
pos Bool
_is_stdlib = Position
pos

class HasPosition a where
    getPosition :: a -> Position

instance HasPosition Position where
    getPosition :: Position -> Position
getPosition Position
p = Position
p

instance (HasPosition a) => HasPosition (Maybe a) where
    getPosition :: Maybe a -> Position
getPosition (Just a
x) = a -> Position
forall a. HasPosition a => a -> Position
getPosition a
x
    getPosition Maybe a
Nothing = Position
noPosition

instance (HasPosition a, HasPosition b) => HasPosition (Either a b) where
    getPosition :: Either a b -> Position
getPosition (Right b
x) = b -> Position
forall a. HasPosition a => a -> Position
getPosition b
x
    getPosition (Left a
x) = a -> Position
forall a. HasPosition a => a -> Position
getPosition a
x

instance (HasPosition a) => HasPosition [a] where
    getPosition :: [a] -> Position
getPosition [] = Position
noPosition
    getPosition (a
x:[a]
xs) = a -> Position
forall a. HasPosition a => a -> Position
getPosition a
x Position -> Position -> Position
`bestPosition` [a] -> Position
forall a. HasPosition a => a -> Position
getPosition [a]
xs

instance (HasPosition a, HasPosition b) => HasPosition (a, b) where
    getPosition :: (a, b) -> Position
getPosition (a
x, b
y) = a -> Position
forall a. HasPosition a => a -> Position
getPosition a
x Position -> Position -> Position
`bestPosition` b -> Position
forall a. HasPosition a => a -> Position
getPosition b
y

instance (HasPosition a, HasPosition b, HasPosition c) => HasPosition (a, b, c) where
    getPosition :: (a, b, c) -> Position
getPosition (a
x, b
y, c
z) = a -> Position
forall a. HasPosition a => a -> Position
getPosition a
x Position -> Position -> Position
`bestPosition` b -> Position
forall a. HasPosition a => a -> Position
getPosition b
y Position -> Position -> Position
`bestPosition` c -> Position
forall a. HasPosition a => a -> Position
getPosition c
z

instance (HasPosition a, HasPosition b, HasPosition c, HasPosition d) => HasPosition (a, b, c, d) where
    getPosition :: (a, b, c, d) -> Position
getPosition (a
x, b
y, c
z, d
w) = a -> Position
forall a. HasPosition a => a -> Position
getPosition a
x Position -> Position -> Position
`bestPosition` b -> Position
forall a. HasPosition a => a -> Position
getPosition b
y Position -> Position -> Position
`bestPosition` c -> Position
forall a. HasPosition a => a -> Position
getPosition c
z Position -> Position -> Position
`bestPosition` d -> Position
forall a. HasPosition a => a -> Position
getPosition d
w

instance HasPosition String where
    getPosition :: String -> Position
getPosition String
_x = Position
noPosition