{-# OPTIONS_GHC -fno-warn-orphans #-}

-- | Futhark prettyprinter.  This module defines 'Pretty' instances
-- for the AST defined in "Language.Futhark.Syntax".
module Language.Futhark.Pretty
  ( prettyString,
    prettyTuple,
    leadingOperator,
    IsName (..),
    Annot (..),
  )
where

import Control.Monad
import Data.Char (chr)
import Data.Functor
import Data.List (intersperse)
import Data.List.NonEmpty qualified as NE
import Data.Map.Strict qualified as M
import Data.Maybe
import Data.Monoid hiding (Sum)
import Data.Ord
import Data.Word
import Futhark.Util
import Futhark.Util.Pretty
import Language.Futhark.Prop
import Language.Futhark.Syntax
import Prelude

-- | A class for types that are variable names in the Futhark source
-- language.  This is used instead of a mere 'Pretty' instance because
-- in the compiler frontend we want to print VNames differently
-- depending on whether the FUTHARK_COMPILER_DEBUGGING environment
-- variable is set, yet in the backend we want to always print VNames
-- with the tag.  To avoid erroneously using the 'Pretty' instance for
-- VNames, we in fact only define it inside the modules for the core
-- language (as an orphan instance).
class IsName v where
  prettyName :: v -> Doc a
  toName :: v -> Name

-- | Depending on the environment variable FUTHARK_COMPILER_DEBUGGING,
-- VNames are printed as either the name with an internal tag, or just
-- the base name.
instance IsName VName where
  prettyName :: forall a. VName -> Doc a
prettyName
    | String -> Int -> Bool
isEnvVarAtLeast String
"FUTHARK_COMPILER_DEBUGGING" Int
1 =
        \(VName Name
vn Int
i) -> forall a ann. Pretty a => a -> Doc ann
pretty Name
vn forall a. Semigroup a => a -> a -> a
<> Doc a
"_" forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty (forall a. Show a => a -> String
show Int
i)
    | Bool
otherwise = forall a ann. Pretty a => a -> Doc ann
pretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. VName -> Name
baseName
  toName :: VName -> Name
toName = VName -> Name
baseName

instance IsName Name where
  prettyName :: forall a. Name -> Doc a
prettyName = forall a ann. Pretty a => a -> Doc ann
pretty
  toName :: Name -> Name
toName = forall a. a -> a
id

-- | Class for type constructors that represent annotations.  Used in
-- the prettyprinter to either print the original AST, or the computed
-- decoration.
class Annot f where
  -- | Extract value, if any.
  unAnnot :: f a -> Maybe a

instance Annot NoInfo where
  unAnnot :: forall a. NoInfo a -> Maybe a
unAnnot = forall a b. a -> b -> a
const forall a. Maybe a
Nothing

instance Annot Info where
  unAnnot :: forall a. Info a -> Maybe a
unAnnot = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Info a -> a
unInfo

instance Pretty PrimValue where
  pretty :: forall ann. PrimValue -> Doc ann
pretty (UnsignedValue (Int8Value Int8
v)) =
    forall a ann. Pretty a => a -> Doc ann
pretty (forall a. Show a => a -> String
show (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int8
v :: Word8)) forall a. Semigroup a => a -> a -> a
<> Doc ann
"u8"
  pretty (UnsignedValue (Int16Value Int16
v)) =
    forall a ann. Pretty a => a -> Doc ann
pretty (forall a. Show a => a -> String
show (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int16
v :: Word16)) forall a. Semigroup a => a -> a -> a
<> Doc ann
"u16"
  pretty (UnsignedValue (Int32Value Int32
v)) =
    forall a ann. Pretty a => a -> Doc ann
pretty (forall a. Show a => a -> String
show (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
v :: Word32)) forall a. Semigroup a => a -> a -> a
<> Doc ann
"u32"
  pretty (UnsignedValue (Int64Value Int64
v)) =
    forall a ann. Pretty a => a -> Doc ann
pretty (forall a. Show a => a -> String
show (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
v :: Word64)) forall a. Semigroup a => a -> a -> a
<> Doc ann
"u64"
  pretty (SignedValue IntValue
v) = forall a ann. Pretty a => a -> Doc ann
pretty IntValue
v
  pretty (BoolValue Bool
True) = Doc ann
"true"
  pretty (BoolValue Bool
False) = Doc ann
"false"
  pretty (FloatValue FloatValue
v) = forall a ann. Pretty a => a -> Doc ann
pretty FloatValue
v

instance Pretty Size where
  pretty :: forall ann. Size -> Doc ann
pretty (AnySize Maybe VName
Nothing) = forall a. Monoid a => a
mempty
  pretty (AnySize (Just VName
v)) = Doc ann
"?" forall a. Semigroup a => a -> a -> a
<> forall v a. IsName v => v -> Doc a
prettyName VName
v
  pretty (NamedSize QualName VName
v) = forall a ann. Pretty a => a -> Doc ann
pretty QualName VName
v
  pretty (ConstSize Int
n) = forall a ann. Pretty a => a -> Doc ann
pretty Int
n

instance IsName vn => Pretty (SizeExp vn) where
  pretty :: forall ann. SizeExp vn -> Doc ann
pretty SizeExp vn
SizeExpAny = forall a. Monoid a => a
mempty
  pretty (SizeExpNamed QualName vn
v SrcLoc
_) = forall a ann. Pretty a => a -> Doc ann
pretty QualName vn
v
  pretty (SizeExpConst Int
n SrcLoc
_) = forall a ann. Pretty a => a -> Doc ann
pretty Int
n

instance Pretty (Shape Size) where
  pretty :: forall ann. Shape Size -> Doc ann
pretty (Shape [Size]
ds) = forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map (forall ann. Doc ann -> Doc ann
brackets forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. Pretty a => a -> Doc ann
pretty) [Size]
ds)

instance Pretty (Shape ()) where
  pretty :: forall ann. Shape () -> Doc ann
pretty (Shape [()]
ds) = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> [a]
replicate (forall (t :: * -> *) a. Foldable t => t a -> Int
length [()]
ds) Doc ann
"[]"

instance Pretty (Shape Int64) where
  pretty :: forall ann. Shape Int64 -> Doc ann
pretty (Shape [Int64]
ds) = forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map (forall ann. Doc ann -> Doc ann
brackets forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. Pretty a => a -> Doc ann
pretty) [Int64]
ds)

instance Pretty (Shape Bool) where
  pretty :: forall ann. Shape Bool -> Doc ann
pretty (Shape [Bool]
ds) = forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map (forall ann. Doc ann -> Doc ann
brackets forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. Pretty a => a -> Doc ann
pretty) [Bool]
ds)

prettyRetType :: Pretty (Shape dim) => Int -> RetTypeBase dim as -> Doc a
prettyRetType :: forall dim as a.
Pretty (Shape dim) =>
Int -> RetTypeBase dim as -> Doc a
prettyRetType Int
p (RetType [] TypeBase dim as
t) =
  forall dim as a.
Pretty (Shape dim) =>
Int -> TypeBase dim as -> Doc a
prettyType Int
p TypeBase dim as
t
prettyRetType Int
_ (RetType [VName]
dims TypeBase dim as
t) =
  Doc a
"?"
    forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map (forall ann. Doc ann -> Doc ann
brackets forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v a. IsName v => v -> Doc a
prettyName) [VName]
dims)
    forall a. Semigroup a => a -> a -> a
<> Doc a
"."
    forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty TypeBase dim as
t

instance Pretty (Shape dim) => Pretty (RetTypeBase dim as) where
  pretty :: forall ann. RetTypeBase dim as -> Doc ann
pretty = forall dim as a.
Pretty (Shape dim) =>
Int -> RetTypeBase dim as -> Doc a
prettyRetType Int
0

prettyScalarType :: Pretty (Shape dim) => Int -> ScalarTypeBase dim as -> Doc a
prettyScalarType :: forall dim as a.
Pretty (Shape dim) =>
Int -> ScalarTypeBase dim as -> Doc a
prettyScalarType Int
_ (Prim PrimType
et) = forall a ann. Pretty a => a -> Doc ann
pretty PrimType
et
prettyScalarType Int
p (TypeVar as
_ Uniqueness
u QualName VName
v [TypeArg dim]
targs) =
  forall a. Bool -> Doc a -> Doc a
parensIf (Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TypeArg dim]
targs) Bool -> Bool -> Bool
&& Int
p forall a. Ord a => a -> a -> Bool
> Int
3) forall a b. (a -> b) -> a -> b
$
    forall a ann. Pretty a => a -> Doc ann
pretty Uniqueness
u forall a. Semigroup a => a -> a -> a
<> forall ann. [Doc ann] -> Doc ann
hsep (forall a ann. Pretty a => a -> Doc ann
pretty QualName VName
v forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (forall dim a. Pretty (Shape dim) => Int -> TypeArg dim -> Doc a
prettyTypeArg Int
3) [TypeArg dim]
targs)
prettyScalarType Int
_ (Record Map Name (TypeBase dim as)
fs)
  | Just [TypeBase dim as]
