{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}

-- |
-- Module      :  Swarm.Language.Pretty
-- Copyright   :  Brent Yorgey
-- Maintainer  :  byorgey@gmail.com
--
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Pretty-printing for the Swarm language.
module Swarm.Language.Pretty where

import Control.Lens.Combinators (pattern Empty)
import Control.Unification
import Control.Unification.IntVar
import Data.Bool (bool)
import Data.Functor.Fixedpoint (Fix, unFix)
import Data.String (fromString)
import Data.Text (Text)
import Data.Text qualified as T
import Prettyprinter
import Prettyprinter.Render.String qualified as RS
import Prettyprinter.Render.Text qualified as RT
import Swarm.Language.Capability
import Swarm.Language.Context
import Swarm.Language.Syntax
import Swarm.Language.Typecheck
import Swarm.Language.Types
import Witch

-- | Type class for things that can be pretty-printed, given a
--   precedence level of their context.
class PrettyPrec a where
  prettyPrec :: Int -> a -> Doc ann -- can replace with custom ann type later if desired

-- | Pretty-print a thing, with a context precedence level of zero.
ppr :: PrettyPrec a => a -> Doc ann
ppr :: forall a ann. PrettyPrec a => a -> Doc ann
ppr = forall a ann. PrettyPrec a => Int -> a -> Doc ann
prettyPrec Int
0

-- | Pretty-print something and render it as @Text@.
prettyText :: PrettyPrec a => a -> Text
prettyText :: forall a. PrettyPrec a => a -> Text
prettyText = forall ann. SimpleDocStream ann -> Text
RT.renderStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutPretty LayoutOptions
defaultLayoutOptions forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. PrettyPrec a => a -> Doc ann
ppr

-- | Pretty-print something and render it as a @String@.
prettyString :: PrettyPrec a => a -> String
prettyString :: forall a. PrettyPrec a => a -> String
prettyString = forall ann. SimpleDocStream ann -> String
RS.renderString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutPretty LayoutOptions
defaultLayoutOptions forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. PrettyPrec a => a -> Doc ann
ppr

-- | Optionally surround a document with parentheses depending on the
--   @Bool@ argument.
pparens :: Bool -> Doc ann -> Doc ann
pparens :: forall ann. Bool -> Doc ann -> Doc ann
pparens Bool
True = forall ann. Doc ann -> Doc ann
parens
pparens Bool
False = forall a. a -> a
id

instance PrettyPrec BaseTy where
  prettyPrec :: forall ann. Int -> BaseTy -> Doc ann
prettyPrec Int
_ BaseTy
BVoid = Doc ann
"void"
  prettyPrec Int
_ BaseTy
BUnit = Doc ann
"unit"
  prettyPrec Int
_ BaseTy
BInt = Doc ann
"int"
  prettyPrec Int
_ BaseTy
BDir = Doc ann
"dir"
  prettyPrec Int
_ BaseTy
BText = Doc ann
"text"
  prettyPrec Int
_ BaseTy
BBool = Doc ann
"bool"
  prettyPrec Int
_ BaseTy
BRobot = Doc ann
"robot"

instance PrettyPrec IntVar where
  prettyPrec :: forall ann. Int -> IntVar -> Doc ann
prettyPrec Int
_ = forall a ann. Pretty a => a -> Doc ann
pretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> IntVar -> Text
mkVarName Text
"u"

instance PrettyPrec (t (Fix t)) => PrettyPrec (Fix t) where
  prettyPrec :: forall ann. Int -> Fix t -> Doc ann
prettyPrec Int
p = forall a ann. PrettyPrec a => Int -> a -> Doc ann
prettyPrec Int
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *). Fix f -> f (Fix f)
unFix

instance (PrettyPrec (t (UTerm t v)), PrettyPrec v) => PrettyPrec (UTerm t v) where
  prettyPrec :: forall ann. Int -> UTerm t v -> Doc ann
