-- SPDX-FileCopyrightText: 2020 Tocqueville Group
--
-- SPDX-License-Identifier: LicenseRef-MIT-TQ

module Michelson.ErrorPos
  ( mkPos
  , unsafeMkPos
  , Pos (..)
  , SrcPos (..)
  , srcPos
  , InstrCallStack (..)
  , LetCallStack
  , LetName (..)
  ) where

import Data.Aeson.TH (deriveJSON)
import Data.Data (Data(..))
import Data.Default (Default(..))
import qualified Data.Text as T
import Fmt (Buildable (..))
import Michelson.Printer.Util (RenderDoc (..), renderAnyBuildable)
import Text.PrettyPrint.Leijen.Text


import Util.Aeson


newtype Pos = Pos {Pos -> Word
unPos :: Word}
  deriving stock (Pos -> Pos -> Bool
(Pos -> Pos -> Bool) -> (Pos -> Pos -> Bool) -> Eq Pos
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pos -> Pos -> Bool
$c/= :: Pos -> Pos -> Bool
== :: Pos -> Pos -> Bool
$c== :: Pos -> Pos -> Bool
Eq, Eq Pos
Eq Pos
-> (Pos -> Pos -> Ordering)
-> (Pos -> Pos -> Bool)
-> (Pos -> Pos -> Bool)
-> (Pos -> Pos -> Bool)
-> (Pos -> Pos -> Bool)
-> (Pos -> Pos -> Pos)
-> (Pos -> Pos -> Pos)
-> Ord Pos
Pos -> Pos -> Bool
Pos -> Pos -> Ordering
Pos -> Pos -> Pos
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 :: Pos -> Pos -> Pos
$cmin :: Pos -> Pos -> Pos
max :: Pos -> Pos -> Pos
$cmax :: Pos -> Pos -> Pos
>= :: Pos -> Pos -> Bool
$c>= :: Pos -> Pos -> Bool
> :: Pos -> Pos -> Bool
$c> :: Pos -> Pos -> Bool
<= :: Pos -> Pos -> Bool
$c<= :: Pos -> Pos -> Bool
< :: Pos -> Pos -> Bool
$c< :: Pos -> Pos -> Bool
compare :: Pos -> Pos -> Ordering
$ccompare :: Pos -> Pos -> Ordering
$cp1Ord :: Eq Pos
Ord, Int -> Pos -> ShowS
[Pos] -> ShowS
Pos -> String
(Int -> Pos -> ShowS)
-> (Pos -> String) -> ([Pos] -> ShowS) -> Show Pos
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pos] -> ShowS
$cshowList :: [Pos] -> ShowS
show :: Pos -> String
$cshow :: Pos -> String
showsPrec :: Int -> Pos -> ShowS
$cshowsPrec :: Int -> Pos -> ShowS
Show, (forall x. Pos -> Rep Pos x)
-> (forall x. Rep Pos x -> Pos) -> Generic Pos
forall x. Rep Pos x -> Pos
forall x. Pos -> Rep Pos x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Pos x -> Pos
$cfrom :: forall x. Pos -> Rep Pos x
Generic, Typeable Pos
DataType
Constr
Typeable Pos
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Pos -> c Pos)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Pos)
-> (Pos -> Constr)
-> (Pos -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Pos))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Pos))
-> ((forall b. Data b => b -> b) -> Pos -> Pos)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Pos -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Pos -> r)
-> (forall u. (forall d. Data d => d -> u) -> Pos -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Pos -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Pos -> m Pos)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Pos -> m Pos)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Pos -> m Pos)
-> Data Pos
Pos -> DataType
Pos -> Constr
(forall b. Data b => b -> b) -> Pos -> Pos
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Pos -> c Pos
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Pos
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Pos -> u
forall u. (forall d. Data d => d -> u) -> Pos -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Pos -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Pos -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Pos -> m Pos
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Pos -> m Pos
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Pos
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Pos -> c Pos
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Pos)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Pos)
$cPos :: Constr
$tPos :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Pos -> m Pos
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Pos -> m Pos
gmapMp :: (forall d. Data d => d -> m d) -> Pos -> m Pos
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Pos -> m Pos
gmapM :: (forall d. Data d => d -> m d) -> Pos -> m Pos
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Pos -> m Pos
gmapQi :: Int -> (forall d. Data d => d -> u) -> Pos -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Pos -> u
gmapQ :: (forall d. Data d => d -> u) -> Pos -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Pos -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Pos -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Pos -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Pos -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Pos -> r
gmapT :: (forall b. Data b => b -> b) -> Pos -> Pos
$cgmapT :: (forall b. Data b => b -> b) -> Pos -> Pos
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Pos)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Pos)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Pos)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Pos)
dataTypeOf :: Pos -> DataType
$cdataTypeOf :: Pos -> DataType
toConstr :: Pos -> Constr
$ctoConstr :: Pos -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Pos
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Pos
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Pos -> c Pos
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Pos -> c Pos
$cp1Data :: Typeable Pos
Data)