ts <- forall a. Map Name a -> Maybe [a]
areTupleFields Map Name (TypeBase dim as)
fs =
      forall ann. Doc ann -> Doc ann
group forall a b. (a -> b) -> a -> b
$ forall ann. Doc ann -> Doc ann
parens forall a b. (a -> b) -> a -> b
$ forall ann. Doc ann -> Doc ann
align forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate (Doc a
"," forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
line) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty [TypeBase dim as]
ts
  | Bool
otherwise =
      forall ann. Doc ann -> Doc ann
group forall a b. (a -> b) -> a -> b
$ forall ann. Doc ann -> Doc ann
braces forall a b. (a -> b) -> a -> b
$ forall ann. Doc ann -> Doc ann
align forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate (Doc a
"," forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
line) forall {ann}. [Doc ann]
fs'
  where
    ppField :: (Name, a) -> Doc ann
ppField (Name
name, a
t) = forall a ann. Pretty a => a -> Doc ann
pretty (Name -> String
nameToString Name
name) forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
colon forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
align (forall a ann. Pretty a => a -> Doc ann
pretty a
t)
    fs' :: [Doc ann]
fs' = forall a b. (a -> b) -> [a] -> [b]
map forall {a} {ann}. Pretty a => (Name, a) -> Doc ann
ppField forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
M.toList Map Name (TypeBase dim as)
fs
prettyScalarType Int
p (Arrow as
_ (Named VName
v) TypeBase dim ()
t1 RetTypeBase dim as
t2) =
  forall a. Bool -> Doc a -> Doc a
parensIf (Int
p forall a. Ord a => a -> a -> Bool
> Int
1) forall a b. (a -> b) -> a -> b
$
    forall ann. Doc ann -> Doc ann
parens (forall v a. IsName v => v -> Doc a
prettyName VName
v forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
colon forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
align (forall a ann. Pretty a => a -> Doc ann
pretty TypeBase dim ()
t1)) forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc a
"->" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall dim as a.
Pretty (Shape dim) =>
Int -> RetTypeBase dim as -> Doc a
prettyRetType Int
1 RetTypeBase dim as
t2
prettyScalarType Int
p (Arrow as
_ PName
Unnamed TypeBase dim ()
t1 RetTypeBase dim as
t2) =
  forall a. Bool -> Doc a -> Doc a
parensIf (Int
p forall a. Ord a => a -> a -> Bool
> Int
1) forall a b. (a -> b) -> a -> b
$ forall dim as a.
Pretty (Shape dim) =>
Int -> TypeBase dim as -> Doc a
prettyType Int
2 TypeBase dim ()
t1 forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc a
"->" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall dim as a.
Pretty (Shape dim) =>
Int -> RetTypeBase dim as -> Doc a
prettyRetType Int
1 RetTypeBase dim as
t2
prettyScalarType Int
p (Sum Map Name [TypeBase dim as]
cs) =
  forall a. Bool -> Doc a -> Doc a
parensIf (Int
p forall a. Ord a => a -> a -> Bool
> Int
0) forall a b. (a -> b) -> a -> b
$
    forall ann. Doc ann -> Doc ann
group (forall ann. Doc ann -> Doc ann
align (forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate (Doc a
" |" forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
line) forall {ann}. [Doc ann]
cs'))
  where
    ppConstr :: (a, [TypeBase dim as]) -> Doc ann
ppConstr (a
name, [TypeBase dim as]
fs) = forall ann. [Doc ann] -> Doc ann
sep forall a b. (a -> b) -> a -> b
$ (Doc ann
"#" forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty a
name) forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (forall dim as a.
Pretty (Shape dim) =>
Int -> TypeBase dim as -> Doc a
prettyType Int
2) [TypeBase dim as]
fs
    cs' :: [Doc ann]
cs' = forall a b. (a -> b) -> [a] -> [b]
map forall {a} {dim} {as} {ann}.
(Pretty a, Pretty (Shape dim)) =>
(a, [TypeBase dim as]) -> Doc ann
ppConstr forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
M.toList Map Name [TypeBase dim as]
cs

instance Pretty (Shape dim) => Pretty (ScalarTypeBase dim as) where
  pretty :: forall ann. ScalarTypeBase dim as -> Doc ann
pretty = forall dim as a.
Pretty (Shape dim) =>
Int -> ScalarTypeBase dim as -> Doc a
prettyScalarType Int
0

prettyType :: Pretty (Shape dim) => Int -> TypeBase dim as -> Doc a
prettyType :: forall dim as a.
Pretty (Shape dim) =>
Int -> TypeBase dim as -> Doc a
prettyType Int
_ (Array as
_ Uniqueness
u Shape dim
shape ScalarTypeBase dim ()
at) =
  forall a ann. Pretty a => a -> Doc ann
pretty Uniqueness
u forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty Shape dim
shape forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann -> Doc ann
align (forall dim as a.
Pretty (Shape dim) =>
Int -> ScalarTypeBase dim as -> Doc a
prettyScalarType Int
1 ScalarTypeBase dim ()
at)
prettyType Int
p (Scalar ScalarTypeBase dim as
t) =
  forall dim as a.
Pretty (Shape dim) =>
Int -> ScalarTypeBase dim as -> Doc a
prettyScalarType Int
p ScalarTypeBase dim as
t

instance Pretty (Shape dim) => Pretty (TypeBase dim as) where
  pretty :: forall ann. TypeBase dim as -> Doc ann
pretty = forall dim as a.
Pretty (Shape dim) =>
Int -> TypeBase dim as -> Doc a
prettyType Int
0

prettyTypeArg :: Pretty (Shape dim) => Int -> TypeArg dim -> Doc a
prettyTypeArg :: forall dim a. Pretty (Shape dim) => Int -> TypeArg dim -> Doc a
prettyTypeArg Int
_ (TypeArgDim dim
d SrcLoc
_) = forall a ann. Pretty a => a -> Doc ann
pretty forall a b. (a -> b) -> a -> b
$ forall dim. [dim] -> Shape dim
Shape [dim
d]
prettyTypeArg Int
p (TypeArgType TypeBase dim ()
t SrcLoc
_) = forall dim as a.
Pretty (Shape dim) =>
Int -> TypeBase dim as -> Doc a
prettyType Int
p TypeBase dim ()
t

instance Pretty (TypeArg Size) where
  pretty :: forall ann. TypeArg Size -> Doc ann
pretty = forall dim a. Pretty (Shape dim) => Int -> TypeArg dim -> Doc a
prettyTypeArg Int
0

instance (Eq vn, IsName vn) => Pretty (TypeExp vn) where
  pretty :: forall ann. TypeExp vn -> Doc ann
pretty (TEUnique TypeExp vn
t SrcLoc
_) = Doc ann
"*" forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty TypeExp vn
t
  pretty (TEArray SizeExp vn
d TypeExp vn
at SrcLoc
_) = forall ann. Doc ann -> Doc ann
brackets (forall a ann. Pretty a => a -> Doc ann
pretty SizeExp vn
d) forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty TypeExp vn
at
  pretty (TETuple [TypeExp vn]
ts SrcLoc
_) = forall ann. Doc ann -> Doc ann
parens forall a b. (a -> b) -> a -> b
$ forall ann. [Doc ann] -> Doc ann
commasep forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty [TypeExp vn]
ts
  pretty (TERecord [(Name, TypeExp vn)]
fs SrcLoc
_) = forall ann. Doc ann -> Doc ann
braces forall a b. (a -> b) -> a -> b
$ forall ann. [Doc ann] -> Doc ann
commasep forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {a} {ann}. Pretty a => (Name, a) -> Doc ann
ppField [(Name, TypeExp vn)]
fs
    where
      ppField :: (Name, a) -> Doc ann
ppField (Name
name, a
t) = forall a ann. Pretty a => a -> Doc ann
pretty (Name -> String
nameToString Name
name) forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
colon forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty a
t
  pretty (TEVar QualName vn
name SrcLoc
_) = forall a ann. Pretty a => a -> Doc ann
pretty QualName vn
name
  pretty (TEApply TypeExp vn
t TypeArgExp vn
arg SrcLoc
_) = forall a ann. Pretty a => a -> Doc ann
pretty TypeExp vn
t forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty TypeArgExp vn
arg
  pretty (TEArrow (Just vn
v) TypeExp vn
t1 TypeExp vn
t2 SrcLoc
_) = forall ann. Doc ann -> Doc ann
parens forall ann. Doc ann
v' forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"->" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty TypeExp vn
t2
    where
      v' :: Doc a
v' = forall v a. IsName v => v -> Doc a
prettyName vn
v forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
colon forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty TypeExp vn
t1
  pretty (TEArrow Maybe vn
Nothing TypeExp vn
t1 TypeExp vn
t2 SrcLoc
_) = forall a ann. Pretty a => a -> Doc ann
pretty TypeExp vn
t1 forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"->" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty TypeExp vn
t2
  pretty (TESum [(Name, [TypeExp vn])]
cs SrcLoc
_) =
    forall ann. Doc ann -> Doc ann
align forall a b. (a -> b) -> a -> b
$ forall ann. [Doc ann] -> Doc ann
cat forall a b. (a -> b) -> a -> b
$ forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate (Doc ann
" |" forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
softline) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {a} {a} {ann}. (Pretty a, Pretty a) => (a, [a]) -> Doc ann
ppConstr [(Name, [TypeExp vn])]
cs
    where
      ppConstr :: (a, [a]) -> Doc ann
ppConstr (a
name, [a]
fs) = Doc ann
"#" forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty a
name forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. [Doc ann] -> Doc ann
sep (forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty [a]
fs)
  pretty (TEDim [vn]
dims TypeExp vn
te SrcLoc
_) =
    Doc ann
"?" forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map (forall ann. Doc ann -> Doc ann
brackets forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v a. IsName v => v -> Doc a
prettyName) [vn]
dims) forall a. Semigroup a => a -> a -> a
<> Doc ann
"." forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty TypeExp vn
te

instance (Eq vn, IsName vn) => Pretty (TypeArgExp vn) where
  pretty :: forall ann. TypeArgExp vn -> Doc ann
pretty (TypeArgExpDim SizeExp vn
d SrcLoc
_) = forall ann. Doc ann -> Doc ann
brackets forall a b. (a -> b) -> a -> b
$ forall a ann. Pretty a => a -> Doc ann
pretty SizeExp vn
d
  pretty (TypeArgExpType TypeExp vn
t) = forall a ann. Pretty a => a -> Doc ann
pretty TypeExp vn
t

instance IsName vn => Pretty (QualName vn) where
  pretty :: forall ann. QualName vn -> Doc ann
pretty (QualName [vn]
names vn
name) =
    forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
"." forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall v a. IsName v => v -> Doc a
prettyName [vn]
names forall a. [a] -> [a] -> [a]
++ [forall v a. IsName v => v -> Doc a
prettyName vn
name]

instance IsName vn => Pretty (IdentBase f vn) where
  pretty :: forall ann. IdentBase f vn -> Doc ann
pretty = forall v a. IsName v => v -> Doc a
prettyName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) vn. IdentBase f vn -> vn
identName