prettyPrec Int
p (UTerm t (UTerm t v)
t) = forall a ann. PrettyPrec a => Int -> a -> Doc ann
prettyPrec Int
p t (UTerm t v)
t
  prettyPrec Int
p (UVar v
v) = forall a ann. PrettyPrec a => Int -> a -> Doc ann
prettyPrec Int
p v
v

instance PrettyPrec t => PrettyPrec (TypeF t) where
  prettyPrec :: forall ann. Int -> TypeF t -> Doc ann
prettyPrec Int
_ (TyBaseF BaseTy
b) = forall a ann. PrettyPrec a => a -> Doc ann
ppr BaseTy
b
  prettyPrec Int
_ (TyVarF Text
v) = forall a ann. Pretty a => a -> Doc ann
pretty Text
v
  prettyPrec Int
p (TySumF t
ty1 t
ty2) =
    forall ann. Bool -> Doc ann -> Doc ann
pparens (Int
p forall a. Ord a => a -> a -> Bool
> Int
1) forall a b. (a -> b) -> a -> b
$
      forall a ann. PrettyPrec a => Int -> a -> Doc ann
prettyPrec Int
2 t
ty1 forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"+" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. PrettyPrec a => Int -> a -> Doc ann
prettyPrec Int
1 t
ty2
  prettyPrec Int
p (TyProdF t
ty1 t
ty2) =
    forall ann. Bool -> Doc ann -> Doc ann
pparens (Int
p forall a. Ord a => a -> a -> Bool
> Int
2) forall a b. (a -> b) -> a -> b
$
      forall a ann. PrettyPrec a => Int -> a -> Doc ann
prettyPrec Int
3 t
ty1 forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"*" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. PrettyPrec a => Int -> a -> Doc ann
prettyPrec Int
2 t
ty2
  prettyPrec Int
p (TyCmdF t
ty) = forall ann. Bool -> Doc ann -> Doc ann
pparens (Int
p forall a. Ord a => a -> a -> Bool
> Int
9) forall a b. (a -> b) -> a -> b
$ Doc ann
"cmd" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. PrettyPrec a => Int -> a -> Doc ann
prettyPrec Int
10 t
ty
  prettyPrec Int
_ (TyDelayF t
ty) = forall ann. Doc ann -> Doc ann
braces forall a b. (a -> b) -> a -> b
$ forall a ann. PrettyPrec a => a -> Doc ann
ppr t
ty
  prettyPrec Int
p (TyFunF t
ty1 t
ty2) =
    forall ann. Bool -> Doc ann -> Doc ann
pparens (Int
p forall a. Ord a => a -> a -> Bool
> Int
0) forall a b. (a -> b) -> a -> b
$
      forall a ann. PrettyPrec a => Int -> a -> Doc ann
prettyPrec Int
1 t
ty1 forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"->" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. PrettyPrec a => Int -> a -> Doc ann
prettyPrec Int
0 t
ty2

instance PrettyPrec Polytype where
  prettyPrec :: forall ann. Int -> Polytype -> Doc ann
prettyPrec Int
_ (Forall [] Type
t) = forall a ann. PrettyPrec a => a -> Doc ann
ppr Type
t
  prettyPrec Int
_ (Forall [Text]
xs Type
t) = forall ann. [Doc ann] -> Doc ann
hsep (Doc ann
"∀" forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty [Text]
xs) forall a. Semigroup a => a -> a -> a
<> Doc ann
"." forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. PrettyPrec a => a -> Doc ann
ppr Type
t

instance PrettyPrec UPolytype where
  prettyPrec :: forall ann. Int -> UPolytype -> Doc ann
prettyPrec Int
_ (Forall [] UType
t) = forall a ann. PrettyPrec a => a -> Doc ann
ppr UType
t
  prettyPrec Int
_ (Forall [Text]
xs UType
t) = forall ann. [Doc ann] -> Doc ann
hsep (Doc ann
"∀" forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty [Text]
xs) forall a. Semigroup a => a -> a -> a
<> Doc ann
"." forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. PrettyPrec a => a -> Doc ann
ppr UType
t

