{-# OPTIONS_GHC -fno-warn-orphans #-}
module Futhark.IR.Pretty
( prettyTuple,
prettyTupleLines,
prettyString,
PrettyRep (..),
)
where
import Data.Foldable (toList)
import Data.List.NonEmpty (NonEmpty (..))
import Data.Maybe
import Futhark.IR.Syntax
import Futhark.Util.Pretty
class
( RepTypes rep,
Pretty (RetType rep),
Pretty (BranchType rep),
Pretty (FParamInfo rep),
Pretty (LParamInfo rep),
Pretty (LetDec rep),
Pretty (Op rep)
) =>
PrettyRep rep
where
ppExpDec :: ExpDec rep -> Exp rep -> Maybe (Doc a)
ppExpDec ExpDec rep
_ Exp rep
_ = forall a. Maybe a
Nothing
instance Pretty (NoOp rep) where
pretty :: forall ann. NoOp rep -> Doc ann
pretty NoOp rep
NoOp = Doc ann
"noop"
instance Pretty VName where
pretty :: forall ann. VName -> Doc ann
pretty (VName Name
vn Int
i) = forall a ann. Pretty a => a -> Doc ann
pretty Name
vn 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 (forall a. Show a => a -> String
show Int
i)
instance Pretty Commutativity where
pretty :: forall ann. Commutativity -> Doc ann
pretty Commutativity
Commutative = Doc ann
"commutative"
pretty Commutativity
Noncommutative = Doc ann
"noncommutative"
instance Pretty NoUniqueness where
pretty :: forall ann. NoUniqueness -> Doc ann
pretty NoUniqueness
_ = forall a. Monoid a => a
mempty
instance Pretty Shape where
pretty :: forall ann. Shape -> Doc ann
pretty = forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall d. ShapeBase d -> [d]
shapeDims
instance Pretty Rank where
pretty :: forall ann. Rank -> Doc ann
pretty (Rank Int
r) = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> [a]
replicate Int
r Doc ann
"[]"
instance Pretty a => Pretty (Ext a) where
pretty :: forall ann. Ext a -> Doc ann
pretty (Free a
e) = forall a ann. Pretty a => a -> Doc ann
pretty a
e
pretty (Ext Int
x) = Doc ann
"?" forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty (forall a. Show a => a -> String
show Int
x)
instance Pretty ExtShape where
pretty :: forall ann. ExtShape -> Doc ann
pretty = forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall d. ShapeBase d -> [d]
shapeDims
instance Pretty Space where
pretty :: forall ann. Space -> Doc ann
pretty Space
DefaultSpace = forall a. Monoid a => a
mempty
pretty (Space String
s) = Doc ann
"@" forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty String
s
pretty (ScalarSpace [SubExp]
d PrimType
t) = 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 a ann. Pretty a => a -> Doc ann
pretty) [SubExp]
d) forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty PrimType
t
instance Pretty u => Pretty (TypeBase Shape u) where
pretty :: forall ann. TypeBase Shape u -> Doc ann
pretty (Prim PrimType
t) = forall a ann. Pretty a => a -> Doc ann
pretty PrimType
t
pretty (Acc VName
acc Shape
ispace [Type]
ts u
u) =
forall a ann. Pretty a => a -> Doc ann
pretty u
u
forall a. Semigroup a => a -> a -> a
<> Doc ann
"acc"
forall a. Semigroup a => a -> a -> a
<> forall a. [Doc a] -> Doc a
apply
[ forall a ann. Pretty a => a -> Doc ann
pretty VName
acc,
forall a ann. Pretty a => a -> Doc ann
pretty Shape
ispace,
forall a. [Doc a] -> Doc a
ppTuple' forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty [Type]
ts
]
pretty (Array PrimType
et (Shape [SubExp]
ds) u
u) =
forall a ann. Pretty a => a -> Doc ann
pretty u
u 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 a ann. Pretty a => a -> Doc ann
pretty) [SubExp]
ds) forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty PrimType
et
pretty (Mem Space
s) = Doc ann
"mem" forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty Space
s
instance Pretty u => Pretty (TypeBase ExtShape u) where
pretty :: forall ann. TypeBase ExtShape u -> Doc ann
pretty (Prim PrimType
t) = forall a ann. Pretty a => a -> Doc ann
pretty PrimType
t
pretty (Acc VName
acc Shape
ispace [Type]
ts u
u) =
forall a ann. Pretty a => a -> Doc ann
pretty u
u
forall a. Semigroup a => a -> a -> a
<> Doc ann
"acc"
forall a. Semigroup a => a -> a -> a
<> forall a. [Doc a] -> Doc a
apply
[ forall a ann. Pretty a => a -> Doc ann
pretty VName
acc,
forall a ann. Pretty a => a -> Doc ann
pretty Shape
ispace,
forall a. [Doc a] -> Doc a
ppTuple' forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty [Type]
ts
]
pretty (Array PrimType
et (Shape [ExtSize]
ds) u
u) =
forall a ann. Pretty a => a -> Doc ann
pretty u
u 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 a ann. Pretty a => a -> Doc ann
pretty) [ExtSize]
ds) forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty PrimType
et
pretty (Mem Space
s) = Doc ann
"mem" forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty Space
s
instance Pretty u => Pretty (TypeBase Rank u) where
pretty :: forall ann. TypeBase Rank u -> Doc ann
pretty (Prim PrimType
t) = forall a ann. Pretty a => a -> Doc ann
pretty PrimType
t
pretty (Acc VName
acc Shape
ispace [Type]
ts u
u) =
forall a ann. Pretty a => a -> Doc ann
pretty u
u
forall a. Semigroup a => a -> a -> a
<> Doc ann
"acc"
forall a. Semigroup a => a -> a -> a
<> forall a. [Doc a] -> Doc a
apply
[ forall a ann. Pretty a => a -> Doc ann
pretty VName
acc,
forall a ann. Pretty a => a -> Doc ann
pretty Shape
ispace,
forall a. [Doc a] -> Doc a
ppTuple' forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty [Type]
ts
]
pretty (Array PrimType
et (Rank Int
n) u
u) =
forall a ann. Pretty a => a -> Doc ann
pretty u
u forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat (forall a. Int -> a -> [a]
replicate Int
n forall a b. (a -> b) -> a -> b
$ forall ann. Doc ann -> Doc ann
brackets forall a. Monoid a => a
mempty) forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty PrimType
et
pretty (Mem Space
s) = Doc ann
"mem" forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty Space
s
instance Pretty Ident where
pretty :: forall ann. Ident -> Doc ann
pretty Ident
ident = forall a ann. Pretty a => a -> Doc ann
pretty (Ident -> Type
identType Ident
ident) forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty (Ident -> VName
identName Ident
ident)
instance Pretty SubExp where
pretty :: forall ann. SubExp -> Doc ann
pretty (Var VName
v) = forall a ann. Pretty a => a -> Doc ann
pretty VName
v
pretty (Constant PrimValue
v) = forall a ann. Pretty a => a -> Doc ann
pretty PrimValue
v
instance Pretty Certs where
pretty :: forall ann. Certs -> Doc ann
pretty (Certs []) = forall a. Monoid a => a
mempty
pretty (Certs [VName]
cs) = Doc ann
"#" forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann -> Doc ann
braces (forall a. [Doc a] -> Doc a
commasep (forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty [VName]
cs))
instance PrettyRep rep => Pretty (Stms rep) where
pretty :: forall ann. Stms rep -> Doc ann
pretty = forall a. [Doc a] -> Doc a
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 b c a. (b -> c) -> (a -> b) -> a -> c
. forall rep. Stms rep -> [Stm rep]
stmsToList
instance Pretty SubExpRes where
pretty :: forall ann. SubExpRes -> Doc ann
pretty (SubExpRes Certs
cs SubExp
se) = forall a. [Doc a] -> Doc a
hsep forall a b. (a -> b) -> a -> b
$ forall a. Certs -> [Doc a]
certAnnots Certs
cs forall a. [a] -> [a] -> [a]
++ [forall a ann. Pretty a => a -> Doc ann
pretty SubExp
se]
instance PrettyRep rep => Pretty (Body rep) where
pretty :: forall ann. Body rep -> Doc ann
pretty (Body BodyDec rep
_ Stms rep
stms [SubExpRes]
res)
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null Stms rep
stms = forall ann. Doc ann -> Doc ann
braces (forall a. [Doc a] -> Doc a
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 [SubExpRes]
res)
| Bool
otherwise =
forall a. [Doc a] -> Doc a
stack (forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty forall a b. (a -> b) -> a -> b
$ forall rep. Stms rep -> [Stm rep]
stmsToList Stms rep
stms)
forall ann. Doc ann -> Doc ann -> Doc ann
</> Doc ann
"in"
forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
braces (forall a. [Doc a] -> Doc a
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 [SubExpRes]
res)
instance Pretty Attr where
pretty :: forall ann. Attr -> Doc ann
pretty (AttrName Name
v) = forall a ann. Pretty a => a -> Doc ann
pretty Name
v
pretty (AttrInt Integer
x) = forall a ann. Pretty a => a -> Doc ann
pretty Integer
x
pretty (AttrComp Name
f [Attr]
attrs) = 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 a. [Doc a] -> Doc a
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 [Attr]
attrs)
attrAnnots :: Attrs -> [Doc a]
attrAnnots :: forall a. Attrs -> [Doc a]
attrAnnots = forall a b. (a -> b) -> [a] -> [b]
map forall {a} {ann}. Pretty a => a -> Doc ann
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attrs -> Set Attr
unAttrs
where
f :: a -> Doc ann
f a
v = Doc ann
"#[" forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty a
v forall a. Semigroup a => a -> a -> a
<> Doc ann
"]"
stmAttrAnnots :: Stm rep -> [Doc a]
stmAttrAnnots :: forall rep a. Stm rep -> [Doc a]
stmAttrAnnots = forall a. Attrs -> [Doc a]
attrAnnots forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall dec. StmAux dec -> Attrs
stmAuxAttrs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall rep. Stm rep -> StmAux (ExpDec rep)
stmAux
certAnnots :: Certs -> [Doc a]
certAnnots :: forall a. Certs -> [Doc a]
certAnnots Certs
cs
| Certs
cs forall a. Eq a => a -> a -> Bool
== forall a. Monoid a => a
mempty = []
| Bool
otherwise = [forall a ann. Pretty a => a -> Doc ann
pretty Certs
cs]
stmCertAnnots :: Stm rep -> [Doc a]
stmCertAnnots :: forall rep a. Stm rep -> [Doc a]
stmCertAnnots = forall a. Certs -> [Doc a]
certAnnots forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall dec. StmAux dec -> Certs
stmAuxCerts forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall rep. Stm rep -> StmAux (ExpDec rep)
stmAux
instance Pretty Attrs where
pretty :: forall ann. Attrs -> Doc ann
pretty = forall a. [Doc a] -> Doc a
hsep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Attrs -> [Doc a]
attrAnnots
instance Pretty t => Pretty (Pat t) where
pretty :: forall ann. Pat t -> Doc ann
pretty (Pat [PatElem t]
xs) = forall ann. Doc ann -> Doc ann
braces forall a b. (a -> b) -> a -> b
$ forall a. [Doc a] -> Doc a
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 [PatElem t]
xs
instance Pretty t => Pretty (PatElem t) where
pretty :: forall ann. PatElem t -> Doc ann
pretty (PatElem VName
name t
t) = forall a ann. Pretty a => a -> Doc ann
pretty VName
name forall ann. Doc ann -> Doc ann -> Doc ann
<+> 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 t
t)
instance Pretty t => Pretty (Param t) where
pretty :: forall ann. Param t -> Doc ann
pretty (Param Attrs
attrs VName
name t
t) =
forall a. [Doc a] -> Doc a -> Doc a
annot (forall a. Attrs -> [Doc a]
attrAnnots Attrs
attrs) forall a b. (a -> b) -> a -> b
$ forall a ann. Pretty a => a -> Doc ann
pretty VName
name forall ann. Doc ann -> Doc ann -> Doc ann
<+> 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 t
t)
instance PrettyRep rep => Pretty (Stm rep) where
pretty :: forall ann. Stm rep -> Doc ann
pretty stm :: Stm rep
stm@(Let Pat (LetDec rep)
pat StmAux (ExpDec rep)
aux Exp rep
e) =
forall ann. Doc ann -> Doc ann
align forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ann. Int -> Doc ann -> Doc ann
hang Int
2 forall a b. (a -> b) -> a -> b
$
Doc ann
"let"
forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
align (forall a ann. Pretty a => a -> Doc ann
pretty Pat (LetDec rep)
pat)
forall ann. Doc ann -> Doc ann -> Doc ann
<+> case (Bool
linebreak, forall {a}. [Doc a]
stmannot) of
(Bool
True, []) -> forall ann. Doc ann
equals forall ann. Doc ann -> Doc ann -> Doc ann
</> forall a ann. Pretty a => a -> Doc ann
pretty Exp rep
e
(Bool
False, []) -> forall ann. Doc ann
equals forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Exp rep
e
(Bool
_, [Doc ann]
ann) -> forall ann. Doc ann
equals forall ann. Doc ann -> Doc ann -> Doc ann
</> (forall a. [Doc a] -> Doc a
stack [Doc ann]
ann forall ann. Doc ann -> Doc ann -> Doc ann
</> forall a ann. Pretty a => a -> Doc ann
pretty Exp rep
e)
where
linebreak :: Bool
linebreak = case Exp rep
e of
BasicOp BinOp {} -> Bool
False
BasicOp CmpOp {} -> Bool
False
BasicOp ConvOp {} -> Bool
False
BasicOp UnOp {} -> Bool
False
BasicOp SubExp {} -> Bool
False
Exp rep
_ -> Bool
True
stmannot :: [Doc a]
stmannot =
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ forall a. Maybe a -> [a]
maybeToList (forall rep a.
PrettyRep rep =>
ExpDec rep -> Exp rep -> Maybe (Doc a)
ppExpDec (forall dec. StmAux dec -> dec
stmAuxDec StmAux (ExpDec rep)
aux) Exp rep
e),
forall rep a. Stm rep -> [Doc a]
stmAttrAnnots Stm rep
stm,
forall rep a. Stm rep -> [Doc a]
stmCertAnnots Stm rep
stm
]
instance Pretty a => Pretty (Slice a) where
pretty :: forall ann. Slice a -> Doc ann
pretty (Slice [DimIndex a]
xs) = forall ann. Doc ann -> Doc ann
brackets (forall a. [Doc a] -> Doc a
commasep (forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty [DimIndex a]
xs))
instance Pretty d => Pretty (FlatDimIndex d) where
pretty :: forall ann. FlatDimIndex d -> Doc ann
pretty (FlatDimIndex d
n d
s) = forall a ann. Pretty a => a -> Doc ann
pretty d
n 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 d
s
instance Pretty a => Pretty (FlatSlice a) where
pretty :: forall ann. FlatSlice a -> Doc ann
pretty (FlatSlice a
offset [FlatDimIndex a]
xs) = forall ann. Doc ann -> Doc ann
brackets (forall a ann. Pretty a => a -> Doc ann
pretty a
offset forall a. Semigroup a => a -> a -> a
<> Doc ann
";" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a. [Doc a] -> Doc a
commasep (forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty [FlatDimIndex a]
xs))
instance Pretty BasicOp where
pretty :: forall ann. BasicOp -> Doc ann
pretty (SubExp SubExp
se) = forall a ann. Pretty a => a -> Doc ann
pretty SubExp
se
pretty (Opaque OpaqueOp
OpaqueNil SubExp
e) = Doc ann
"opaque" forall a. Semigroup a => a -> a -> a
<> forall a. [Doc a] -> Doc a
apply [forall a ann. Pretty a => a -> Doc ann
pretty SubExp
e]
pretty (Opaque (OpaqueTrace Text
s) SubExp
e) = Doc ann
"trace" forall a. Semigroup a => a -> a -> a
<> forall a. [Doc a] -> Doc a
apply [forall a ann. Pretty a => a -> Doc ann
pretty (forall a. Show a => a -> String
show Text
s), forall a ann. Pretty a => a -> Doc ann
pretty SubExp
e]
pretty (ArrayLit [SubExp]
es Type
rt) =
case Type
rt of
Array {} -> forall ann. Doc ann -> Doc ann
brackets forall a b. (a -> b) -> a -> b
$ forall a. [Doc a] -> Doc a
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 [SubExp]
es
Type
_ -> forall ann. Doc ann -> Doc ann
brackets forall a b. (a -> b) -> a -> b
$ forall a. [Doc a] -> Doc a
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 [SubExp]
es
forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann
colon
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"[]" forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty Type
rt
pretty (BinOp BinOp
bop SubExp
x SubExp
y) = forall a ann. Pretty a => a -> Doc ann
pretty BinOp
bop forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann -> Doc ann
parens (forall a ann. Pretty a => a -> Doc ann
pretty SubExp
x forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
comma forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty SubExp
y)
pretty (CmpOp CmpOp
op SubExp
x SubExp
y) = forall a ann. Pretty a => a -> Doc ann
pretty CmpOp
op forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann -> Doc ann
parens (forall a ann. Pretty a => a -> Doc ann
pretty SubExp
x forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
comma forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty SubExp
y)
pretty (ConvOp ConvOp
conv SubExp
x) =
forall a ann. Pretty a => a -> Doc ann
pretty (ConvOp -> String
convOpFun ConvOp
conv) forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty PrimType
fromtype forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty SubExp
x forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"to" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty PrimType
totype
where
(PrimType
fromtype, PrimType
totype) = ConvOp -> (PrimType, PrimType)
convOpType ConvOp
conv
pretty (UnOp UnOp
op SubExp
e) = forall a ann. Pretty a => a -> Doc ann
pretty UnOp
op forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty SubExp
e
pretty (Index VName
v Slice SubExp
slice) = forall a ann. Pretty a => a -> Doc ann
pretty VName
v forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty Slice SubExp
slice
pretty (Update Safety
safety VName
src Slice SubExp
slice SubExp
se) =
forall a ann. Pretty a => a -> Doc ann
pretty VName
src 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 Slice SubExp
slice 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 SubExp
se
where
with :: Doc ann
with = case Safety
safety of
Safety
Unsafe -> Doc ann
"with"
Safety
Safe -> Doc ann
"with?"
pretty (FlatIndex VName
v FlatSlice SubExp
slice) = forall a ann. Pretty a => a -> Doc ann
pretty VName
v forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty FlatSlice SubExp
slice
pretty (FlatUpdate VName
src FlatSlice SubExp
slice VName
se) =
forall a ann. Pretty a => a -> Doc ann
pretty VName
src 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 FlatSlice SubExp
slice 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 VName
se
pretty (Iota SubExp
e SubExp
x SubExp
s IntType
et) = Doc ann
"iota" forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
et' forall a. Semigroup a => a -> a -> a
<> forall a. [Doc a] -> Doc a
apply [forall a ann. Pretty a => a -> Doc ann
pretty SubExp
e, forall a ann. Pretty a => a -> Doc ann
pretty SubExp
x, forall a ann. Pretty a => a -> Doc ann
pretty SubExp
s]
where
et' :: Doc ann
et' = 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
$ PrimType -> Int
primBitSize forall a b. (a -> b) -> a -> b
$ IntType -> PrimType
IntType IntType
et
pretty (Replicate Shape
ne SubExp
ve) =
Doc ann
"replicate" forall a. Semigroup a => a -> a -> a
<> forall a. [Doc a] -> Doc a
apply [forall a ann. Pretty a => a -> Doc ann
pretty Shape
ne, forall ann. Doc ann -> Doc ann
align (forall a ann. Pretty a => a -> Doc ann
pretty SubExp
ve)]
pretty (Scratch PrimType
t [SubExp]
shape) =
Doc ann
"scratch" forall a. Semigroup a => a -> a -> a
<> forall a. [Doc a] -> Doc a
apply (forall a ann. Pretty a => a -> Doc ann
pretty PrimType
t forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty [SubExp]
shape)
pretty (Reshape ReshapeKind
ReshapeArbitrary Shape
shape VName
e) =
Doc ann
"reshape" forall a. Semigroup a => a -> a -> a
<> forall a. [Doc a] -> Doc a
apply [forall a ann. Pretty a => a -> Doc ann
pretty Shape
shape, forall a ann. Pretty a => a -> Doc ann
pretty VName
e]
pretty (Reshape ReshapeKind
ReshapeCoerce Shape
shape VName
e) =
Doc ann
"coerce" forall a. Semigroup a => a -> a -> a
<> forall a. [Doc a] -> Doc a
apply [forall a ann. Pretty a => a -> Doc ann
pretty Shape
shape, forall a ann. Pretty a => a -> Doc ann
pretty VName
e]
pretty (Rearrange [Int]
perm VName
e) =
Doc ann
"rearrange" forall a. Semigroup a => a -> a -> a
<> forall a. [Doc a] -> Doc a
apply [forall a. [Doc a] -> Doc a
apply (forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty [Int]
perm), forall a ann. Pretty a => a -> Doc ann
pretty VName
e]
pretty (Rotate [SubExp]
es VName
e) =
Doc ann
"rotate" forall a. Semigroup a => a -> a -> a
<> forall a. [Doc a] -> Doc a
apply [forall a. [Doc a] -> Doc a
apply (forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty [SubExp]
es), forall a ann. Pretty a => a -> Doc ann
pretty VName
e]
pretty (Concat Int
i (VName
x :| [VName]
xs) SubExp
w) =
Doc ann
"concat" 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 Int
i forall a. Semigroup a => a -> a -> a
<> forall a. [Doc a] -> Doc a
apply (forall a ann. Pretty a => a -> Doc ann
pretty SubExp
w forall a. a -> [a] -> [a]
: forall a ann. Pretty a => a -> Doc ann
pretty VName
x forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty [VName]
xs)
pretty (Copy VName
e) = Doc ann
"copy" forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann -> Doc ann
parens (forall a ann. Pretty a => a -> Doc ann
pretty VName
e)
pretty (Manifest [Int]
perm VName
e) = Doc ann
"manifest" forall a. Semigroup a => a -> a -> a
<> forall a. [Doc a] -> Doc a
apply [forall a. [Doc a] -> Doc a
apply (forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty [Int]
perm), forall a ann. Pretty a => a -> Doc ann
pretty VName
e]
pretty (Assert SubExp
e ErrorMsg SubExp
msg (SrcLoc
loc, [SrcLoc]
_)) =
Doc ann
"assert" forall a. Semigroup a => a -> a -> a
<> forall a. [Doc a] -> Doc a
apply [forall a ann. Pretty a => a -> Doc ann
pretty SubExp
e, forall a ann. Pretty a => a -> Doc ann
pretty ErrorMsg SubExp
msg, 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. Located a => a -> String
locStr SrcLoc
loc]
pretty (UpdateAcc VName
acc [SubExp]
is [SubExp]
v) =
Doc ann
"update_acc"
forall a. Semigroup a => a -> a -> a
<> forall a. [Doc a] -> Doc a
apply
[ forall a ann. Pretty a => a -> Doc ann
pretty VName
acc,
forall a. [Doc a] -> Doc a
ppTuple' forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty [SubExp]
is,
forall a. [Doc a] -> Doc a
ppTuple' forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty [SubExp]
v
]
instance Pretty a => Pretty (ErrorMsg a) where
pretty :: forall ann. ErrorMsg a -> Doc ann
pretty (ErrorMsg [ErrorMsgPart a]
parts) = 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. [Doc a] -> Doc a
commasep forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {a} {ann}. Pretty a => ErrorMsgPart a -> Doc ann
p [ErrorMsgPart a]
parts
where
p :: ErrorMsgPart a -> Doc ann
p (ErrorString Text
s) = forall a ann. Pretty a => a -> Doc ann
pretty forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Text
s
p (ErrorVal PrimType
t a
x) = forall a ann. Pretty a => a -> Doc ann
pretty a
x forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann
colon forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty PrimType
t
maybeNest :: PrettyRep rep => Body rep -> Doc a
maybeNest :: forall rep a. PrettyRep rep => Body rep -> Doc a
maybeNest Body rep
b
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ forall rep. Body rep -> Stms rep
bodyStms Body rep
b = forall a ann. Pretty a => a -> Doc ann
pretty Body rep
b
| Bool
otherwise = forall a. Doc a -> Doc a -> Doc a -> Doc a
nestedBlock Doc a
"{" Doc a
"}" forall a b. (a -> b) -> a -> b
$ forall a ann. Pretty a => a -> Doc ann
pretty Body rep
b
instance PrettyRep rep => Pretty (Case (Body rep)) where
pretty :: forall ann. Case (Body rep) -> Doc ann
pretty (Case [Maybe PrimValue]
vs Body rep
b) =
Doc ann
"case" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a. [Doc a] -> Doc a
ppTuple' (forall a b. (a -> b) -> [a] -> [b]
map (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc ann
"_" forall a ann. Pretty a => a -> Doc ann
pretty) [Maybe PrimValue]
vs) forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"->" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall rep a. PrettyRep rep => Body rep -> Doc a
maybeNest Body rep
b
instance PrettyRep rep => Pretty (Exp rep) where
pretty :: forall ann. Exp rep -> Doc ann
pretty (Match [SubExp
c] [Case [Just (BoolValue Bool
True)] Body rep
t] Body rep
f (MatchDec [BranchType rep]
ret MatchSort
ifsort)) =
Doc ann
"if"
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
info'
forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty SubExp
c
forall ann. Doc ann -> Doc ann -> Doc ann
</> Doc ann
"then"
forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall rep a. PrettyRep rep => Body rep -> Doc a
maybeNest Body rep
t
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"else"
forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall rep a. PrettyRep rep => Body rep -> Doc a
maybeNest Body rep
f
forall ann. Doc ann -> Doc ann -> Doc ann
</> forall ann. Doc ann
colon
forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a. [Doc a] -> Doc a
ppTupleLines' (forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty [BranchType rep]
ret)
where
info' :: Doc ann
info' = case MatchSort
ifsort of
MatchSort
MatchNormal -> forall a. Monoid a => a
mempty
MatchSort
MatchFallback -> Doc ann
"<fallback>"
MatchSort
MatchEquiv -> Doc ann
"<equiv>"
pretty (Match [SubExp]
ses [Case (Body rep)]
cs Body rep
defb (MatchDec [BranchType rep]
ret MatchSort
ifsort)) =
(Doc ann
"match" forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
info' forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a. [Doc a] -> Doc a
ppTuple' (forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty [SubExp]
ses))
forall ann. Doc ann -> Doc ann -> Doc ann
</> forall a. [Doc a] -> Doc a
stack (forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty [Case (Body rep)]
cs)
forall ann. Doc ann -> Doc ann -> Doc ann
</> Doc ann
"default"
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"->"
forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall rep a. PrettyRep rep => Body rep -> Doc a
maybeNest Body rep
defb
forall ann. Doc ann -> Doc ann -> Doc ann
</> forall ann. Doc ann
colon
forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a. [Doc a] -> Doc a
ppTupleLines' (forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty [BranchType rep]
ret)
where
info' :: Doc ann
info' = case MatchSort
ifsort of
MatchSort
MatchNormal -> forall a. Monoid a => a
mempty
MatchSort
MatchFallback -> Doc ann
"<fallback>"
MatchSort
MatchEquiv -> Doc ann
"<equiv>"
pretty (BasicOp BasicOp
op) = forall a ann. Pretty a => a -> Doc ann
pretty BasicOp
op
pretty (Apply Name
fname [(SubExp, Diet)]
args [RetType rep]
ret (Safety
safety, SrcLoc
_, [SrcLoc]
_)) =
Doc ann
applykw
forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty (Name -> String
nameToString Name
fname)
forall a. Semigroup a => a -> a -> a
<> forall a. [Doc a] -> Doc a
apply (forall a b. (a -> b) -> [a] -> [b]
map (forall ann. Doc ann -> Doc ann
align forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a} {ann}. Pretty a => (a, Diet) -> Doc ann
prettyArg) [(SubExp, Diet)]
args)
forall ann. Doc ann -> Doc ann -> Doc ann
</> forall ann. Doc ann
colon
forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
braces (forall a. [Doc a] -> Doc a
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 [RetType rep]
ret)
where
prettyArg :: (a, Diet) -> Doc ann
prettyArg (a
arg, Diet
Consume) = Doc ann
"*" forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty a
arg
prettyArg (a
arg, Diet
_) = forall a ann. Pretty a => a -> Doc ann
pretty a
arg
applykw :: Doc ann
applykw = case Safety
safety of
Safety
Unsafe -> Doc ann
"apply <unsafe>"
Safety
Safe -> Doc ann
"apply"
pretty (Op Op rep
op) = forall a ann. Pretty a => a -> Doc ann
pretty Op rep
op
pretty (DoLoop [(Param (FParamInfo rep), SubExp)]
merge LoopForm rep
form Body rep
loopbody) =
Doc ann
"loop"
forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
braces (forall a. [Doc a] -> Doc a
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 [Param (FParamInfo rep)]
params)
forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann
equals
forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a. [Doc a] -> Doc a
ppTuple' (forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty [SubExp]
args)
forall ann. Doc ann -> Doc ann -> Doc ann
</> ( case LoopForm rep
form of
ForLoop VName
i IntType
it SubExp
bound [] ->
Doc ann
"for"
forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
align
( forall a ann. Pretty a => a -> Doc ann
pretty VName
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 IntType
it
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 SubExp
bound)
)
ForLoop VName
i IntType
it SubExp
bound [(Param (LParamInfo rep), VName)]
loop_vars ->
Doc ann
"for"
forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
align
( forall a ann. Pretty a => a -> Doc ann
pretty VName
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 IntType
it
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 SubExp
bound)
forall ann. Doc ann -> Doc ann -> Doc ann
</> forall a. [Doc a] -> Doc a
stack (forall a b. (a -> b) -> [a] -> [b]
map forall {a} {a} {ann}. (Pretty a, Pretty a) => (a, a) -> Doc ann
prettyLoopVar [(Param (LParamInfo rep), VName)]
loop_vars)
)
WhileLoop VName
cond ->
Doc ann
"while" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty VName
cond
)
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"do"
forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a. Doc a -> Doc a -> Doc a -> Doc a
nestedBlock Doc ann
"{" Doc ann
"}" (forall a ann. Pretty a => a -> Doc ann
pretty Body rep
loopbody)
where
([Param (FParamInfo rep)]
params, [SubExp]
args) = forall a b. [(a, b)] -> ([a], [b])
unzip [(Param (FParamInfo rep), SubExp)]
merge
prettyLoopVar :: (a, a) -> Doc ann
prettyLoopVar (a
p, a
a) = forall a ann. Pretty a => a -> Doc ann
pretty a
p 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 a
a
pretty (WithAcc [WithAccInput rep]
inputs Lambda rep
lam) =
Doc ann
"with_acc"
forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann -> Doc ann
parens (forall ann. Doc ann -> Doc ann
braces (forall a. [Doc a] -> Doc a
commastack forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {a} {a} {a} {a} {ann}.
(Pretty a, Pretty a, Pretty a, Pretty a) =>
(a, [a], Maybe (a, [a])) -> Doc ann
ppInput [WithAccInput rep]
inputs) forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
comma forall ann. Doc ann -> Doc ann -> Doc ann
</> forall a ann. Pretty a => a -> Doc ann
pretty Lambda rep
lam)
where
ppInput :: (a, [a], Maybe (a, [a])) -> Doc ann
ppInput (a
shape, [a]
arrs, Maybe (a, [a])
op) =
forall ann. Doc ann -> Doc ann
parens
( forall a ann. Pretty a => a -> Doc ann
pretty a
shape forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
comma
forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a. [Doc a] -> Doc a
ppTuple' (forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty [a]
arrs)
forall a. Semigroup a => a -> a -> a
<> case Maybe (a, [a])
op of
Maybe (a, [a])
Nothing -> forall a. Monoid a => a
mempty
Just (a
op', [a]
nes) ->
forall ann. Doc ann
comma forall ann. Doc ann -> Doc ann -> Doc ann
</> forall ann. Doc ann -> Doc ann
parens (forall a ann. Pretty a => a -> Doc ann
pretty a
op' forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
comma forall ann. Doc ann -> Doc ann -> Doc ann
</> forall a. [Doc a] -> Doc a
ppTuple' (forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty [a]
nes))
)
instance PrettyRep rep => Pretty (Lambda rep) where
pretty :: forall ann. Lambda rep -> Doc ann
pretty (Lambda [] (Body BodyDec rep
_ Stms rep
stms []) []) | Stms rep
stms forall a. Eq a => a -> a -> Bool
== forall a. Monoid a => a
mempty = Doc ann
"nilFn"
pretty (Lambda [Param (LParamInfo rep)]
params Body rep
body [Type]
rettype) =
Doc ann
"\\"
forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
braces (forall a. [Doc a] -> Doc a
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 [Param (LParamInfo rep)]
params)
forall ann. Doc ann -> Doc ann -> Doc ann
</> forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (forall ann. Doc ann
colon forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a. [Doc a] -> Doc a
ppTupleLines' (forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty [Type]
rettype) 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 Body rep
body)
instance Pretty Signedness where
pretty :: forall ann. Signedness -> Doc ann
pretty Signedness
Signed = Doc ann
"signed"
pretty Signedness
Unsigned = Doc ann
"unsigned"
instance Pretty ValueType where
pretty :: forall ann. ValueType -> Doc ann
pretty (ValueType Signedness
s (Rank Int
r) PrimType
t) =
forall a. Monoid a => [a] -> a
mconcat (forall a. Int -> a -> [a]
replicate Int
r Doc ann
"[]") forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty (Bool -> PrimType -> Text
prettySigned (Signedness
s forall a. Eq a => a -> a -> Bool
== Signedness
Unsigned) PrimType
t)
instance Pretty EntryPointType where
pretty :: forall ann. EntryPointType -> Doc ann
pretty (TypeTransparent ValueType
t) = forall a ann. Pretty a => a -> Doc ann
pretty ValueType
t
pretty (TypeOpaque Name
desc) = Doc ann
"opaque" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
dquotes (forall a ann. Pretty a => a -> Doc ann
pretty Name
desc)
instance Pretty EntryParam where
pretty :: forall ann. EntryParam -> Doc ann
pretty (EntryParam Name
name Uniqueness
u EntryPointType
t) = forall a ann. Pretty a => a -> Doc ann
pretty 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 Uniqueness
u forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty EntryPointType
t
instance Pretty EntryResult where
pretty :: forall ann. EntryResult -> Doc ann
pretty (EntryResult Uniqueness
u EntryPointType
t) = 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 EntryPointType
t
instance PrettyRep rep => Pretty (FunDef rep) where
pretty :: forall ann. FunDef rep -> Doc ann
pretty (FunDef Maybe EntryPoint
entry Attrs
attrs Name
name [RetType rep]
rettype [Param (FParamInfo rep)]
fparams Body rep
body) =
forall a. [Doc a] -> Doc a -> Doc a
annot (forall a. Attrs -> [Doc a]
attrAnnots Attrs
attrs) forall a b. (a -> b) -> a -> b
$
forall ann. Doc ann
fun
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 (Name -> String
nameToString Name
name))
forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
parens (forall a. [Doc a] -> Doc a
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 [Param (FParamInfo rep)]
fparams)
forall ann. Doc ann -> Doc ann -> Doc ann
</> forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (forall ann. Doc ann
colon forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
align (forall a. [Doc a] -> Doc a
ppTupleLines' forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty [RetType rep]
rettype))
forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann
equals
forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a. Doc a -> Doc a -> Doc a -> Doc a
nestedBlock Doc ann
"{" Doc ann
"}" (forall a ann. Pretty a => a -> Doc ann
pretty Body rep
body)
where
fun :: Doc ann
fun = case Maybe EntryPoint
entry of
Maybe EntryPoint
Nothing -> Doc ann
"fun"
Just (Name
p_name, [EntryParam]
p_entry, [EntryResult]
ret_entry) ->
Doc ann
"entry"
forall a. Semigroup a => a -> a -> a
<> (forall ann. Doc ann -> Doc ann
parens forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ann. Doc ann -> Doc ann
align)
( Doc ann
"\"" forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty Name
p_name forall a. Semigroup a => a -> a -> a
<> Doc ann
"\"" forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
comma
forall ann. Doc ann -> Doc ann -> Doc ann
</> forall a. [Doc a] -> Doc a
ppTupleLines' (forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty [EntryParam]
p_entry) forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
comma
forall ann. Doc ann -> Doc ann -> Doc ann
</> forall a. [Doc a] -> Doc a
ppTupleLines' (forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty [EntryResult]
ret_entry)
)
instance Pretty OpaqueType where
pretty :: forall ann. OpaqueType -> Doc ann
pretty (OpaqueType [ValueType]
ts) =
Doc ann
"opaque" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a. Doc a -> Doc a -> Doc a -> Doc a
nestedBlock Doc ann
"{" Doc ann
"}" (forall a. [Doc a] -> Doc a
stack forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty [ValueType]
ts)
pretty (OpaqueRecord [(Name, EntryPointType)]
fs) =
Doc ann
"record" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a. Doc a -> Doc a -> Doc a -> Doc a
nestedBlock Doc ann
"{" Doc ann
"}" (forall a. [Doc a] -> Doc a
stack 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
p [(Name, EntryPointType)]
fs)
where
p :: (a, a) -> Doc ann
p (a
f, a
et) = forall a ann. Pretty a => a -> Doc ann
pretty a
f 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 a
et
instance Pretty OpaqueTypes where
pretty :: forall ann. OpaqueTypes -> Doc ann
pretty (OpaqueTypes [(Name, OpaqueType)]
ts) = Doc ann
"types" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a. Doc a -> Doc a -> Doc a -> Doc a
nestedBlock Doc ann
"{" Doc ann
"}" (forall a. [Doc a] -> Doc a
stack 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
p [(Name, OpaqueType)]
ts)
where
p :: (a, a) -> Doc ann
p (a
name, a
t) = Doc ann
"type" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
dquotes (forall a ann. Pretty a => a -> Doc ann
pretty a
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 a
t
instance PrettyRep rep => Pretty (Prog rep) where
pretty :: forall ann. Prog rep -> Doc ann
pretty (Prog OpaqueTypes
types Stms rep
consts [FunDef rep]
funs) =
forall a. [Doc a] -> Doc a
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 ann. Pretty a => a -> Doc ann
pretty OpaqueTypes
types forall a. a -> [a] -> [a]
: forall a ann. Pretty a => a -> Doc ann
pretty Stms rep
consts forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty [FunDef rep]
funs
instance Pretty d => Pretty (DimIndex d) where
pretty :: forall ann. DimIndex d -> Doc ann
pretty (DimFix d
i) = forall a ann. Pretty a => a -> Doc ann
pretty d
i
pretty (DimSlice d
i d
n d
s) = forall a ann. Pretty a => a -> Doc ann
pretty d
i 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 d
n 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 d
s