instance NFData Pos

unsafeMkPos :: Int -> Pos
unsafeMkPos :: Int -> Pos
unsafeMkPos Int
x
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0     = Text -> Pos
forall a. HasCallStack => Text -> a
error (Text -> Pos) -> Text -> Pos
forall a b. (a -> b) -> a -> b
$ Text
"negative pos: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
x
  | Bool
otherwise = Word -> Pos
Pos (Word -> Pos) -> Word -> Pos
forall a b. (a -> b) -> a -> b
$ Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x

mkPos :: Int -> Maybe Pos
mkPos :: Int -> Maybe Pos
mkPos Int
x
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0     = Maybe Pos
forall a. Maybe a
Nothing
  | Bool
otherwise = Pos -> Maybe Pos
forall a. a -> Maybe a
Just (Pos -> Maybe Pos) -> Pos -> Maybe Pos
forall a b. (a -> b) -> a -> b
$ Word -> Pos
Pos (Word -> Pos) -> Word -> Pos
forall a b. (a -> b) -> a -> b
$ Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x

data SrcPos =
  SrcPos
  { SrcPos -> Pos
srcLine :: Pos
  , SrcPos -> Pos
srcCol :: Pos
  } deriving stock (SrcPos -> SrcPos -> Bool
(SrcPos -> SrcPos -> Bool)
-> (SrcPos -> SrcPos -> Bool) -> Eq SrcPos
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SrcPos -> SrcPos -> Bool
$c/= :: SrcPos -> SrcPos -> Bool
== :: SrcPos -> SrcPos -> Bool
$c== :: SrcPos -> SrcPos -> Bool
Eq, Eq SrcPos
Eq SrcPos
-> (SrcPos -> SrcPos -> Ordering)
-> (SrcPos -> SrcPos -> Bool)
-> (SrcPos -> SrcPos -> Bool)
-> (SrcPos -> SrcPos -> Bool)
-> (SrcPos -> SrcPos -> Bool)
-> (SrcPos -> SrcPos -> SrcPos)
-> (SrcPos -> SrcPos -> SrcPos)
-> Ord SrcPos
SrcPos -> SrcPos -> Bool
SrcPos -> SrcPos -> Ordering
SrcPos -> SrcPos -> SrcPos
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 :: SrcPos -> SrcPos -> SrcPos
$cmin :: SrcPos -> SrcPos -> SrcPos
max :: SrcPos -> SrcPos -> SrcPos
$cmax :: SrcPos -> SrcPos -> SrcPos
>= :: SrcPos -> SrcPos -> Bool
$c>= :: SrcPos -> SrcPos -> Bool
> :: SrcPos -> SrcPos -> Bool
$c> :: SrcPos -> SrcPos -> Bool
<= :: SrcPos -> SrcPos -> Bool
$c<= :: SrcPos -> SrcPos -> Bool
< :: SrcPos -> SrcPos -> Bool
$c< :: SrcPos -> SrcPos -> Bool
compare :: SrcPos -> SrcPos -> Ordering
$ccompare :: SrcPos -> SrcPos -> Ordering
$cp1Ord :: Eq SrcPos
Ord, Int -> SrcPos -> ShowS
[SrcPos] -> ShowS
SrcPos -> String
(Int -> SrcPos -> ShowS)
-> (SrcPos -> String) -> ([SrcPos] -> ShowS) -> Show SrcPos
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SrcPos] -> ShowS
$cshowList :: [SrcPos] -> ShowS
show :: SrcPos -> String
$cshow :: SrcPos -> String
showsPrec :: Int -> SrcPos -> ShowS
$cshowsPrec :: Int -> SrcPos -> ShowS
Show, (forall x. SrcPos -> Rep SrcPos x)
-> (forall x. Rep SrcPos x -> SrcPos) -> Generic SrcPos
forall x. Rep SrcPos x -> SrcPos
forall x. SrcPos -> Rep SrcPos x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SrcPos x -> SrcPos
$cfrom :: forall x. SrcPos -> Rep SrcPos x
Generic, Typeable SrcPos
DataType
Constr
Typeable SrcPos
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> SrcPos -> c SrcPos)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SrcPos)
-> (SrcPos -> Constr)
-> (SrcPos -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SrcPos))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SrcPos))
-> ((forall b. Data b => b -> b) -> SrcPos -> SrcPos)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SrcPos -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SrcPos -> r)
-> (forall u. (forall d. Data d => d -> u) -> SrcPos -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> SrcPos -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> SrcPos -> m SrcPos)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SrcPos -> m SrcPos)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SrcPos -> m SrcPos)
-> Data SrcPos
SrcPos -> DataType
SrcPos -> Constr
(forall b. Data b => b -> b) -> SrcPos -> SrcPos
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SrcPos -> c SrcPos
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SrcPos
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> SrcPos -> u
forall u. (forall d. Data d => d -> u) -> SrcPos -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SrcPos -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SrcPos -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SrcPos -> m SrcPos
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SrcPos -> m SrcPos
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SrcPos
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SrcPos -> c SrcPos
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SrcPos)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SrcPos)
$cSrcPos :: Constr
$tSrcPos :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> SrcPos -> m SrcPos
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SrcPos -> m SrcPos
gmapMp :: (forall d. Data d => d -> m d) -> SrcPos -> m SrcPos
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SrcPos -> m SrcPos
gmapM :: (forall d. Data d => d -> m d) -> SrcPos -> m SrcPos
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SrcPos -> m SrcPos
gmapQi :: Int -> (forall d. Data d => d -> u) -> SrcPos -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SrcPos -> u
gmapQ :: (forall d. Data d => d -> u) -> SrcPos -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SrcPos -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SrcPos -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SrcPos -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SrcPos -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SrcPos -> r
gmapT :: (forall b. Data b => b -> b) -> SrcPos -> SrcPos
$cgmapT :: (forall b. Data b => b -> b) -> SrcPos -> SrcPos
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SrcPos)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SrcPos)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c SrcPos)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SrcPos)
dataTypeOf :: SrcPos -> DataType
$cdataTypeOf :: SrcPos -> DataType
toConstr :: SrcPos -> Constr
$ctoConstr :: SrcPos -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SrcPos
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SrcPos
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SrcPos -> c SrcPos
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SrcPos -> c SrcPos
$cp1Data :: Typeable SrcPos
Data)