instance PrettyPrec t => PrettyPrec (Ctx t) where
  prettyPrec :: forall ann. Int -> Ctx t -> Doc ann
prettyPrec Int
_ Ctx t
Empty = forall ann. Doc ann
emptyDoc
  prettyPrec Int
_ (forall t. Ctx t -> [(Text, t)]
assocs -> [(Text, t)]
bs) = forall ann. Doc ann -> Doc ann
brackets (forall ann. [Doc ann] -> Doc ann
hsep (forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
"," (forall a b. (a -> b) -> [a] -> [b]
map forall {a} {a} {ann}. (Pretty a, PrettyPrec a) => (a, a) -> Doc ann
prettyBinding [(Text, t)]
bs)))
   where
    prettyBinding :: (a, a) -> Doc ann
prettyBinding (a
x, a
ty) = forall a ann. Pretty a => a -> Doc ann
pretty a
x forall a. Semigroup a => a -> a -> a
<> Doc ann
":" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. PrettyPrec a => a -> Doc ann
ppr a
ty

instance PrettyPrec Direction where
  prettyPrec :: forall ann. Int -> Direction -> Doc ann
prettyPrec Int
_ = forall a ann. Pretty a => a -> Doc ann
pretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. DirInfo -> Text
dirSyntax forall b c a. (b -> c) -> (a -> b) -> a -> c
. Direction -> DirInfo
dirInfo

instance PrettyPrec Capability where
  prettyPrec :: forall ann. Int -> Capability -> Doc ann
prettyPrec Int
_ Capability
c = forall a ann. Pretty a => a -> Doc ann
pretty forall a b. (a -> b) -> a -> b
$ Text -> Text
T.toLower (forall source target. From source target => source -> target
from (forall a. [a] -> [a]
tail forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Capability
c))

instance PrettyPrec Const where
  prettyPrec :: forall ann. Int -> Const -> Doc ann
prettyPrec Int
p Const
c = forall ann. Bool -> Doc ann -> Doc ann
pparens (Int
p forall a. Ord a => a -> a -> Bool
> ConstInfo -> Int
fixity (Const -> ConstInfo
constInfo Const
c)) forall a b. (a -> b) -> a -> b
$ forall a ann. Pretty a => a -> Doc ann
pretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConstInfo -> Text
syntax forall b c a. (b -> c) -> (a -> b) -> a -> c
. Const -> ConstInfo
constInfo forall a b. (a -> b) -> a -> b
$ Const
c

instance PrettyPrec Term where
  prettyPrec :: forall ann. Int -> Term -> Doc ann
prettyPrec Int
_ Term
TUnit = Doc ann
"()"
  prettyPrec Int
p (TConst Const
c) = forall a ann. PrettyPrec a => Int -> a -> Doc ann
prettyPrec Int
p Const
c
  prettyPrec Int
_ (TDir Direction
d) = forall a ann. PrettyPrec a => a -> Doc ann
ppr Direction
d
  prettyPrec Int
_ (TInt Integer
n) = forall a ann. Pretty a => a -> Doc ann
pretty Integer
n
  prettyPrec Int
_ (TAntiInt Text
v) = Doc ann
"$int:" forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty Text
v
  prettyPrec Int
_ (TText Text
s) = forall a. IsString a => String -> a
fromString (forall a. Show a => a -> String
show Text
s)
  prettyPrec Int
_ (TAntiText Text
v) = Doc ann
"$str:" forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty Text
v
  prettyPrec Int
_ (TBool Bool
b) = forall a. a -> a -> Bool -> a
bool Doc ann
"false" Doc ann
"true" Bool
b
  prettyPrec Int
_ (TRobot Int
r) = Doc ann
"<r" forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty Int
r forall a. Semigroup a => a -> a -> a
<> Doc ann
">"
  prettyPrec Int
_ (TRef Int
r) = Doc ann
"@" forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty Int
r
  prettyPrec Int