hasArrayLit :: ExpBase ty vn -> Bool
hasArrayLit :: forall (ty :: * -> *) vn. ExpBase ty vn -> Bool
hasArrayLit ArrayLit {} = Bool
True
hasArrayLit (TupLit [ExpBase ty vn]
es2 SrcLoc
_) = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any forall (ty :: * -> *) vn. ExpBase ty vn -> Bool
hasArrayLit [ExpBase ty vn]
es2
hasArrayLit ExpBase ty vn
_ = Bool
False

instance (Eq vn, IsName vn, Annot f) => Pretty (DimIndexBase f vn) where
  pretty :: forall ann. DimIndexBase f vn -> Doc ann
pretty (DimFix ExpBase f vn
e) = forall a ann. Pretty a => a -> Doc ann
pretty ExpBase f vn
e
  pretty (DimSlice Maybe (ExpBase f vn)
i Maybe (ExpBase f vn)
j (Just ExpBase f vn
s)) =
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty forall a ann. Pretty a => a -> Doc ann
pretty Maybe (ExpBase f vn)
i
      forall a. Semigroup a => a -> a -> a
<> Doc ann
":"
      forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty forall a ann. Pretty a => a -> Doc ann
pretty Maybe (ExpBase f vn)
j
      forall a. Semigroup a => a -> a -> a
<> Doc ann
":"
      forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty ExpBase f vn
s
  pretty (DimSlice Maybe (ExpBase f vn)
i (Just ExpBase f vn
j) Maybe (ExpBase f vn)
s) =
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty forall a ann. Pretty a => a -> Doc ann
pretty Maybe (ExpBase f vn)
i
      forall a. Semigroup a => a -> a -> a
<> Doc ann
":"
      forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty ExpBase f vn