instance Buildable SrcPos where
  build :: SrcPos -> Builder
build (SrcPos (Pos Word
l) (Pos Word
c)) = Word -> Builder
forall p. Buildable p => p -> Builder
build Word
l Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
":" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word -> Builder
forall p. Buildable p => p -> Builder
build Word
c

instance NFData SrcPos

srcPos :: Word -> Word -> SrcPos
srcPos :: Word -> Word -> SrcPos
srcPos Word
x Word
y = Pos -> Pos -> SrcPos
SrcPos (Word -> Pos
Pos Word
x) (Word -> Pos
Pos Word
y)

newtype LetName = LetName T.Text
  deriving stock (LetName -> LetName -> Bool
(LetName -> LetName -> Bool)
-> (LetName -> LetName -> Bool) -> Eq LetName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LetName -> LetName -> Bool
$c/= :: LetName -> LetName -> Bool
== :: LetName -> LetName -> Bool
$c== :: LetName -> LetName -> Bool
Eq, Eq LetName
Eq LetName
-> (LetName -> LetName -> Ordering)
-> (LetName -> LetName -> Bool)
-> (LetName -> LetName -> Bool)
-> (LetName -> LetName -> Bool)
-> (LetName -> LetName -> Bool)
-> (LetName -> LetName -> LetName)
-> (LetName -> LetName -> LetName)
-> Ord LetName
LetName -> LetName -> Bool
LetName -> LetName -> Ordering
LetName -> LetName -> LetName
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 :: LetName -> LetName -> LetName
$cmin :: LetName -> LetName -> LetName
max :: LetName -> LetName -> LetName
$cmax :: LetName -> LetName -> LetName
>= :: LetName -> LetName -> Bool
$c>= :: LetName -> LetName -> Bool
> :: LetName -> LetName -> Bool
$c> :: LetName -> LetName -> Bool
<= :: LetName -> LetName -> Bool
$c<= :: LetName -> LetName -> Bool
< :: LetName -> LetName -> Bool
$c< :: LetName -> LetName -> Bool
compare :: LetName -> LetName -> Ordering
$ccompare :: LetName -> LetName -> Ordering
$cp1Ord :: Eq LetName
Ord, Int -> LetName -> ShowS
[LetName] -> ShowS
LetName -> String
(Int -> LetName -> ShowS)
-> (LetName -> String) -> ([LetName] -> ShowS) -> Show LetName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LetName] -> ShowS
$cshowList :: [LetName] -> ShowS
show :: LetName -> String
$cshow :: LetName -> String
showsPrec :: Int -> LetName -> ShowS
$cshowsPrec :: Int -> LetName -> ShowS
Show, Typeable LetName
DataType
Constr
Typeable LetName
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> LetName -> c LetName)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c LetName)
-> (LetName -> Constr)
-> (LetName -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c LetName))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c LetName))
-> ((forall b. Data b => b -> b) -> LetName -> LetName)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> LetName -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> LetName -> r)
-> (forall u. (forall d. Data d => d -> u) -> LetName -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> LetName -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> LetName -> m LetName)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> LetName -> m LetName)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> LetName -> m LetName)
-> Data LetName
LetName -> DataType
LetName -> Constr
(forall b. Data b => b -> b) -> LetName -> LetName
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LetName -> c LetName
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LetName
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> LetName -> u
forall u. (forall d. Data d => d -> u) -> LetName -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LetName -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LetName -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> LetName -> m LetName
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LetName -> m LetName
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LetName
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LetName -> c LetName
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LetName)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c LetName)
$cLetName :: Constr
$tLetName :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> LetName -> m LetName
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LetName -> m LetName
gmapMp :: (forall d. Data d => d -> m d) -> LetName -> m LetName
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LetName -> m LetName
gmapM :: (forall d. Data d => d -> m d) -> LetName -> m LetName
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> LetName -> m LetName
gmapQi :: Int -> (forall d. Data d => d -> u) -> LetName -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> LetName -> u
gmapQ :: (forall d. Data d => d -> u) -> LetName -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> LetName -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LetName -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LetName -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LetName -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LetName -> r
gmapT :: (forall b. Data b => b -> b) -> LetName -> LetName
$cgmapT :: (forall b. Data b => b -> b) -> LetName -> LetName
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c LetName)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c LetName)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c LetName)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LetName)
dataTypeOf :: LetName -> DataType
$cdataTypeOf :: LetName -> DataType
toConstr :: LetName -> Constr
$ctoConstr :: LetName -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LetName
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LetName
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LetName -> c LetName
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LetName -> c LetName
$cp1Data :: Typeable LetName
Data, (forall x. LetName -> Rep LetName x)
-> (forall x. Rep LetName x -> LetName) -> Generic LetName
forall x. Rep LetName x -> LetName
forall x. LetName -> Rep LetName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LetName x -> LetName
$cfrom :: forall x. LetName -> Rep LetName x
Generic)
  deriving newtype LetName -> Builder