p (TRequireDevice Text
d) = forall ann. Bool -> Doc ann -> Doc ann
pparens (Int
p forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$ Doc ann
"require" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. PrettyPrec a => a -> Doc ann
ppr (Text -> Term
TText Text
d)
  prettyPrec Int
p (TRequire Int
n Text
e) = forall ann. Bool -> Doc ann -> Doc ann
pparens (Int
p forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$ Doc ann
"require" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Int
n forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. PrettyPrec a => a -> Doc ann
ppr (Text -> Term
TText Text
e)
  prettyPrec Int
_ (TVar Text
s) = forall a ann. Pretty a => a -> Doc ann
pretty Text
s
  prettyPrec Int
_ (TDelay DelayType
_ Term
t) = forall ann. Doc ann -> Doc ann
braces forall a b. (a -> b) -> a -> b
$ forall a ann. PrettyPrec a => a -> Doc ann
ppr Term
t
  prettyPrec Int
_ t :: Term
t@TPair {} = forall a. Term -> Doc a
prettyTuple Term
t
  prettyPrec Int
_ (TLam Text
x Maybe Type
mty Term
body) =
    Doc ann
"\\" forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty Text
x forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc ann
"" ((Doc ann
":" forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. PrettyPrec a => a -> Doc ann
ppr) Maybe Type
mty forall a. Semigroup a => a -> a -> a
<> Doc ann
"." forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. PrettyPrec a => a -> Doc ann
ppr Term
body
  -- Special handling of infix operators - ((+) 2) 3 --> 2 + 3
  prettyPrec Int
p (TApp t :: Term
t@(TApp (TConst Const
c) Term
l) Term
r) =
    let ci :: ConstInfo
ci = Const -> ConstInfo
constInfo Const
c
        pC :: Int
pC = ConstInfo -> Int
fixity ConstInfo
ci
     in case ConstInfo -> ConstMeta
constMeta ConstInfo
ci of
          ConstMBinOp MBinAssoc
assoc ->
            forall ann. Bool -> Doc ann -> Doc ann
pparens (Int
p forall a. Ord a => a -> a -> Bool
> Int
pC) forall a b. (a -> b) -> a -> b
$
              forall ann. [Doc ann] -> Doc ann
hsep
                [ forall a ann. PrettyPrec a => Int -> a -> Doc ann
prettyPrec (Int
pC forall a. Num a => a -> a -> a
+ forall a. Enum a => a -> Int
fromEnum (MBinAssoc
assoc forall a. Eq a => a -> a -> Bool
== MBinAssoc
R)) Term
l
                , forall a ann. PrettyPrec a => a -> Doc ann
ppr Const
c
                , forall a ann. PrettyPrec a => Int -> a -> Doc ann
prettyPrec (Int
pC forall a. Num a => a -> a -> a
+ forall a. Enum a => a -> Int
fromEnum (MBinAssoc
assoc forall a. Eq a => a -> a -> Bool
== MBinAssoc
L)) Term
r
                ]
          ConstMeta
_ -> forall a. Int -> Term -> Term -> Doc a
prettyPrecApp Int
p Term
t Term
r
  prettyPrec Int
p (TApp Term
t1 Term
t2) = case Term
t1 of
    TConst Const
c ->
      let ci :: ConstInfo
ci = Const -> ConstInfo
constInfo Const
c
          pC :: Int
pC = ConstInfo -> Int
fixity ConstInfo
ci
       in case ConstInfo -> ConstMeta
constMeta ConstInfo
ci of
            ConstMUnOp MUnAssoc
P -> forall ann. Bool -> Doc ann -> Doc ann
pparens (Int
p forall a. Ord a => a -> a -> Bool
> Int
pC) forall a b. (a -> b) -> a -> b
$ forall a ann. PrettyPrec a => a -> Doc ann
ppr Term
t1 forall a. Semigroup a => a -> a -> a
<> forall a ann. PrettyPrec a => Int -> a -> Doc ann
prettyPrec (forall a. Enum a => a -> a
succ Int
pC) Term
t2
            ConstMUnOp MUnAssoc
S -> forall ann. Bool -> Doc ann -> Doc ann
pparens (Int
p forall a. Ord a => a -> a -> Bool
> Int
pC) forall a b. (a -> b) -> a -> b
$ forall a ann. PrettyPrec a => Int -> a -> Doc ann
prettyPrec (forall a. Enum a => a -> a
succ Int
pC) Term
t2 forall a. Semigroup a => a -> a -> a
<> forall a ann. PrettyPrec a => a -> Doc ann
ppr Term
t1
            ConstMeta
_ -> forall a. Int -> Term -> Term -> Doc a
prettyPrecApp Int
p Term
t1 Term
t2
    Term
_ -> forall a. Int -> Term -> Term -> Doc a
prettyPrecApp Int
p Term
t1 Term
t2
  prettyPrec Int
_ (TLet Bool
_ Text
x Maybe Polytype
mty Term
t1 Term
t2) =
    forall ann. [Doc ann] -> Doc ann
hsep forall a b. (a -> b) -> a -> b
$
      [Doc ann
"let", forall a ann. Pretty a => a -> Doc ann
pretty Text
x]
        forall a. [a] -> [a] -> [a]
++ forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Polytype
ty -> [Doc ann
":", forall a ann. PrettyPrec a => a -> Doc ann
ppr Polytype
ty]) Maybe Polytype
mty
        forall a. [a] -> [a] -> [a]
++ [Doc ann
"=", forall a ann. PrettyPrec a => a -> Doc ann
ppr Term
t1, Doc ann
"in", forall a ann. PrettyPrec a => a -> Doc ann
ppr Term
t2]
  prettyPrec Int
_ (TDef Bool
_ Text
x Maybe Polytype
mty Term
t1) =
    forall ann. [Doc ann] -> Doc ann
hsep forall a b. (a -> b) -> a -> b
$
      [Doc ann
"def", forall a ann. Pretty a => a -> Doc ann
pretty Text
x]
        forall a. [a] -> [a] -> [a]
++ forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Polytype
ty -> [Doc ann
":", forall a ann. PrettyPrec a => a -> Doc ann
ppr Polytype
ty]) Maybe Polytype
mty
        forall a. [a] -> [a] -> [a]
++ [Doc ann
"=", forall a ann. PrettyPrec a => a -> Doc ann
ppr Term
t1, Doc ann
"end"]
  prettyPrec Int
p (TBind Maybe Text
Nothing Term
t1 Term
t2) =
    forall ann. Bool -> Doc ann -> Doc ann
pparens (Int
p forall a. Ord a => a -> a -> Bool
> Int
0) forall a b. (a -> b) -> a -> b
$
      forall a ann. PrettyPrec a => Int -> a -> Doc ann
prettyPrec Int
1 Term
t1 forall a. Semigroup a => a -> a -> a
<> Doc ann
";" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. PrettyPrec a => Int -> a -> Doc ann
prettyPrec Int
0 Term
t2
  prettyPrec Int
p (TBind (Just Text
x) Term
t1 Term
t2) =
    forall ann. Bool -> Doc ann -> Doc ann
pparens (Int
p forall a. Ord a => a -> a -> Bool
> Int
0) forall a b. (a -> b) -> a -> b
$
      forall a ann. Pretty a => a -> Doc ann
pretty Text
x forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"<-" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. PrettyPrec a => Int -> a -> Doc ann
prettyPrec Int
1 Term
t1 forall a. Semigroup a => a -> a -> a
<> Doc ann
";" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. PrettyPrec a => Int -> a -> Doc ann
prettyPrec Int
0 Term
t2

prettyTuple :: Term -> Doc a
prettyTuple :: forall a. Term -> Doc a
prettyTuple = forall ann. Bool -> Doc ann -> Doc ann
pparens Bool
True forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ann. [Doc ann] -> Doc ann
hsep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc a
"," forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a ann. PrettyPrec a => a -> Doc ann
ppr forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> [Term]
unnestTuple
 where
  unnestTuple :: Term -> [Term]
unnestTuple (TPair Term
t1 Term
t2) = Term
t1 forall a. a -> [a] -> [a]
: Term -> [Term]
unnestTuple Term
t2
  unnestTuple Term
t = [Term
t]

prettyPrecApp :: Int -> Term -> Term -> Doc a
prettyPrecApp :: forall a. Int -> Term -> Term -> Doc a
prettyPrecApp Int
p Term
t1 Term
t2 =
  forall ann. Bool -> Doc ann -> Doc ann
pparens (Int
p forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$
    forall a ann. PrettyPrec a => Int -> a -> Doc ann
prettyPrec Int
10 Term
t1 forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. PrettyPrec a => Int -> a -> Doc ann
prettyPrec Int
11 Term
t2

appliedTermPrec :: Term -> Int
appliedTermPrec :: Term -> Int
appliedTermPrec (TApp Term
f Term
_) = case Term
f of
  TConst Const
c -> ConstInfo -> Int
fixity forall a b. (a -> b) -> a -> b
$ Const -> ConstInfo
constInfo Const
c
  Term
_ -> Term -> Int
appliedTermPrec Term
f
appliedTermPrec Term
_ = Int
10

instance PrettyPrec TypeErr where
  prettyPrec :: forall ann. Int -> TypeErr -> Doc ann
prettyPrec Int
_ (Mismatch Location
_ TypeF UType
ty1 TypeF UType
ty2) =
    Doc ann
"Can't unify" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. PrettyPrec a => a -> Doc ann
ppr TypeF UType
ty1 forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"and" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. PrettyPrec a => a -> Doc ann
ppr TypeF UType
ty2
  prettyPrec Int
_ (EscapedSkolem Location
_ Text
x) =
    Doc ann
"Skolem variable" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Text
x forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"would escape its scope"
  prettyPrec Int
_ (UnboundVar Location
_ Text
x) =
    Doc ann
"Unbound variable" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Text
x
  prettyPrec Int
_ (Infinite IntVar
x UType
uty) =
    Doc ann
"Infinite type:" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. PrettyPrec a => a -> Doc ann
ppr IntVar
x forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"=" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. PrettyPrec a => a -> Doc ann
ppr UType
uty
  prettyPrec Int
_ (DefNotTopLevel Location
_ Term
t) =
    Doc ann
"Definitions may only be at the top level:" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. PrettyPrec a => a -> Doc ann
ppr Term
t
  prettyPrec Int
_ (CantInfer Location
_ Term
t) =
    Doc ann
"Couldn't infer the type of term (this shouldn't happen; please report this as a bug!):" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. PrettyPrec a => a -> Doc ann
ppr Term
t
  prettyPrec Int
_ (InvalidAtomic Location
_ InvalidAtomicReason
reason Term
t) =
    Doc ann
"Invalid atomic block:" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. PrettyPrec a => a -> Doc ann
ppr InvalidAtomicReason
reason forall a. Semigroup a => a -> a -> a
<> Doc ann
":" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. PrettyPrec a => a -> Doc ann
ppr Term
t

instance PrettyPrec InvalidAtomicReason where
  prettyPrec :: forall ann. Int -> InvalidAtomicReason -> Doc ann
prettyPrec Int
_ (TooManyTicks Int
n) = Doc ann
"block could take too many ticks (" forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty Int
n forall a. Semigroup a => a -> a -> a
<> Doc ann
")"
  prettyPrec Int
_ InvalidAtomicReason
AtomicDupingThing = Doc ann
"def, let, and lambda are not allowed"
  prettyPrec Int
_ (NonSimpleVarType Text
_ UPolytype
ty) = Doc ann
"reference to variable with non-simple type" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. PrettyPrec a => a -> Doc ann
ppr UPolytype
ty
  prettyPrec Int
_ InvalidAtomicReason
NestedAtomic = Doc ann
"nested atomic block"
  prettyPrec Int
_ InvalidAtomicReason
LongConst = Doc ann
"commands that can take multiple ticks to execute are not allowed"