j
      forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty ((Doc ann
":" <>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. Pretty a => a -> Doc ann
pretty) Maybe (ExpBase f vn)
s
  pretty (DimSlice Maybe (ExpBase f vn)
i Maybe (ExpBase f vn)
Nothing Maybe (ExpBase f vn)
Nothing) =
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty forall a ann. Pretty a => a -> Doc ann
pretty Maybe (ExpBase f vn)
i forall a. Semigroup a => a -> a -> a
<> Doc ann
":"

instance IsName vn => Pretty (SizeBinder vn) where
  pretty :: forall ann. SizeBinder vn -> Doc ann
pretty (SizeBinder vn
v SrcLoc
_) = forall ann. Doc ann -> Doc ann
brackets forall a b. (a -> b) -> a -> b
$ forall v a. IsName v => v -> Doc a
prettyName vn
v

letBody :: (Eq vn, IsName vn, Annot f) => ExpBase f vn -> Doc a
letBody :: forall vn (f :: * -> *) a.
(Eq vn, IsName vn, Annot f) =>
ExpBase f vn -> Doc a
letBody body :: ExpBase f vn
body@(AppExp LetPat {} f AppRes
_) = forall a ann. Pretty a => a -> Doc ann
pretty ExpBase f vn
body
letBody body :: ExpBase f vn
body@(AppExp LetFun {} f AppRes
_) = forall a ann. Pretty a => a -> Doc ann
pretty ExpBase f vn
body
letBody ExpBase f vn
body = Doc a
"in" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
align (forall a ann. Pretty a => a -> Doc ann
pretty ExpBase f vn
body)

prettyAppExp :: (Eq vn, IsName vn, Annot f) => Int -> AppExpBase f vn -> Doc a
prettyAppExp :: forall vn (f :: * -> *) a.
(Eq vn, IsName vn, Annot f) =>
Int -> AppExpBase f vn -> Doc a
prettyAppExp Int
p (Coerce ExpBase f vn
e TypeExp vn
t SrcLoc
_) =
  forall a. Bool -> Doc a -> Doc a
parensIf (Int
p forall a. Eq a => a -> a -> Bool
/= -Int
1) forall a b. (a -> b) -> a -> b
$ forall vn (f :: * -> *) a.
(Eq vn, IsName vn, Annot f) =>
Int -> ExpBase f vn -> Doc a
prettyExp Int
0 ExpBase f vn
e forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc a
":>" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
align (forall a ann. Pretty a => a -> Doc ann
pretty TypeExp vn
t)
prettyAppExp Int
p (BinOp (QualName vn
bop, SrcLoc
_) f PatType
_ (ExpBase f vn
x, f (StructType, Maybe VName)
_) (ExpBase f vn
y, f (StructType, Maybe VName)
_) SrcLoc
_) = forall vn (f :: * -> *) a.
(Eq vn, IsName vn, Annot f) =>
Int -> QualName vn -> ExpBase f vn -> ExpBase f vn -> Doc a
prettyBinOp Int
p QualName vn
bop ExpBase f vn
x ExpBase f vn
y
prettyAppExp Int
_ (Match ExpBase f vn
e NonEmpty (CaseBase f vn)
cs SrcLoc
_) = Doc a
"match" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty ExpBase f vn
e forall ann. Doc ann -> Doc ann -> Doc ann
</> (forall ann. [Doc ann] -> Doc ann
stack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty) (forall a. NonEmpty a -> [a]
NE.toList NonEmpty (CaseBase f vn)
cs)
prettyAppExp Int
_ (DoLoop [VName]
sizeparams PatBase f vn
pat ExpBase f vn
initexp LoopFormBase f vn
form ExpBase f vn
loopbody SrcLoc
_) =
  Doc a
"loop"
    forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
align
      ( forall ann. [Doc ann] -> Doc ann
hsep (forall a b. (a -> b) -> [a] -> [b]
map (forall ann. Doc ann -> Doc ann
brackets forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v a. IsName v => v -> Doc a
prettyName) [VName]
sizeparams forall a. [a] -> [a] -> [a]
++ [forall a ann. Pretty a => a -> Doc ann
pretty PatBase f vn
pat])
          forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann
equals
          forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty ExpBase f vn
initexp
          forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty LoopFormBase f vn
form
          forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc a
"do"
      )
    forall ann. Doc ann -> Doc ann -> Doc ann
</> forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (forall a ann. Pretty a => a -> Doc ann
pretty ExpBase f vn
loopbody)
prettyAppExp Int
_ (Index ExpBase f vn
e SliceBase f vn
idxs SrcLoc
_) =
  forall vn (f :: * -> *) a.
(Eq vn, IsName vn, Annot f) =>
Int -> ExpBase f vn -> Doc a
prettyExp Int
9 ExpBase f vn
e forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann -> Doc ann
brackets (forall ann. [Doc ann] -> Doc ann
commasep (forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty SliceBase f vn
idxs))
prettyAppExp Int
p (LetPat [SizeBinder vn]
sizes PatBase f vn
pat ExpBase f vn
e ExpBase f vn
body SrcLoc
_) =
  forall a. Bool -> Doc a -> Doc a
parensIf (Int
p forall a. Eq a => a -> a -> Bool
/= -Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ann. Doc ann -> Doc ann
align forall a b. (a -> b) -> a -> b
$
    forall ann. [Doc ann] -> Doc ann
hsep (Doc a
"let" forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty [SizeBinder vn]
sizes forall a. [a] -> [a] -> [a]
++ [forall ann. Doc ann -> Doc ann
align (forall a ann. Pretty a => a -> Doc ann
pretty PatBase f vn
pat)])
      forall ann. Doc ann -> Doc ann -> Doc ann
<+> ( if Bool
linebreak
              then forall ann. Doc ann
equals forall ann. Doc ann -> Doc ann -> Doc ann
</> forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (forall a ann. Pretty a => a -> Doc ann
pretty ExpBase f vn
e)
              else forall ann. Doc ann
equals forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
align (forall a ann. Pretty a => a -> Doc ann
pretty ExpBase f vn
e)
          )
      forall ann. Doc ann -> Doc ann -> Doc ann
</> forall vn (f :: * -> *) a.
(Eq vn, IsName vn, Annot f) =>
ExpBase f vn -> Doc a
letBody ExpBase f vn
body
  where
    linebreak :: Bool
linebreak = case ExpBase f vn
e of
      AppExp {} -> Bool
True
      Attr {} -> Bool
True
      ArrayLit {} -> Bool
False
      ExpBase f vn
_ -> forall (ty :: * -> *) vn. ExpBase ty vn -> Bool
hasArrayLit ExpBase f vn
e
prettyAppExp Int
_ (LetFun vn
fname ([TypeParamBase vn]
tparams, [PatBase f vn]
params, Maybe (TypeExp vn)
retdecl, f StructRetType
rettype, ExpBase f vn
e) ExpBase f vn
body SrcLoc
_) =
  Doc a
"let"
    forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. [Doc ann] -> Doc ann
hsep (forall v a. IsName v => v -> Doc a
prettyName vn
fname forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty [TypeParamBase vn]
tparams forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty [PatBase f vn]
params)
      forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
retdecl'
    forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann
equals
    forall ann. Doc ann -> Doc ann -> Doc ann
</> forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (forall a ann. Pretty a => a -> Doc ann
pretty ExpBase f vn
e)
    forall ann. Doc ann -> Doc ann -> Doc ann
</> forall vn (f :: * -> *) a.
(Eq vn, IsName vn, Annot f) =>
ExpBase f vn -> Doc a
letBody ExpBase f vn
body
  where
    retdecl' :: Doc ann
retdecl' = case (forall a ann. Pretty a => a -> Doc ann
pretty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Annot f => f a -> Maybe a
unAnnot f StructRetType
rettype) forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` (forall a ann. Pretty a => a -> Doc ann
pretty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (TypeExp vn)
retdecl) of
      Just Doc ann
rettype' -> forall ann. Doc ann
colon forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
align Doc ann
rettype'
      Maybe (Doc ann)
Nothing -> forall a. Monoid a => a
mempty
prettyAppExp Int
_ (LetWith IdentBase f vn
dest IdentBase f vn
src SliceBase f vn
idxs ExpBase f vn
ve ExpBase f vn
body SrcLoc
_)
  | IdentBase f vn
dest forall a. Eq a => a -> a -> Bool
== IdentBase f vn
src =
      Doc a
"let"
        forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty IdentBase f vn
dest forall a. Semigroup a => a -> a -> a
<> forall ann. [Doc ann] -> Doc ann
list (forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty SliceBase f vn
idxs)
        forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann
equals
        forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
align (forall a ann. Pretty a => a -> Doc ann
pretty ExpBase f vn
ve)
        forall ann. Doc ann -> Doc ann -> Doc ann
</> forall vn (f :: * -> *) a.
(Eq vn, IsName vn, Annot f) =>
ExpBase f vn -> Doc a
letBody ExpBase f vn
body
  | Bool
otherwise =
      Doc a
"let"
        forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty IdentBase f vn
dest
        forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann
equals
        forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty IdentBase f vn
src
        forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc a
"with"
        forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
brackets (forall ann. [Doc ann] -> Doc ann
commasep (forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty SliceBase f vn
idxs))
        forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc a
"="
        forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
align (forall a ann. Pretty a => a -> Doc ann
pretty ExpBase f vn
ve)
        forall ann. Doc ann -> Doc ann -> Doc ann
</> forall vn (f :: * -> *) a.
(Eq vn, IsName vn, Annot f) =>
ExpBase f vn -> Doc a
letBody ExpBase f vn
body
prettyAppExp Int
p (Range ExpBase f vn
start Maybe (ExpBase f vn)
maybe_step Inclusiveness (ExpBase f vn)
end SrcLoc
_) =
  forall a. Bool -> Doc a -> Doc a
parensIf (Int
p forall a. Eq a => a -> a -> Bool
/= -Int
1) forall a b. (a -> b) -> a -> b
$
    forall a ann. Pretty a => a -> Doc ann
pretty ExpBase f vn
start
      forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty ((Doc a
".." <>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. Pretty a => a -> Doc ann
pretty) Maybe (ExpBase f vn)
maybe_step
      forall a. Semigroup a => a -> a -> a
<> case Inclusiveness (ExpBase f vn)
end of
        DownToExclusive ExpBase f vn
end' -> Doc a
"..>" forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty ExpBase f vn
end'
        ToInclusive ExpBase f vn
end' -> Doc a
"..." forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty ExpBase f vn
end'
        UpToExclusive ExpBase f vn
end' -> Doc a
"..<" forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty ExpBase f vn
end'
prettyAppExp Int
_ (If ExpBase f vn
c ExpBase f vn
t ExpBase f vn
f SrcLoc
_) =
  Doc a
"if"
    forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty ExpBase f vn
c
    forall ann. Doc ann -> Doc ann -> Doc ann
</> Doc a
"then"
    forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
align (forall a ann. Pretty a => a -> Doc ann
pretty ExpBase f vn
t)
    forall ann. Doc ann -> Doc ann -> Doc ann
</> Doc a
"else"
    forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
align (forall a ann. Pretty a => a -> Doc ann
pretty ExpBase f vn
f)
prettyAppExp Int
p (Apply ExpBase f vn
f ExpBase f vn
arg f (Diet, Maybe VName)
_ SrcLoc
_) =
  forall a. Bool -> Doc a -> Doc a
parensIf (Int
p forall a. Ord a => a -> a -> Bool
>= Int
10) forall a b. (a -> b) -> a -> b
$ forall vn (f :: * -> *) a.
(Eq vn, IsName vn, Annot f) =>
Int -> ExpBase f vn -> Doc a
prettyExp Int
0 ExpBase f vn
f forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall vn (f :: * -> *) a.
(Eq vn, IsName vn, Annot f) =>
Int -> ExpBase f vn -> Doc a
prettyExp Int
10 ExpBase f vn
arg

instance (Eq vn, IsName vn, Annot f) => Pretty (AppExpBase f vn) where
  pretty :: forall ann. AppExpBase f vn -> Doc ann
pretty = forall vn (f :: * -> *) a.
(Eq vn, IsName vn, Annot f) =>
Int -> AppExpBase f vn -> Doc a
prettyAppExp (-Int
1)

prettyInst :: Annot f => f PatType -> Doc a
prettyInst :: forall (f :: * -> *) a. Annot f => f PatType -> Doc a
prettyInst f PatType
t =
  case forall (f :: * -> *) a. Annot f => f a -> Maybe a
unAnnot f PatType
t of
    Just PatType
t'
      | String -> Int -> Bool
isEnvVarAtLeast String
"FUTHARK_COMPILER_DEBUGGING" Int
2 ->
          Doc a
"@" forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann -> Doc ann
parens (forall ann. Doc ann -> Doc ann
align forall a b. (a -> b) -> a -> b
$ forall a ann. Pretty a => a -> Doc ann
pretty PatType
t')
    Maybe PatType
_ -> forall a. Monoid a => a
mempty

prettyAttr :: Pretty a => a -> Doc ann
prettyAttr :: forall a ann. Pretty a => a -> Doc ann
prettyAttr a
attr = Doc ann
"#[" forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty a
attr forall a. Semigroup a => a -> a -> a
<> Doc ann
"]"

prettyExp :: (Eq vn, IsName vn, Annot f) => Int -> ExpBase f vn -> Doc a
prettyExp :: forall vn (f :: * -> *) a.
(Eq vn, IsName vn, Annot f) =>
Int -> ExpBase f vn -> Doc a
prettyExp Int
_ (Var QualName vn
name f PatType
t SrcLoc
_) = forall a ann. Pretty a => a -> Doc ann
pretty QualName vn
name forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. Annot f => f PatType -> Doc a
prettyInst f PatType
t
prettyExp Int
_ (Hole f PatType
t SrcLoc
_) = Doc a
"???" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. Annot f => f PatType -> Doc a
prettyInst f PatType
t
prettyExp Int
_ (Parens ExpBase f vn
e SrcLoc
_) = forall ann. Doc ann -> Doc ann
align forall a b. (a -> b) -> a -> b
$ forall ann. Doc ann -> Doc ann
parens forall a b. (a -> b) -> a -> b
$ forall a ann. Pretty a => a -> Doc ann
pretty ExpBase f vn
e
prettyExp Int
_ (QualParens (QualName vn
v, SrcLoc
_) ExpBase f vn
e SrcLoc
_) = forall a ann. Pretty a => a -> Doc ann
pretty QualName vn
v forall a. Semigroup a => a -> a -> a
<> Doc a
"." forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann -> Doc ann
align (forall ann. Doc ann -> Doc ann
parens forall a b. (a -> b) -> a -> b
$ forall a ann. Pretty a => a -> Doc ann
pretty ExpBase f vn
e)
prettyExp Int
p (Ascript ExpBase f vn
e TypeExp vn
t SrcLoc
_) =
  forall a. Bool -> Doc a -> Doc a
parensIf (Int
p forall a. Eq a => a -> a -> Bool
/= -Int
1) forall a b. (a -> b) -> a -> b
$ forall vn (f :: * -> *) a.
(Eq vn, IsName vn, Annot f) =>
Int -> ExpBase f vn -> Doc a
prettyExp Int
0 ExpBase f vn
e forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc a
":" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
align (forall a ann. Pretty a => a -> Doc ann
pretty TypeExp vn
t)
prettyExp Int
_ (Literal PrimValue
v SrcLoc
_) = forall a ann. Pretty a => a -> Doc ann
pretty PrimValue
v
prettyExp Int
_ (IntLit Integer
v f PatType
t SrcLoc
_) = forall a ann. Pretty a => a -> Doc ann
pretty Integer
v forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. Annot f => f PatType -> Doc a
prettyInst f PatType
t
prettyExp Int
_ (FloatLit Double
v f PatType
t SrcLoc
_) = forall a ann. Pretty a => a -> Doc ann
pretty Double
v forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. Annot f => f PatType -> Doc a
prettyInst f PatType
t
prettyExp Int
_ (TupLit [ExpBase f vn]
es SrcLoc
_)
  | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any forall (ty :: * -> *) vn. ExpBase ty vn -> Bool
hasArrayLit [ExpBase f vn]
es = forall ann. Doc ann -> Doc ann
parens forall a b. (a -> b) -> a -> b
$ forall ann. [Doc ann] -> Doc ann
commastack forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty [ExpBase f vn]
es
  | Bool
otherwise = forall ann. Doc ann -> Doc ann
parens forall a b. (a -> b) -> a -> b
$ forall ann. [Doc ann] -> Doc ann
commasep forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty [ExpBase f vn]
es
prettyExp Int
_ (RecordLit [FieldBase f vn]
fs SrcLoc
_)
  | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any forall {ty :: * -> *} {vn}. FieldBase ty vn -> Bool
fieldArray [FieldBase f vn]
fs = forall ann. Doc ann -> Doc ann
braces forall a b. (a -> b) -> a -> b
$ forall ann. [Doc ann] -> Doc ann
commastack forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty [FieldBase f vn]
fs
  | Bool
otherwise = forall ann. Doc ann -> Doc ann
braces forall a b. (a -> b) -> a -> b
$ forall ann. [Doc ann] -> Doc ann
commasep forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty [FieldBase f vn]
fs
  where
    fieldArray :: FieldBase ty vn -> Bool
fieldArray (RecordFieldExplicit Name
_ ExpBase ty vn
e SrcLoc
_) = forall (ty :: * -> *) vn. ExpBase ty vn -> Bool
hasArrayLit ExpBase ty vn
e
    fieldArray RecordFieldImplicit {} = Bool
False
prettyExp Int
_ (ArrayLit [ExpBase f vn]
es f PatType
t SrcLoc
_) =
  forall ann. Doc ann -> Doc ann
brackets (forall ann. [Doc ann] -> Doc ann
commasep forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty [ExpBase f vn]
es) forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. Annot f => f PatType -> Doc a
prettyInst f PatType
t
prettyExp Int
_ (StringLit [Word8]
s SrcLoc
_) =
  forall a ann. Pretty a => a -> Doc ann
pretty forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Int -> Char
chr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) [Word8]
s
prettyExp Int
_ (Project Name
k ExpBase f vn
e f PatType
_ SrcLoc
_) = forall a ann. Pretty a => a -> Doc ann
pretty ExpBase f vn
e forall a. Semigroup a => a -> a -> a
<> Doc a
"." forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty Name
k
prettyExp Int
_ (Negate ExpBase f vn
e SrcLoc
_) = Doc a
"-" forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty ExpBase f vn
e
prettyExp Int
_ (Not ExpBase f vn
e SrcLoc
_) = Doc a
"-" forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty ExpBase f vn
e
prettyExp Int
_ (Update ExpBase f vn
src SliceBase f vn
idxs ExpBase f vn
ve SrcLoc
_) =
  forall a ann. Pretty a => a -> Doc ann
pretty ExpBase f vn
src
    forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc a
"with"
    forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
brackets (forall ann. [Doc ann] -> Doc ann
commasep (forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty SliceBase f vn
idxs))
    forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc a
"="
    forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
align (forall a ann. Pretty a => a -> Doc ann
pretty ExpBase f vn
ve)
prettyExp Int
_ (RecordUpdate ExpBase f vn
src [Name]
fs ExpBase f vn
ve f PatType
_ SrcLoc
_) =
  forall a ann. Pretty a => a -> Doc ann
pretty ExpBase f vn
src
    forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc a
"with"
    forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a. Monoid a => [a] -> a
mconcat (forall a. a -> [a] -> [a]
intersperse Doc a
"." (forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty [Name]
fs))
    forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc a
"="
    forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
align (forall a ann. Pretty a => a -> Doc ann
pretty ExpBase f vn
ve)
prettyExp Int
_ (Assert ExpBase f vn
e1 ExpBase f vn
e2 f Text
_ SrcLoc
_) = Doc a
"assert" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall vn (f :: * -> *) a.
(Eq vn, IsName vn, Annot f) =>
Int -> ExpBase f vn -> Doc a
prettyExp Int
10 ExpBase f vn
e1 forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall vn (f :: * -> *) a.
(Eq vn, IsName vn, Annot f) =>
Int -> ExpBase f vn -> Doc a
prettyExp Int
10 ExpBase f vn
e2
prettyExp Int
p (Lambda [PatBase f vn]
params ExpBase f vn
body Maybe (TypeExp vn)
rettype f (Aliasing, StructRetType)
_ SrcLoc
_) =
  forall a. Bool -> Doc a -> Doc a
parensIf (Int
p forall a. Eq a => a -> a -> Bool
/= -Int
1) forall a b. (a -> b) -> a -> b
$
    Doc a
"\\" forall a. Semigroup a => a -> a -> a
<> forall ann. [Doc ann] -> Doc ann
hsep (forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty [PatBase f vn]
params) forall a. Semigroup a => a -> a -> a
<> forall t a. Pretty t => Maybe t -> Doc a
ppAscription Maybe (TypeExp vn)
rettype
      forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc a
"->"
      forall ann. Doc ann -> Doc ann -> Doc ann
</> forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (forall a ann. Pretty a => a -> Doc ann
pretty ExpBase f vn
body)
prettyExp Int
_ (OpSection QualName vn
binop f PatType
_ SrcLoc
_) =
  forall ann. Doc ann -> Doc ann
parens forall a b. (a -> b) -> a -> b
$ forall a ann. Pretty a => a -> Doc ann
pretty QualName vn
binop
prettyExp Int
_ (OpSectionLeft QualName vn
binop f PatType
_ ExpBase f vn
x (f (PName, StructType, Maybe VName), f (PName, StructType))
_ (f PatRetType, f [VName])
_ SrcLoc
_) =
  forall ann. Doc ann -> Doc ann
parens forall a b. (a -> b) -> a -> b
$ forall a ann. Pretty a => a -> Doc ann
pretty ExpBase f vn
x forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall v a. IsName v => QualName v -> Doc a
ppBinOp QualName vn
binop
prettyExp Int
_ (OpSectionRight QualName vn
binop f PatType
_ ExpBase f vn
x (f (PName, StructType), f (PName, StructType, Maybe VName))
_ f PatRetType
_ SrcLoc
_) =
  forall ann. Doc ann -> Doc ann
parens forall a b. (a -> b) -> a -> b
$ forall v a. IsName v => QualName v -> Doc a
ppBinOp QualName vn
binop forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty ExpBase f vn
x
prettyExp Int
_ (ProjectSection [Name]
fields f PatType
_ SrcLoc
_) =
  forall ann. Doc ann -> Doc ann
parens forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
p [Name]
fields
  where
    p :: a -> Doc ann
p a
name = Doc ann
"." forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty a
name
prettyExp Int
_ (IndexSection SliceBase f vn
idxs f PatType
_ SrcLoc
_) =
  forall ann. Doc ann -> Doc ann
parens forall a b. (a -> b) -> a -> b
$ Doc a
"." forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann -> Doc ann
brackets (forall ann. [Doc ann] -> Doc ann
commasep (forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty SliceBase f vn
idxs))
prettyExp Int
_ (Constr Name
n [ExpBase f vn]
cs f PatType
t SrcLoc
_) =
  Doc a
"#" forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty Name
n forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. [Doc ann] -> Doc ann
sep (forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty [ExpBase f vn]
cs) forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. Annot f => f PatType -> Doc a
prettyInst f PatType
t
prettyExp Int
_ (Attr AttrInfo vn
attr ExpBase f vn
e SrcLoc
_) =
  forall a ann. Pretty a => a -> Doc ann
prettyAttr AttrInfo vn
attr forall ann. Doc ann -> Doc ann -> Doc ann
</> forall vn (f :: * -> *) a.
(Eq vn, IsName vn, Annot f) =>
Int -> ExpBase f vn -> Doc a
prettyExp (-Int
1) ExpBase f vn
e
prettyExp Int
i (AppExp AppExpBase f vn
e f AppRes
_) = forall vn (f :: * -> *) a.
(Eq vn, IsName vn, Annot f) =>
Int -> AppExpBase f vn -> Doc a
prettyAppExp Int
i AppExpBase f vn
e

instance (Eq vn, IsName vn, Annot f) => Pretty (ExpBase f vn) where
  pretty :: forall ann. ExpBase f vn -> Doc ann
pretty = forall vn (f :: * -> *) a.
(Eq vn, IsName vn, Annot f) =>
Int -> ExpBase f vn -> Doc a
prettyExp (-Int
1)

instance IsName vn => Pretty (AttrAtom vn) where
  pretty :: forall ann. AttrAtom vn -> Doc ann
pretty (AtomName Name
v) = forall a ann. Pretty a => a -> Doc ann
pretty Name
v
  pretty (AtomInt Integer
x) = forall a ann. Pretty a => a -> Doc ann
pretty Integer
x

instance IsName vn => Pretty (AttrInfo vn) where
  pretty :: forall ann. AttrInfo vn -> Doc ann
pretty (AttrAtom AttrAtom vn
attr SrcLoc
_) = forall a ann. Pretty a => a -> Doc ann
pretty AttrAtom vn
attr
  pretty (AttrComp Name
f [AttrInfo vn]
attrs SrcLoc
_) = forall a ann. Pretty a => a -> Doc ann
pretty Name
f forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann -> Doc ann
parens (forall ann. [Doc ann] -> Doc ann
commasep forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty [AttrInfo vn]
attrs)

instance (Eq vn, IsName vn, Annot f) => Pretty (FieldBase f vn) where
  pretty :: forall ann. FieldBase f vn -> Doc ann
pretty (RecordFieldExplicit Name
name ExpBase f vn
e SrcLoc
_) = forall a ann. Pretty a => a -> Doc ann
pretty Name
name forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
equals forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty ExpBase f vn
e
  pretty (RecordFieldImplicit vn
name f PatType
_ SrcLoc
_) = forall v a. IsName v => v -> Doc a
prettyName vn
name

instance (Eq vn, IsName vn, Annot f) => Pretty (CaseBase f vn) where
  pretty :: forall ann. CaseBase f vn -> Doc ann
pretty (CasePat PatBase f vn
p ExpBase f vn
e SrcLoc
_) = Doc ann
"case" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty PatBase f vn
p forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"->" forall ann. Doc ann -> Doc ann -> Doc ann
</> forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (forall a ann. Pretty a => a -> Doc ann
pretty ExpBase f vn
e)

instance (Eq vn, IsName vn, Annot f) => Pretty (LoopFormBase f vn) where
  pretty :: forall ann. LoopFormBase f vn -> Doc ann
pretty (For IdentBase f vn
i ExpBase f vn
ubound) =
    Doc ann
"for" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty IdentBase f vn
i forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"<" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
align (forall a ann. Pretty a => a -> Doc ann
pretty ExpBase f vn
ubound)
  pretty (ForIn PatBase f vn
x ExpBase f vn
e) =
    Doc ann
"for" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty PatBase f vn
x forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"in" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty ExpBase f vn
e
  pretty (While ExpBase f vn
cond) =
    Doc ann
"while" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty ExpBase f vn
cond

instance Pretty PatLit where
  pretty :: forall ann. PatLit -> Doc ann
pretty (PatLitInt Integer
x) = forall a ann. Pretty a => a -> Doc ann
pretty Integer
x
  pretty (PatLitFloat Double
f) = forall a ann. Pretty a => a -> Doc ann
pretty Double
f
  pretty (PatLitPrim PrimValue
v) = forall a ann. Pretty a => a -> Doc ann
pretty PrimValue
v

instance (Eq vn, IsName vn, Annot f) => Pretty (PatBase f vn) where
  pretty :: forall ann. PatBase f vn -> Doc ann
pretty (PatAscription PatBase f vn
p TypeExp vn
t SrcLoc
_) = forall a ann. Pretty a => a -> Doc ann
pretty PatBase f vn
p forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
colon forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
align (forall a ann. Pretty a => a -> Doc ann
pretty TypeExp vn
t)
  pretty (PatParens PatBase f vn
p SrcLoc
_) = forall ann. Doc ann -> Doc ann
parens forall a b. (a -> b) -> a -> b
$ forall a ann. Pretty a => a -> Doc ann
pretty PatBase f vn
p
  pretty (Id vn
v f PatType
t SrcLoc
_) = case forall (f :: * -> *) a. Annot f => f a -> Maybe a
unAnnot f PatType
t of
    Just PatType
t' -> forall ann. Doc ann -> Doc ann
parens forall a b. (a -> b) -> a -> b
$ forall v a. IsName v => v -> Doc a
prettyName vn
v forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
colon forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
align (forall a ann. Pretty a => a -> Doc ann
pretty PatType
t')
    Maybe PatType
Nothing -> forall v a. IsName v => v -> Doc a
prettyName vn
v
  pretty (TuplePat [PatBase f vn]
pats SrcLoc
_) = forall ann. Doc ann -> Doc ann
parens forall a b. (a -> b) -> a -> b
$ forall ann. [Doc ann] -> Doc ann
commasep forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty [PatBase f vn]
pats
  pretty (RecordPat [(Name, PatBase f vn)]
fs SrcLoc
_) = forall ann. Doc ann -> Doc ann
braces forall a b. (a -> b) -> a -> b
$ forall ann. [Doc ann] -> Doc ann
commasep forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {a} {ann}. Pretty a => (Name, a) -> Doc ann
ppField [(Name, PatBase f vn)]
fs
    where
      ppField :: (Name, a) -> Doc ann
ppField (Name
name, a
t) = forall a ann. Pretty a => a -> Doc ann
pretty (Name -> String
nameToString Name
name) forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
equals forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty a
t
  pretty (Wildcard f PatType
t SrcLoc
_) = case forall (f :: * -> *) a. Annot f => f a -> Maybe a
unAnnot f PatType
t of
    Just PatType
t' -> forall ann. Doc ann -> Doc ann
parens forall a b. (a -> b) -> a -> b
$ Doc ann
"_" forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
colon forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty PatType
t'
    Maybe PatType
Nothing -> Doc ann
"_"
  pretty (PatLit PatLit
e f PatType
_ SrcLoc
_) = forall a ann. Pretty a => a -> Doc ann
pretty PatLit
e
  pretty (PatConstr Name
n f PatType
_ [PatBase f vn]
ps SrcLoc
_) = Doc ann
"#" forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty Name
n forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. [Doc ann] -> Doc ann
sep (forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty [PatBase f vn]
ps)
  pretty (PatAttr AttrInfo vn
attr PatBase f vn
p SrcLoc
_) = Doc ann
"#[" forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty AttrInfo vn
attr forall a. Semigroup a => a -> a -> a
<> Doc ann
"]" forall ann. Doc ann -> Doc ann -> Doc ann
</> forall a ann. Pretty a => a -> Doc ann
pretty PatBase f vn
p

ppAscription :: Pretty t => Maybe t -> Doc a
ppAscription :: forall t a. Pretty t => Maybe t -> Doc a
ppAscription Maybe t
Nothing = forall a. Monoid a => a
mempty
ppAscription (Just t
t) = forall ann. Doc ann
colon forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann -> Doc ann
align (forall a ann. Pretty a => a -> Doc ann
pretty t
t)

instance (Eq vn, IsName vn, Annot f) => Pretty (ProgBase f vn) where
  pretty :: forall ann. ProgBase f vn -> Doc ann
pretty = forall ann. [Doc ann] -> Doc ann
stack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate forall ann. Doc ann
line forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) vn. ProgBase f vn -> [DecBase f vn]
progDecs

instance (Eq vn, IsName vn, Annot f) => Pretty (DecBase f vn) where
  pretty :: forall ann. DecBase f vn -> Doc ann
pretty (ValDec ValBindBase f vn
dec) = forall a ann. Pretty a => a -> Doc ann
pretty ValBindBase f vn
dec
  pretty (TypeDec TypeBindBase f vn
dec) = forall a ann. Pretty a => a -> Doc ann
pretty TypeBindBase f vn
dec
  pretty (SigDec SigBindBase f vn
sig) = forall a ann. Pretty a => a -> Doc ann
pretty SigBindBase f vn
sig
  pretty (ModDec ModBindBase f vn
sd) = forall a ann. Pretty a => a -> Doc ann
pretty ModBindBase f vn
sd
  pretty (OpenDec ModExpBase f vn
x SrcLoc
_) = Doc ann
"open" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty ModExpBase f vn
x
  pretty (LocalDec DecBase f vn
dec SrcLoc
_) = Doc ann
"local" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty DecBase f vn
dec
  pretty (ImportDec String
x f String
_ SrcLoc
_) = Doc ann
"import" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty String
x

instance (Eq vn, IsName vn, Annot f) => Pretty (ModExpBase f vn) where
  pretty :: forall ann. ModExpBase f vn -> Doc ann
pretty (ModVar QualName vn
v SrcLoc
_) = forall a ann. Pretty a => a -> Doc ann
pretty QualName vn
v
  pretty (ModParens ModExpBase f vn
e SrcLoc
_) = forall ann. Doc ann -> Doc ann
parens forall a b. (a -> b) -> a -> b
$ forall a ann. Pretty a => a -> Doc ann
pretty ModExpBase f vn
e
  pretty (ModImport String
v f String
_ SrcLoc
_) = Doc ann
"import" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty (forall a. Show a => a -> String
show String
v)
  pretty (ModDecs [DecBase f vn]
ds SrcLoc
_) = forall a. Doc a -> Doc a -> Doc a -> Doc a
nestedBlock Doc ann
"{" Doc ann
"}" (forall ann. [Doc ann] -> Doc ann
stack forall a b. (a -> b) -> a -> b
$ forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate forall ann. Doc ann
line forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty [DecBase f vn]
ds)
  pretty (ModApply ModExpBase f vn
f ModExpBase f vn
a f (Map VName VName)
_ f (Map VName VName)
_ SrcLoc
_) = forall ann. Doc ann -> Doc ann
parens forall a b. (a -> b) -> a -> b
$ forall a ann. Pretty a => a -> Doc ann
pretty ModExpBase f vn
f forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
parens (forall a ann. Pretty a => a -> Doc ann
pretty ModExpBase f vn
a)
  pretty (ModAscript ModExpBase f vn
me SigExpBase f vn
se f (Map VName VName)
_ SrcLoc
_) = forall a ann. Pretty a => a -> Doc ann
pretty ModExpBase f vn
me forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
colon forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty SigExpBase f vn
se
  pretty (ModLambda ModParamBase f vn
param Maybe (SigExpBase f vn, f (Map VName VName))
maybe_sig ModExpBase f vn
body SrcLoc
_) =
    Doc ann
"\\" forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty ModParamBase f vn
param forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
maybe_sig'
      forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"->"
      forall ann. Doc ann -> Doc ann -> Doc ann
</> forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (forall a ann. Pretty a => a -> Doc ann
pretty ModExpBase f vn
body)
    where
      maybe_sig' :: Doc ann
maybe_sig' = case Maybe (SigExpBase f vn, f (Map VName VName))
maybe_sig of
        Maybe (SigExpBase f vn, f (Map VName VName))
Nothing -> forall a. Monoid a => a
mempty
        Just (SigExpBase f vn
sig, f (Map VName VName)
_) -> forall ann. Doc ann
colon forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty SigExpBase f vn
sig

instance Pretty Liftedness where
  pretty :: forall ann. Liftedness -> Doc ann
pretty Liftedness
Unlifted = Doc ann
""
  pretty Liftedness
SizeLifted = Doc ann
"~"
  pretty Liftedness
Lifted = Doc ann
"^"

instance (Eq vn, IsName vn, Annot f) => Pretty (TypeBindBase f vn) where
  pretty :: forall ann. TypeBindBase f vn -> Doc ann
pretty (TypeBind vn
name Liftedness
l [TypeParamBase vn]
params TypeExp vn
te f StructRetType
rt Maybe DocComment
_ SrcLoc
_) =
    Doc ann
"type" forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty Liftedness
l
      forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. [Doc ann] -> Doc ann
hsep (forall v a. IsName v => v -> Doc a
prettyName vn
name forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty [TypeParamBase vn]
params)
      forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann
equals
      forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a ann. Pretty a => a -> Doc ann
pretty TypeExp vn
te) forall a ann. Pretty a => a -> Doc ann
pretty (forall (f :: * -> *) a. Annot f => f a -> Maybe a
unAnnot f StructRetType
rt)

instance (Eq vn, IsName vn) => Pretty (TypeParamBase vn) where
  pretty :: forall ann. TypeParamBase vn -> Doc ann
pretty (TypeParamDim vn
name SrcLoc
_) = forall ann. Doc ann -> Doc ann
brackets forall a b. (a -> b) -> a -> b
$ forall v a. IsName v => v -> Doc a
prettyName vn
name
  pretty (TypeParamType Liftedness
l vn
name SrcLoc
_) = Doc ann
"'" forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty Liftedness
l forall a. Semigroup a => a -> a -> a
<> forall v a. IsName v => v -> Doc a
prettyName vn
name

instance (Eq vn, IsName vn, Annot f) => Pretty (ValBindBase f vn) where
  pretty :: forall ann. ValBindBase f vn -> Doc ann
pretty (ValBind Maybe (f EntryPoint)
entry vn
name Maybe (TypeExp vn)
retdecl f StructRetType
rettype [TypeParamBase vn]
tparams [PatBase f vn]
args ExpBase f vn
body Maybe DocComment
_ [AttrInfo vn]
attrs SrcLoc
_) =
    forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map ((forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
line) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. Pretty a => a -> Doc ann
prettyAttr) [AttrInfo vn]
attrs)
      forall a. Semigroup a => a -> a -> a
<> Doc ann
fun
      forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
align
        ( forall ann. [Doc ann] -> Doc ann
sep
            ( forall v a. IsName v => v -> Doc a
prettyName vn
name
                forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty [TypeParamBase vn]
tparams
                forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty [PatBase f vn]
args
                forall a. [a] -> [a] -> [a]
++ forall {ann}. [Doc ann]
retdecl'
                forall a. [a] -> [a] -> [a]
++ [Doc ann
"="]
            )
        )
      forall ann. Doc ann -> Doc ann -> Doc ann
</> forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (forall a ann. Pretty a => a -> Doc ann
pretty ExpBase f vn
body)
    where
      fun :: Doc ann
fun
        | forall a. Maybe a -> Bool
isJust Maybe (f EntryPoint)
entry = Doc ann
"entry"
        | Bool
otherwise = Doc ann
"def"
      retdecl' :: [Doc ann]
retdecl' = case (forall a ann. Pretty a => a -> Doc ann
pretty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Annot f => f a -> Maybe a
unAnnot f StructRetType
rettype) forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` (forall a ann. Pretty a => a -> Doc ann
pretty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (TypeExp vn)
retdecl) of
        Just Doc ann
rettype' -> [forall ann. Doc ann
colon forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
align Doc ann
rettype']
        Maybe (Doc ann)
Nothing -> forall a. Monoid a => a
mempty

instance (Eq vn, IsName vn, Annot f) => Pretty (SpecBase f vn) where
  pretty :: forall ann. SpecBase f vn -> Doc ann
pretty (TypeAbbrSpec TypeBindBase f vn
tpsig) = forall a ann. Pretty a => a -> Doc ann
pretty TypeBindBase f vn
tpsig
  pretty (TypeSpec Liftedness
l vn
name [TypeParamBase vn]
ps Maybe DocComment
_ SrcLoc
_) =
    Doc ann
"type" forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty Liftedness
l forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. [Doc ann] -> Doc ann
hsep (forall v a. IsName v => v -> Doc a
prettyName vn
name forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty [TypeParamBase vn]
ps)
  pretty (ValSpec vn
name [TypeParamBase vn]
tparams TypeExp vn
vtype f StructType
_ Maybe DocComment
_ SrcLoc
_) =
    Doc ann
"val" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. [Doc ann] -> Doc ann
hsep (forall v a. IsName v => v -> Doc a
prettyName vn
name forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty [TypeParamBase vn]
tparams) forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
colon forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty TypeExp vn
vtype
  pretty (ModSpec vn
name SigExpBase f vn
sig Maybe DocComment
_ SrcLoc
_) =
    Doc ann
"module" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall v a. IsName v => v -> Doc a
prettyName vn
name forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
colon forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty SigExpBase f vn
sig
  pretty (IncludeSpec SigExpBase f vn
e SrcLoc
_) =
    Doc ann
"include" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty SigExpBase f vn
e

instance (Eq vn, IsName vn, Annot f) => Pretty (SigExpBase f vn) where
  pretty :: forall ann. SigExpBase f vn -> Doc ann
pretty (SigVar QualName vn
v f (Map VName VName)
_ SrcLoc
_) = forall a ann. Pretty a => a -> Doc ann
pretty QualName vn
v
  pretty (SigParens SigExpBase f vn
e SrcLoc
_) = forall ann. Doc ann -> Doc ann
parens forall a b. (a -> b) -> a -> b
$ forall a ann. Pretty a => a -> Doc ann
pretty SigExpBase f vn
e
  pretty (SigSpecs [SpecBase f vn]
ss SrcLoc
_) = forall a. Doc a -> Doc a -> Doc a -> Doc a
nestedBlock Doc ann
"{" Doc ann
"}" (forall ann. [Doc ann] -> Doc ann
stack forall a b. (a -> b) -> a -> b
$ forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate forall ann. Doc ann
line forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty [SpecBase f vn]
ss)
  pretty (SigWith SigExpBase f vn
s (TypeRef QualName vn
v [TypeParamBase vn]
ps TypeExp vn
td SrcLoc
_) SrcLoc
_) =
    forall a ann. Pretty a => a -> Doc ann
pretty SigExpBase f vn
s forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"with" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty QualName vn
v forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. [Doc ann] -> Doc ann
hsep (forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty [TypeParamBase vn]
ps) forall a. Semigroup a => a -> a -> a
<> Doc ann
" =" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty TypeExp vn
td
  pretty (SigArrow (Just vn
v) SigExpBase f vn
e1 SigExpBase f vn
e2 SrcLoc
_) =
    forall ann. Doc ann -> Doc ann
parens (forall v a. IsName v => v -> Doc a
prettyName vn
v forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
colon forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty SigExpBase f vn
e1) forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"->" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty SigExpBase f vn
e2
  pretty (SigArrow Maybe vn
Nothing SigExpBase f vn
e1 SigExpBase f vn
e2 SrcLoc
_) =
    forall a ann. Pretty a => a -> Doc ann
pretty SigExpBase f vn
e1 forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"->" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty SigExpBase f vn
e2

instance (Eq vn, IsName vn, Annot f) => Pretty (SigBindBase f vn) where
  pretty :: forall ann. SigBindBase f vn -> Doc ann
pretty (SigBind vn
name SigExpBase f vn
e Maybe DocComment
_ SrcLoc
_) =
    Doc ann
"module type" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall v a. IsName v => v -> Doc a
prettyName vn
name forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann
equals forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty SigExpBase f vn
e

instance (Eq vn, IsName vn, Annot f) => Pretty (ModParamBase f vn) where
  pretty :: forall ann. ModParamBase f vn -> Doc ann
pretty (ModParam vn
pname SigExpBase f vn
psig f [VName]
_ SrcLoc
_) =
    forall ann. Doc ann -> Doc ann
parens (forall v a. IsName v => v -> Doc a
prettyName vn
pname forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
colon forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty SigExpBase f vn
psig)

instance (Eq vn, IsName vn, Annot f) => Pretty (ModBindBase f vn) where
  pretty :: forall ann. ModBindBase f vn -> Doc ann
pretty (ModBind vn
name [ModParamBase f vn]
ps Maybe (SigExpBase f vn, f (Map VName VName))
sig ModExpBase f vn
e Maybe DocComment
_ SrcLoc
_) =
    Doc ann
"module" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. [Doc ann] -> Doc ann
hsep (forall v a. IsName v => v -> Doc a
prettyName vn
name forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty [ModParamBase f vn]
ps) forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
sig' forall a. Semigroup a => a -> a -> a
<> Doc ann
" =" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty ModExpBase f vn
e
    where
      sig' :: Doc ann
sig' = case Maybe (SigExpBase f vn, f (Map VName VName))
sig of
        Maybe (SigExpBase f vn, f (Map VName VName))
Nothing -> forall a. Monoid a => a
mempty
        Just (SigExpBase f vn
s, f (Map VName VName)
_) -> Doc ann
" " forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
colon forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty SigExpBase f vn
s forall a. Semigroup a => a -> a -> a
<> Doc ann
" "

ppBinOp :: IsName v => QualName v -> Doc a
ppBinOp :: forall v a. IsName v => QualName v -> Doc a
ppBinOp QualName v
bop =
  case BinOp
leading of
    BinOp
Backtick -> Doc a
"`" forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty QualName v
bop forall a. Semigroup a => a -> a -> a
<> Doc a
"`"
    BinOp
_ -> forall a ann. Pretty a => a -> Doc ann
pretty QualName v
bop
  where
    leading :: BinOp
leading = Name -> BinOp
leadingOperator forall a b. (a -> b) -> a -> b
$ forall v. IsName v => v -> Name
toName forall a b. (a -> b) -> a -> b
$ forall vn. QualName vn -> vn
qualLeaf QualName v
bop

prettyBinOp ::
  (Eq vn, IsName vn, Annot f) =>
  Int ->
  QualName vn ->
  ExpBase f vn ->
  ExpBase f vn ->
  Doc a
prettyBinOp :: forall vn (f :: * -> *) a.
(Eq vn, IsName vn, Annot f) =>
Int -> QualName vn -> ExpBase f vn -> ExpBase f vn -> Doc a
prettyBinOp Int
p QualName vn
bop ExpBase f vn
x ExpBase f vn
y =
  forall a. Bool -> Doc a -> Doc a
parensIf (Int
p forall a. Ord a => a -> a -> Bool
> Int
symPrecedence) forall a b. (a -> b) -> a -> b
$
    forall vn (f :: * -> *) a.
(Eq vn, IsName vn, Annot f) =>
Int -> ExpBase f vn -> Doc a
prettyExp Int
symPrecedence ExpBase f vn
x
      forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann
bop'
      forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall vn (f :: * -> *) a.
(Eq vn, IsName vn, Annot f) =>
Int -> ExpBase f vn -> Doc a
prettyExp Int
symRPrecedence ExpBase f vn
y
  where
    bop' :: Doc ann
bop' = case BinOp
leading of
      BinOp
Backtick -> Doc ann
"`" forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty QualName vn
bop forall a. Semigroup a => a -> a -> a
<> Doc ann
"`"
      BinOp
_ -> forall a ann. Pretty a => a -> Doc ann
pretty QualName vn
bop
    leading :: BinOp
leading = Name -> BinOp
leadingOperator forall a b. (a -> b) -> a -> b
$ forall v. IsName v => v -> Name
toName forall a b. (a -> b) -> a -> b
$ forall vn. QualName vn -> vn
qualLeaf QualName vn
bop
    symPrecedence :: Int
symPrecedence = forall {a}. Num a => BinOp -> a
precedence BinOp
leading
    symRPrecedence :: Int
symRPrecedence = forall {a}. Num a => BinOp -> a
rprecedence BinOp
leading
    precedence :: BinOp -> a
precedence BinOp
PipeRight = -a
1
    precedence BinOp
PipeLeft = -a
1
    precedence BinOp
LogAnd = a
0
    precedence BinOp
LogOr = a
0
    precedence BinOp
Band = a
1
    precedence BinOp
Bor = a
1
    precedence BinOp
Xor = a
1
    precedence BinOp
Equal = a
2
    precedence BinOp
NotEqual = a
2
    precedence BinOp
Bang = a
2
    precedence BinOp
Equ = a
2
    precedence BinOp
Less = a
2
    precedence BinOp
Leq = a
2
    precedence BinOp
Greater = a
2
    precedence BinOp
Geq = a
2
    precedence BinOp
ShiftL = a
3
    precedence BinOp
ShiftR = a
3
    precedence BinOp
Plus = a
4
    precedence BinOp
Minus = a
4
    precedence BinOp
Times = a
5
    precedence BinOp
Divide = a
5
    precedence BinOp
Mod = a
5
    precedence BinOp
Quot = a
5
    precedence BinOp
Rem = a
5
    precedence BinOp
Pow = a
6
    precedence BinOp
Backtick = a
9
    rprecedence :: BinOp -> a
rprecedence BinOp
Minus = a
10
    rprecedence BinOp
Divide = a
10
    rprecedence BinOp
op = forall {a}. Num a => BinOp -> a
precedence BinOp
op