(LetName -> Builder) -> Buildable LetName
forall p. (p -> Builder) -> Buildable p
build :: LetName -> Builder
$cbuild :: LetName -> Builder
Buildable

instance NFData LetName

type LetCallStack = [LetName]
data InstrCallStack = InstrCallStack
  { InstrCallStack -> [LetName]
icsCallStack :: LetCallStack
  , InstrCallStack -> SrcPos
icsSrcPos    :: SrcPos
  } deriving stock (InstrCallStack -> InstrCallStack -> Bool
(InstrCallStack -> InstrCallStack -> Bool)
-> (InstrCallStack -> InstrCallStack -> Bool) -> Eq InstrCallStack
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InstrCallStack -> InstrCallStack -> Bool
$c/= :: InstrCallStack -> InstrCallStack -> Bool
== :: InstrCallStack -> InstrCallStack -> Bool
$c== :: InstrCallStack -> InstrCallStack -> Bool
Eq, Eq InstrCallStack
Eq InstrCallStack
-> (InstrCallStack -> InstrCallStack -> Ordering)
-> (InstrCallStack -> InstrCallStack -> Bool)
-> (InstrCallStack -> InstrCallStack -> Bool)
-> (InstrCallStack -> InstrCallStack -> Bool)
-> (InstrCallStack -> InstrCallStack -> Bool)
-> (InstrCallStack -> InstrCallStack -> InstrCallStack)
-> (InstrCallStack -> InstrCallStack -> InstrCallStack)
-> Ord InstrCallStack
InstrCallStack -> InstrCallStack -> Bool
InstrCallStack -> InstrCallStack -> Ordering
InstrCallStack -> InstrCallStack -> InstrCallStack
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 :: InstrCallStack -> InstrCallStack -> InstrCallStack
$cmin :: InstrCallStack -> InstrCallStack -> InstrCallStack
max :: InstrCallStack -> InstrCallStack -> InstrCallStack
$cmax :: InstrCallStack -> InstrCallStack -> InstrCallStack
>= :: InstrCallStack -> InstrCallStack -> Bool
$c>= :: InstrCallStack -> InstrCallStack -> Bool
> :: InstrCallStack -> InstrCallStack -> Bool
$c> :: InstrCallStack -> InstrCallStack -> Bool
<= :: InstrCallStack -> InstrCallStack -> Bool
$c<= :: InstrCallStack -> InstrCallStack -> Bool
< :: InstrCallStack -> InstrCallStack -> Bool
$c< :: InstrCallStack -> InstrCallStack -> Bool
compare :: InstrCallStack -> InstrCallStack -> Ordering
$ccompare :: InstrCallStack -> InstrCallStack -> Ordering
$cp1Ord :: Eq InstrCallStack
Ord, Int -> InstrCallStack -> ShowS
[InstrCallStack] -> ShowS
InstrCallStack -> String
(Int -> InstrCallStack -> ShowS)
-> (InstrCallStack -> String)
-> ([InstrCallStack] -> ShowS)
-> Show InstrCallStack
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InstrCallStack] -> ShowS
$cshowList :: [InstrCallStack] -> ShowS
show :: InstrCallStack -> String
$cshow :: InstrCallStack -> String
showsPrec :: Int -> InstrCallStack -> ShowS
$cshowsPrec :: Int -> InstrCallStack -> ShowS
Show, (forall x. InstrCallStack -> Rep InstrCallStack x)
-> (forall x. Rep InstrCallStack x -> InstrCallStack)
-> Generic InstrCallStack
forall x. Rep InstrCallStack x -> InstrCallStack
forall x. InstrCallStack -> Rep InstrCallStack x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InstrCallStack x -> InstrCallStack
$cfrom :: forall x. InstrCallStack -> Rep InstrCallStack x
Generic, Typeable InstrCallStack
DataType
Constr
Typeable InstrCallStack
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> InstrCallStack -> c InstrCallStack)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c InstrCallStack)
-> (InstrCallStack -> Constr)
-> (InstrCallStack -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c InstrCallStack))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c InstrCallStack))
-> ((forall b. Data b => b -> b)
    -> InstrCallStack -> InstrCallStack)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> InstrCallStack -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> InstrCallStack -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> InstrCallStack -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> InstrCallStack -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> InstrCallStack -> m InstrCallStack)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> InstrCallStack -> m InstrCallStack)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> InstrCallStack -> m InstrCallStack)
