{-# OPTIONS_GHC -fno-warn-orphans #-}
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
class IsName v where
prettyName :: v -> Doc a
toName :: v -> 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 Annot f where
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 Int64
n) = forall a ann. Pretty a => a -> Doc ann
pretty Int64
n
instance (Eq vn, IsName vn, Annot f) => Pretty (SizeExp f vn) where
pretty :: forall ann. SizeExp f vn -> Doc ann
pretty SizeExpAny {} = forall ann. Doc ann -> Doc ann
brackets forall a. Monoid a => a
mempty
pretty (SizeExp ExpBase f vn
e SrcLoc
_) = forall ann. Doc ann -> Doc ann
brackets forall a b. (a -> b) -> a -> b
$ forall a ann. Pretty a => a -> Doc ann
pretty ExpBase f vn
e
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
instance Pretty Diet where
pretty :: forall ann. Diet -> Doc ann
pretty Diet
Consume = Doc ann
"*"
pretty Diet
Observe = Doc ann
""
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) Diet
d 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 a ann. Pretty a => a -> Doc ann
pretty Diet
d forall a. Semigroup a => a -> a -> a
<> 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 Diet
d 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 a ann. Pretty a => a -> Doc ann
pretty Diet
d forall a. Semigroup a => a -> a -> a
<> 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, Annot f) => Pretty (TypeExp f vn) where
pretty :: forall ann. TypeExp f vn -> Doc ann
pretty (TEUnique TypeExp f vn
t SrcLoc
_) = Doc ann
"*" forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty TypeExp f vn
t
pretty (TEArray SizeExp f vn
d TypeExp f vn
at SrcLoc
_) = forall a ann. Pretty a => a -> Doc ann
pretty SizeExp f vn
d forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty TypeExp f vn
at
pretty (TETuple [TypeExp f 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 f vn]
ts
pretty (TERecord [(Name, TypeExp 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, TypeExp 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
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 f vn
t TypeArgExp f vn
arg SrcLoc
_) = forall a ann. Pretty a => a -> Doc ann
pretty TypeExp f vn
t forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty TypeArgExp f vn
arg
pretty (TEArrow (Just vn
v) TypeExp f vn
t1 TypeExp f 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 f 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 f vn
t1
pretty (TEArrow Maybe vn
Nothing TypeExp f vn
t1 TypeExp f vn
t2 SrcLoc
_) = forall a ann. Pretty a => a -> Doc ann
pretty TypeExp f 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 f vn
t2
pretty (TESum [(Name, [TypeExp f 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 f 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 f 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 f vn
te
instance (Eq vn, IsName vn, Annot f) => Pretty (TypeArgExp f vn) where
pretty :: forall ann. TypeArgExp f vn -> Doc ann
pretty (TypeArgExpSize SizeExp f vn
d) = forall a ann. Pretty a => a -> Doc ann
pretty SizeExp f vn
d
pretty (TypeArgExpType TypeExp f vn
t) = forall a ann. Pretty a => a -> Doc ann
pretty TypeExp f 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 f 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 f 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 f 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 f 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 NonEmpty (f (Diet, Maybe VName), ExpBase f vn)
args 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 ann. [Doc ann] -> Doc ann
hsep (forall a b. (a -> b) -> [a] -> [b]
map (forall vn (f :: * -> *) a.
(Eq vn, IsName vn, Annot f) =>
Int -> ExpBase f vn -> Doc a
prettyExp Int
10 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> [a]
NE.toList NonEmpty (f (Diet, Maybe VName), ExpBase f vn)
args)
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 f 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 f 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 f 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 f 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 ann. Doc ann -> Doc ann
align (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 f 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 f 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 ImportName
_ 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 ImportName
_ 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 f 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 f 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 f 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 f 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 f 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 f 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 f 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 f 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