-> Data InstrCallStack
InstrCallStack -> DataType
InstrCallStack -> Constr
(forall b. Data b => b -> b) -> InstrCallStack -> InstrCallStack
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InstrCallStack -> c InstrCallStack
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InstrCallStack
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> InstrCallStack -> u
forall u. (forall d. Data d => d -> u) -> InstrCallStack -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InstrCallStack -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InstrCallStack -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> InstrCallStack -> m InstrCallStack
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> InstrCallStack -> m InstrCallStack
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InstrCallStack
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InstrCallStack -> c InstrCallStack
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c InstrCallStack)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c InstrCallStack)
$cInstrCallStack :: Constr
$tInstrCallStack :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> InstrCallStack -> m InstrCallStack
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> InstrCallStack -> m InstrCallStack
gmapMp :: (forall d. Data d => d -> m d)
-> InstrCallStack -> m InstrCallStack
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> InstrCallStack -> m InstrCallStack
gmapM :: (forall d. Data d => d -> m d)
-> InstrCallStack -> m InstrCallStack
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> InstrCallStack -> m InstrCallStack
gmapQi :: Int -> (forall d. Data d => d -> u) -> InstrCallStack -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> InstrCallStack -> u
gmapQ :: (forall d. Data d => d -> u) -> InstrCallStack -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> InstrCallStack -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InstrCallStack -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InstrCallStack -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InstrCallStack -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InstrCallStack -> r
gmapT :: (forall b. Data b => b -> b) -> InstrCallStack -> InstrCallStack
$cgmapT :: (forall b. Data b => b -> b) -> InstrCallStack -> InstrCallStack
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c InstrCallStack)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c InstrCallStack)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c InstrCallStack)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c InstrCallStack)
dataTypeOf :: InstrCallStack -> DataType
$cdataTypeOf :: InstrCallStack -> DataType
toConstr :: InstrCallStack -> Constr
$ctoConstr :: InstrCallStack -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InstrCallStack
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InstrCallStack
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InstrCallStack -> c InstrCallStack
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InstrCallStack -> c InstrCallStack
$cp1Data :: Typeable InstrCallStack
Data)

instance RenderDoc InstrCallStack where
  renderDoc :: RenderContext -> InstrCallStack -> Doc
renderDoc RenderContext
_ InstrCallStack{[LetName]
icsCallStack :: [LetName]
icsCallStack :: InstrCallStack -> [LetName]
icsCallStack, icsSrcPos :: InstrCallStack -> SrcPos
icsSrcPos = SrcPos (Pos Word
row) (Pos Word
col)} =
    Doc
"Error occurred on line" Doc -> Doc -> Doc
<+> (Word -> Doc
forall a. Buildable a => a -> Doc
renderAnyBuildable (Word
row Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
1)) Doc -> Doc -> Doc
<+> Doc
"char" Doc -> Doc -> Doc
<+> (Word -> Doc
forall a. Buildable a => a -> Doc
renderAnyBuildable (Word
col Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
1))
    Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> case [LetName]
icsCallStack of
         [] -> Doc
"."
         [LetName]
_ -> Doc
" inside these let defenitions:" Doc -> Doc -> Doc
<+> ([Doc] -> Doc
list ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (LetName -> Doc) -> [LetName] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Doc
text (Text -> Doc) -> (LetName -> Text) -> LetName -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LetName -> Text
forall b a. (Show a, IsString b) => a -> b
show) [LetName]
icsCallStack) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"."

instance NFData InstrCallStack

instance Default Pos where
  def :: Pos
def = Word -> Pos
Pos Word
0

instance Default SrcPos where
  def :: SrcPos
def = Pos -> Pos -> SrcPos
SrcPos Pos
forall a. Default a => a
def Pos
forall a. Default a => a
def

instance Default InstrCallStack where
  def :: InstrCallStack
def = [LetName] -> SrcPos -> InstrCallStack
InstrCallStack [LetName]
forall a. Default a => a
def SrcPos
forall a. Default a => a
def

deriveJSON morleyAesonOptions ''Pos
deriveJSON morleyAesonOptions ''SrcPos
deriveJSON morleyAesonOptions ''LetName
deriveJSON morleyAesonOptions ''InstrCallStack