{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Futhark.IR.Pretty
( prettyTuple,
pretty,
PrettyAnnot (..),
PrettyLore (..),
ppTuple',
)
where
import Data.Foldable (toList)
import Data.Maybe
import Futhark.IR.Prop.Patterns
import Futhark.IR.Syntax
import Futhark.Util.Pretty
class PrettyAnnot a where
ppAnnot :: a -> Maybe Doc
instance PrettyAnnot (PatElemT (TypeBase shape u)) where
ppAnnot :: PatElemT (TypeBase shape u) -> Maybe Doc
ppAnnot = Maybe Doc -> PatElemT (TypeBase shape u) -> Maybe Doc
forall a b. a -> b -> a
const Maybe Doc
forall a. Maybe a
Nothing
instance PrettyAnnot (Param (TypeBase shape u)) where
ppAnnot :: Param (TypeBase shape u) -> Maybe Doc
ppAnnot = Maybe Doc -> Param (TypeBase shape u) -> Maybe Doc
forall a b. a -> b -> a
const Maybe Doc
forall a. Maybe a
Nothing
instance PrettyAnnot () where
ppAnnot :: () -> Maybe Doc
ppAnnot = Maybe Doc -> () -> Maybe Doc
forall a b. a -> b -> a
const Maybe Doc
forall a. Maybe a
Nothing
class
( Decorations lore,
Pretty (RetType lore),
Pretty (BranchType lore),
Pretty (Param (FParamInfo lore)),
Pretty (Param (LParamInfo lore)),
Pretty (PatElemT (LetDec lore)),
PrettyAnnot (PatElem lore),
PrettyAnnot (FParam lore),
PrettyAnnot (LParam lore),
Pretty (Op lore)
) =>
PrettyLore lore
where
ppExpLore :: ExpDec lore -> Exp lore -> Maybe Doc
ppExpLore ExpDec lore
_ (If SubExp
_ BodyT lore
_ BodyT lore
_ (IfDec [BranchType lore]
ts IfSort
_)) =
Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc) -> Doc -> Maybe Doc
forall a b. (a -> b) -> a -> b
$
[Doc] -> Doc
stack ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$
([Char] -> Doc) -> [[Char]] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> Doc
text ([Char] -> Doc) -> ([Char] -> [Char]) -> [Char] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char]
"-- " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++)) ([[Char]] -> [Doc]) -> [[Char]] -> [Doc]
forall a b. (a -> b) -> a -> b
$
[Char] -> [[Char]]
lines ([Char] -> [[Char]]) -> [Char] -> [[Char]]
forall a b. (a -> b) -> a -> b
$
Doc -> [Char]
forall a. Pretty a => a -> [Char]
pretty (Doc -> [Char]) -> Doc -> [Char]
forall a b. (a -> b) -> a -> b
$
[Char] -> Doc
text [Char]
"Branch returns:" Doc -> Doc -> Doc
<+> [BranchType lore] -> Doc
forall a. Pretty a => [a] -> Doc
ppTuple' [BranchType lore]
ts
ppExpLore ExpDec lore
_ Exp lore
_ = Maybe Doc
forall a. Maybe a
Nothing
commastack :: [Doc] -> Doc
commastack :: [Doc] -> Doc
commastack = Doc -> Doc
align (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
stack ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma
instance Pretty VName where
ppr :: VName -> Doc
ppr (VName Name
vn Int
i) = Name -> Doc
forall a. Pretty a => a -> Doc
ppr Name
vn Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Char] -> Doc
text [Char]
"_" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Char] -> Doc
text (Int -> [Char]
forall a. Show a => a -> [Char]
show Int
i)
instance Pretty NoUniqueness where
ppr :: NoUniqueness -> Doc
ppr NoUniqueness
_ = Doc
forall a. Monoid a => a
mempty
instance Pretty Commutativity where
ppr :: Commutativity -> Doc
ppr Commutativity
Commutative = [Char] -> Doc
text [Char]
"commutative"
ppr Commutativity
Noncommutative = [Char] -> Doc
text [Char]
"noncommutative"
instance Pretty Shape where
ppr :: Shape -> Doc
ppr = Doc -> Doc
brackets (Doc -> Doc) -> (Shape -> Doc) -> Shape -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
commasep ([Doc] -> Doc) -> (Shape -> [Doc]) -> Shape -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SubExp -> Doc) -> [SubExp] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map SubExp -> Doc
forall a. Pretty a => a -> Doc
ppr ([SubExp] -> [Doc]) -> (Shape -> [SubExp]) -> Shape -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Shape -> [SubExp]
forall d. ShapeBase d -> [d]
shapeDims
instance Pretty a => Pretty (Ext a) where
ppr :: Ext a -> Doc
ppr (Free a
e) = a -> Doc
forall a. Pretty a => a -> Doc
ppr a
e
ppr (Ext Int
x) = [Char] -> Doc
text [Char]
"?" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Char] -> Doc
text (Int -> [Char]
forall a. Show a => a -> [Char]
show Int
x)
instance Pretty ExtShape where
ppr :: ExtShape -> Doc
ppr = Doc -> Doc
brackets (Doc -> Doc) -> (ExtShape -> Doc) -> ExtShape -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
commasep ([Doc] -> Doc) -> (ExtShape -> [Doc]) -> ExtShape -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ExtSize -> Doc) -> [ExtSize] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ExtSize -> Doc
forall a. Pretty a => a -> Doc
ppr ([ExtSize] -> [Doc])
-> (ExtShape -> [ExtSize]) -> ExtShape -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExtShape -> [ExtSize]
forall d. ShapeBase d -> [d]
shapeDims
instance Pretty Space where
ppr :: Space -> Doc
ppr Space
DefaultSpace = Doc
forall a. Monoid a => a
mempty
ppr (Space [Char]
s) = [Char] -> Doc
text [Char]
"@" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Char] -> Doc
text [Char]
s
ppr (ScalarSpace [SubExp]
d PrimType
t) = [Char] -> Doc
text [Char]
"@" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
forall a. Monoid a => [a] -> a
mconcat ((SubExp -> Doc) -> [SubExp] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Doc -> Doc
brackets (Doc -> Doc) -> (SubExp -> Doc) -> SubExp -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SubExp -> Doc
forall a. Pretty a => a -> Doc
ppr) [SubExp]
d) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> PrimType -> Doc
forall a. Pretty a => a -> Doc
ppr PrimType
t
instance Pretty u => Pretty (TypeBase Shape u) where
ppr :: TypeBase Shape u -> Doc
ppr (Prim PrimType
et) = PrimType -> Doc
forall a. Pretty a => a -> Doc
ppr PrimType
et
ppr (Array PrimType
et (Shape [SubExp]
ds) u
u) =
u -> Doc
forall a. Pretty a => a -> Doc
ppr u
u Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
forall a. Monoid a => [a] -> a
mconcat ((SubExp -> Doc) -> [SubExp] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Doc -> Doc
brackets (Doc -> Doc) -> (SubExp -> Doc) -> SubExp -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SubExp -> Doc
forall a. Pretty a => a -> Doc
ppr) [SubExp]
ds) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> PrimType -> Doc
forall a. Pretty a => a -> Doc
ppr PrimType
et
ppr (Mem Space
s) = [Char] -> Doc
text [Char]
"mem" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Space -> Doc
forall a. Pretty a => a -> Doc
ppr Space
s
instance Pretty u => Pretty (TypeBase ExtShape u) where
ppr :: TypeBase ExtShape u -> Doc
ppr (Prim PrimType
et) = PrimType -> Doc
forall a. Pretty a => a -> Doc
ppr PrimType
et
ppr (Array PrimType
et (Shape [ExtSize]
ds) u
u) =
u -> Doc
forall a. Pretty a => a -> Doc
ppr u
u Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
forall a. Monoid a => [a] -> a
mconcat ((ExtSize -> Doc) -> [ExtSize] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Doc -> Doc
brackets (Doc -> Doc) -> (ExtSize -> Doc) -> ExtSize -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExtSize -> Doc
forall a. Pretty a => a -> Doc
ppr) [ExtSize]
ds) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> PrimType -> Doc
forall a. Pretty a => a -> Doc
ppr PrimType
et
ppr (Mem Space
s) = [Char] -> Doc
text [Char]
"mem" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Space -> Doc
forall a. Pretty a => a -> Doc
ppr Space
s
instance Pretty u => Pretty (TypeBase Rank u) where
ppr :: TypeBase Rank u -> Doc
ppr (Prim PrimType
et) = PrimType -> Doc
forall a. Pretty a => a -> Doc
ppr PrimType
et
ppr (Array PrimType
et (Rank Int
n) u
u) =
u -> Doc
forall a. Pretty a => a -> Doc
ppr u
u Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
forall a. Monoid a => [a] -> a
mconcat (Int -> Doc -> [Doc]
forall a. Int -> a -> [a]
replicate Int
n (Doc -> [Doc]) -> Doc -> [Doc]
forall a b. (a -> b) -> a -> b
$ Doc -> Doc
brackets Doc
forall a. Monoid a => a
mempty) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> PrimType -> Doc
forall a. Pretty a => a -> Doc
ppr PrimType
et
ppr (Mem Space
s) = [Char] -> Doc
text [Char]
"mem" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Space -> Doc
forall a. Pretty a => a -> Doc
ppr Space
s
instance Pretty Ident where
ppr :: Ident -> Doc
ppr Ident
ident = Type -> Doc
forall a. Pretty a => a -> Doc
ppr (Ident -> Type
identType Ident
ident) Doc -> Doc -> Doc
<+> VName -> Doc
forall a. Pretty a => a -> Doc
ppr (Ident -> VName
identName Ident
ident)
instance Pretty SubExp where
ppr :: SubExp -> Doc
ppr (Var VName
v) = VName -> Doc
forall a. Pretty a => a -> Doc
ppr VName
v
ppr (Constant PrimValue
v) = PrimValue -> Doc
forall a. Pretty a => a -> Doc
ppr PrimValue
v
instance Pretty Certificates where
ppr :: Certificates -> Doc
ppr (Certificates []) = Doc
empty
ppr (Certificates [VName]
cs) = [Char] -> Doc
text [Char]
"<" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
commasep ((VName -> Doc) -> [VName] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map VName -> Doc
forall a. Pretty a => a -> Doc
ppr [VName]
cs) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Char] -> Doc
text [Char]
">"
instance PrettyLore lore => Pretty (Stms lore) where
ppr :: Stms lore -> Doc
ppr = [Doc] -> Doc
stack ([Doc] -> Doc) -> (Stms lore -> [Doc]) -> Stms lore -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Stm lore -> Doc) -> [Stm lore] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Stm lore -> Doc
forall a. Pretty a => a -> Doc
ppr ([Stm lore] -> [Doc])
-> (Stms lore -> [Stm lore]) -> Stms lore -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stms lore -> [Stm lore]
forall lore. Stms lore -> [Stm lore]
stmsToList
instance PrettyLore lore => Pretty (Body lore) where
ppr :: Body lore -> Doc
ppr (Body BodyDec lore
_ Stms lore
stms [SubExp]
res)
| Stms lore -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Stms lore
stms = Doc -> Doc
braces ([Doc] -> Doc
commasep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (SubExp -> Doc) -> [SubExp] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map SubExp -> Doc
forall a. Pretty a => a -> Doc
ppr [SubExp]
res)
| Bool
otherwise =
[Doc] -> Doc
stack ((Stm lore -> Doc) -> [Stm lore] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Stm lore -> Doc
forall a. Pretty a => a -> Doc
ppr ([Stm lore] -> [Doc]) -> [Stm lore] -> [Doc]
forall a b. (a -> b) -> a -> b
$ Stms lore -> [Stm lore]
forall lore. Stms lore -> [Stm lore]
stmsToList Stms lore
stms)
Doc -> Doc -> Doc
</> [Char] -> Doc
text [Char]
"in" Doc -> Doc -> Doc
<+> Doc -> Doc
braces ([Doc] -> Doc
commasep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (SubExp -> Doc) -> [SubExp] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map SubExp -> Doc
forall a. Pretty a => a -> Doc
ppr [SubExp]
res)
instance Pretty Attr where
ppr :: Attr -> Doc
ppr (AttrAtom Name
v) = Name -> Doc
forall a. Pretty a => a -> Doc
ppr Name
v
ppr (AttrComp Name
f [Attr]
attrs) = Name -> Doc
forall a. Pretty a => a -> Doc
ppr Name
f Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens ([Doc] -> Doc
commasep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Attr -> Doc) -> [Attr] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Attr -> Doc
forall a. Pretty a => a -> Doc
ppr [Attr]
attrs)
attrAnnots :: Attrs -> [Doc]
attrAnnots :: Attrs -> [Doc]
attrAnnots = (Attr -> Doc) -> [Attr] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Attr -> Doc
forall a. Pretty a => a -> Doc
f ([Attr] -> [Doc]) -> (Attrs -> [Attr]) -> Attrs -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Attr -> [Attr]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Set Attr -> [Attr]) -> (Attrs -> Set Attr) -> Attrs -> [Attr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attrs -> Set Attr
unAttrs
where
f :: a -> Doc
f a
v = [Char] -> Doc
text [Char]
"#[" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> a -> Doc
forall a. Pretty a => a -> Doc
ppr a
v Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Char] -> Doc
text [Char]
"]"
stmAttrAnnots :: Stm lore -> [Doc]
stmAttrAnnots :: Stm lore -> [Doc]
stmAttrAnnots = Attrs -> [Doc]
attrAnnots (Attrs -> [Doc]) -> (Stm lore -> Attrs) -> Stm lore -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StmAux (ExpDec lore) -> Attrs
forall dec. StmAux dec -> Attrs
stmAuxAttrs (StmAux (ExpDec lore) -> Attrs)
-> (Stm lore -> StmAux (ExpDec lore)) -> Stm lore -> Attrs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stm lore -> StmAux (ExpDec lore)
forall lore. Stm lore -> StmAux (ExpDec lore)
stmAux
instance Pretty (PatElemT dec) => Pretty (PatternT dec) where
ppr :: PatternT dec -> Doc
ppr PatternT dec
pat = [PatElemT dec] -> [PatElemT dec] -> Doc
forall a b. (Pretty a, Pretty b) => [a] -> [b] -> Doc
ppPattern (PatternT dec -> [PatElemT dec]
forall dec. PatternT dec -> [PatElemT dec]
patternContextElements PatternT dec
pat) (PatternT dec -> [PatElemT dec]
forall dec. PatternT dec -> [PatElemT dec]
patternValueElements PatternT dec
pat)
instance Pretty (PatElemT b) => Pretty (PatElemT (a, b)) where
ppr :: PatElemT (a, b) -> Doc
ppr = PatElemT b -> Doc
forall a. Pretty a => a -> Doc
ppr (PatElemT b -> Doc)
-> (PatElemT (a, b) -> PatElemT b) -> PatElemT (a, b) -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, b) -> b) -> PatElemT (a, b) -> PatElemT b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, b) -> b
forall a b. (a, b) -> b
snd
instance Pretty (PatElemT Type) where
ppr :: PatElemT Type -> Doc
ppr (PatElem VName
name Type
t) = Type -> Doc
forall a. Pretty a => a -> Doc
ppr Type
t Doc -> Doc -> Doc
<+> VName -> Doc
forall a. Pretty a => a -> Doc
ppr VName
name
instance Pretty (Param b) => Pretty (Param (a, b)) where
ppr :: Param (a, b) -> Doc
ppr = Param b -> Doc
forall a. Pretty a => a -> Doc
ppr (Param b -> Doc)
-> (Param (a, b) -> Param b) -> Param (a, b) -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, b) -> b) -> Param (a, b) -> Param b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, b) -> b
forall a b. (a, b) -> b
snd
instance Pretty (Param DeclType) where
ppr :: Param DeclType -> Doc
ppr (Param VName
name DeclType
t) =
DeclType -> Doc
forall a. Pretty a => a -> Doc
ppr DeclType
t
Doc -> Doc -> Doc
<+> VName -> Doc
forall a. Pretty a => a -> Doc
ppr VName
name
instance Pretty (Param Type) where
ppr :: Param Type -> Doc
ppr (Param VName
name Type
t) =
Type -> Doc
forall a. Pretty a => a -> Doc
ppr Type
t
Doc -> Doc -> Doc
<+> VName -> Doc
forall a. Pretty a => a -> Doc
ppr VName
name
instance PrettyLore lore => Pretty (Stm lore) where
ppr :: Stm lore -> Doc
ppr bnd :: Stm lore
bnd@(Let Pattern lore
pat (StmAux Certificates
cs Attrs
_ ExpDec lore
dec) Exp lore
e) =
Doc -> Doc
stmannot (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
Doc -> Doc
align (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
Int -> Doc -> Doc
hang Int
2 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
[Char] -> Doc
text [Char]
"let" Doc -> Doc -> Doc
<+> Doc -> Doc
align (Pattern lore -> Doc
forall a. Pretty a => a -> Doc
ppr Pattern lore
pat)
Doc -> Doc -> Doc
<+> case (Bool
linebreak, ExpDec lore -> Exp lore -> Maybe Doc
forall lore.
PrettyLore lore =>
ExpDec lore -> Exp lore -> Maybe Doc
ppExpLore ExpDec lore
dec Exp lore
e) of
(Bool
True, Maybe Doc
Nothing) -> Doc
equals Doc -> Doc -> Doc
</> Doc
e'
(Bool
_, Just Doc
ann) -> Doc
equals Doc -> Doc -> Doc
</> (Doc
ann Doc -> Doc -> Doc
</> Doc
e')
(Bool
False, Maybe Doc
Nothing) -> Doc
equals Doc -> Doc -> Doc
<+/> Doc
e'
where
e' :: Doc
e'
| Bool
linebreak = Certificates -> Doc
forall a. Pretty a => a -> Doc
ppr Certificates
cs Doc -> Doc -> Doc
</> Exp lore -> Doc
forall a. Pretty a => a -> Doc
ppr Exp lore
e
| Bool
otherwise = Certificates -> Doc
forall a. Pretty a => a -> Doc
ppr Certificates
cs Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Exp lore -> Doc
forall a. Pretty a => a -> Doc
ppr Exp lore
e
linebreak :: Bool
linebreak = case Exp lore
e of
DoLoop {} -> Bool
True
Op {} -> Bool
True
If {} -> Bool
True
Apply {} -> Bool
True
BasicOp ArrayLit {} -> Bool
False
BasicOp Assert {} -> Bool
True
Exp lore
_ -> Certificates
cs Certificates -> Certificates -> Bool
forall a. Eq a => a -> a -> Bool
/= Certificates
forall a. Monoid a => a
mempty
stmannot :: Doc -> Doc
stmannot =
case Stm lore -> [Doc]
forall lore. Stm lore -> [Doc]
stmAttrAnnots Stm lore
bnd
[Doc] -> [Doc] -> [Doc]
forall a. Semigroup a => a -> a -> a
<> (PatElemT (LetDec lore) -> Maybe Doc)
-> [PatElemT (LetDec lore)] -> [Doc]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe PatElemT (LetDec lore) -> Maybe Doc
forall a. PrettyAnnot a => a -> Maybe Doc
ppAnnot (Pattern lore -> [PatElemT (LetDec lore)]
forall dec. PatternT dec -> [PatElemT dec]
patternElements (Pattern lore -> [PatElemT (LetDec lore)])
-> Pattern lore -> [PatElemT (LetDec lore)]
forall a b. (a -> b) -> a -> b
$ Stm lore -> Pattern lore
forall lore. Stm lore -> Pattern lore
stmPattern Stm lore
bnd) of
[] -> Doc -> Doc
forall a. a -> a
id
[Doc]
annots -> (Doc -> Doc
align ([Doc] -> Doc
stack [Doc]
annots) Doc -> Doc -> Doc
</>)
instance Pretty BasicOp where
ppr :: BasicOp -> Doc
ppr (SubExp SubExp
se) = SubExp -> Doc
forall a. Pretty a => a -> Doc
ppr SubExp
se
ppr (Opaque SubExp
e) = [Char] -> Doc
text [Char]
"opaque" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
apply [SubExp -> Doc
forall a. Pretty a => a -> Doc
ppr SubExp
e]
ppr (ArrayLit [] Type
rt) =
[Char] -> Doc
text [Char]
"empty" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens (Type -> Doc
forall a. Pretty a => a -> Doc
ppr Type
rt)
ppr (ArrayLit [SubExp]
es Type
rt) =
case Type
rt of
Array {} -> Doc -> Doc
brackets (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
commastack ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (SubExp -> Doc) -> [SubExp] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map SubExp -> Doc
forall a. Pretty a => a -> Doc
ppr [SubExp]
es
Type
_ -> Doc -> Doc
brackets (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
commasep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (SubExp -> Doc) -> [SubExp] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map SubExp -> Doc
forall a. Pretty a => a -> Doc
ppr [SubExp]
es
ppr (BinOp BinOp
bop SubExp
x SubExp
y) = BinOp -> Doc
forall a. Pretty a => a -> Doc
ppr BinOp
bop Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens (SubExp -> Doc
forall a. Pretty a => a -> Doc
ppr SubExp
x Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
comma Doc -> Doc -> Doc
<+> SubExp -> Doc
forall a. Pretty a => a -> Doc
ppr SubExp
y)
ppr (CmpOp CmpOp
op SubExp
x SubExp
y) = CmpOp -> Doc
forall a. Pretty a => a -> Doc
ppr CmpOp
op Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens (SubExp -> Doc
forall a. Pretty a => a -> Doc
ppr SubExp
x Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
comma Doc -> Doc -> Doc
<+> SubExp -> Doc
forall a. Pretty a => a -> Doc
ppr SubExp
y)
ppr (ConvOp ConvOp
conv SubExp
x) =
[Char] -> Doc
text (ConvOp -> [Char]
convOpFun ConvOp
conv) Doc -> Doc -> Doc
<+> PrimType -> Doc
forall a. Pretty a => a -> Doc
ppr PrimType
fromtype Doc -> Doc -> Doc
<+> SubExp -> Doc
forall a. Pretty a => a -> Doc
ppr SubExp
x Doc -> Doc -> Doc
<+> [Char] -> Doc
text [Char]
"to" Doc -> Doc -> Doc
<+> PrimType -> Doc
forall a. Pretty a => a -> Doc
ppr PrimType
totype
where
(PrimType
fromtype, PrimType
totype) = ConvOp -> (PrimType, PrimType)
convOpType ConvOp
conv
ppr (UnOp UnOp
op SubExp
e) = UnOp -> Doc
forall a. Pretty a => a -> Doc
ppr UnOp
op Doc -> Doc -> Doc
<+> Int -> SubExp -> Doc
forall a. Pretty a => Int -> a -> Doc
pprPrec Int
9 SubExp
e
ppr (Index VName
v Slice SubExp
idxs) =
VName -> Doc
forall a. Pretty a => a -> Doc
ppr VName
v Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
brackets ([Doc] -> Doc
commasep ((DimIndex SubExp -> Doc) -> Slice SubExp -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map DimIndex SubExp -> Doc
forall a. Pretty a => a -> Doc
ppr Slice SubExp
idxs))
ppr (Update VName
src Slice SubExp
idxs SubExp
se) =
VName -> Doc
forall a. Pretty a => a -> Doc
ppr VName
src Doc -> Doc -> Doc
<+> [Char] -> Doc
text [Char]
"with" Doc -> Doc -> Doc
<+> Doc -> Doc
brackets ([Doc] -> Doc
commasep ((DimIndex SubExp -> Doc) -> Slice SubExp -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map DimIndex SubExp -> Doc
forall a. Pretty a => a -> Doc
ppr Slice SubExp
idxs))
Doc -> Doc -> Doc
<+> [Char] -> Doc
text [Char]
"<-"
Doc -> Doc -> Doc
<+> SubExp -> Doc
forall a. Pretty a => a -> Doc
ppr SubExp
se
ppr (Iota SubExp
e SubExp
x SubExp
s IntType
et) = [Char] -> Doc
text [Char]
"iota" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
et' Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
apply [SubExp -> Doc
forall a. Pretty a => a -> Doc
ppr SubExp
e, SubExp -> Doc
forall a. Pretty a => a -> Doc
ppr SubExp
x, SubExp -> Doc
forall a. Pretty a => a -> Doc
ppr SubExp
s]
where
et' :: Doc
et' = [Char] -> Doc
text ([Char] -> Doc) -> [Char] -> Doc
forall a b. (a -> b) -> a -> b
$ Int -> [Char]
forall a. Show a => a -> [Char]
show (Int -> [Char]) -> Int -> [Char]
forall a b. (a -> b) -> a -> b
$ PrimType -> Int
primBitSize (PrimType -> Int) -> PrimType -> Int
forall a b. (a -> b) -> a -> b
$ IntType -> PrimType
IntType IntType
et
ppr (Replicate Shape
ne SubExp
ve) =
[Char] -> Doc
text [Char]
"replicate" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
apply [Shape -> Doc
forall a. Pretty a => a -> Doc
ppr Shape
ne, Doc -> Doc
align (SubExp -> Doc
forall a. Pretty a => a -> Doc
ppr SubExp
ve)]
ppr (Scratch PrimType
t [SubExp]
shape) =
[Char] -> Doc
text [Char]
"scratch" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
apply (PrimType -> Doc
forall a. Pretty a => a -> Doc
ppr PrimType
t Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (SubExp -> Doc) -> [SubExp] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map SubExp -> Doc
forall a. Pretty a => a -> Doc
ppr [SubExp]
shape)
ppr (Reshape ShapeChange SubExp
shape VName
e) =
[Char] -> Doc
text [Char]
"reshape" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
apply [[Doc] -> Doc
apply ((DimChange SubExp -> Doc) -> ShapeChange SubExp -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map DimChange SubExp -> Doc
forall a. Pretty a => a -> Doc
ppr ShapeChange SubExp
shape), VName -> Doc
forall a. Pretty a => a -> Doc
ppr VName
e]
ppr (Rearrange [Int]
perm VName
e) =
[Char] -> Doc
text [Char]
"rearrange" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
apply [[Doc] -> Doc
apply ((Int -> Doc) -> [Int] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Doc
forall a. Pretty a => a -> Doc
ppr [Int]
perm), VName -> Doc
forall a. Pretty a => a -> Doc
ppr VName
e]
ppr (Rotate [SubExp]
es VName
e) =
[Char] -> Doc
text [Char]
"rotate" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
apply [[Doc] -> Doc
apply ((SubExp -> Doc) -> [SubExp] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map SubExp -> Doc
forall a. Pretty a => a -> Doc
ppr [SubExp]
es), VName -> Doc
forall a. Pretty a => a -> Doc
ppr VName
e]
ppr (Concat Int
i VName
x [VName]
ys SubExp
_) =
[Char] -> Doc
text [Char]
"concat" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Char] -> Doc
text [Char]
"@" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Doc
forall a. Pretty a => a -> Doc
ppr Int
i Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
apply (VName -> Doc
forall a. Pretty a => a -> Doc
ppr VName
x Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (VName -> Doc) -> [VName] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map VName -> Doc
forall a. Pretty a => a -> Doc
ppr [VName]
ys)
ppr (Copy VName
e) = [Char] -> Doc
text [Char]
"copy" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens (VName -> Doc
forall a. Pretty a => a -> Doc
ppr VName
e)
ppr (Manifest [Int]
perm VName
e) = [Char] -> Doc
text [Char]
"manifest" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
apply [[Doc] -> Doc
apply ((Int -> Doc) -> [Int] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Doc
forall a. Pretty a => a -> Doc
ppr [Int]
perm), VName -> Doc
forall a. Pretty a => a -> Doc
ppr VName
e]
ppr (Assert SubExp
e ErrorMsg SubExp
msg (SrcLoc
loc, [SrcLoc]
_)) =
[Char] -> Doc
text [Char]
"assert" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
apply [SubExp -> Doc
forall a. Pretty a => a -> Doc
ppr SubExp
e, ErrorMsg SubExp -> Doc
forall a. Pretty a => a -> Doc
ppr ErrorMsg SubExp
msg, [Char] -> Doc
text ([Char] -> Doc) -> [Char] -> Doc
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
forall a. Show a => a -> [Char]
show ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ SrcLoc -> [Char]
forall a. Located a => a -> [Char]
locStr SrcLoc
loc]
instance Pretty a => Pretty (ErrorMsg a) where
ppr :: ErrorMsg a -> Doc
ppr (ErrorMsg [ErrorMsgPart a]
parts) = [Doc] -> Doc
commasep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (ErrorMsgPart a -> Doc) -> [ErrorMsgPart a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ErrorMsgPart a -> Doc
forall a. Pretty a => ErrorMsgPart a -> Doc
p [ErrorMsgPart a]
parts
where
p :: ErrorMsgPart a -> Doc
p (ErrorString [Char]
s) = [Char] -> Doc
text ([Char] -> Doc) -> [Char] -> Doc
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
s
p (ErrorInt32 a
x) = a -> Doc
forall a. Pretty a => a -> Doc
ppr a
x
p (ErrorInt64 a
x) = a -> Doc
forall a. Pretty a => a -> Doc
ppr a
x
instance PrettyLore lore => Pretty (Exp lore) where
ppr :: Exp lore -> Doc
ppr (If SubExp
c BodyT lore
t BodyT lore
f (IfDec [BranchType lore]
_ IfSort
ifsort)) =
[Char] -> Doc
text [Char]
"if" Doc -> Doc -> Doc
<+> Doc
info' Doc -> Doc -> Doc
<+> SubExp -> Doc
forall a. Pretty a => a -> Doc
ppr SubExp
c
Doc -> Doc -> Doc
</> [Char] -> Doc
text [Char]
"then"
Doc -> Doc -> Doc
<+> BodyT lore -> Doc
forall lore. PrettyLore lore => Body lore -> Doc
maybeNest BodyT lore
t
Doc -> Doc -> Doc
<+> [Char] -> Doc
text [Char]
"else"
Doc -> Doc -> Doc
<+> BodyT lore -> Doc
forall lore. PrettyLore lore => Body lore -> Doc
maybeNest BodyT lore
f
where
info' :: Doc
info' = case IfSort
ifsort of
IfSort
IfNormal -> Doc
forall a. Monoid a => a
mempty
IfSort
IfFallback -> [Char] -> Doc
text [Char]
"<fallback>"
IfSort
IfEquiv -> [Char] -> Doc
text [Char]
"<equiv>"
maybeNest :: BodyT lore -> Doc
maybeNest BodyT lore
b
| Seq (Stm lore) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Seq (Stm lore) -> Bool) -> Seq (Stm lore) -> Bool
forall a b. (a -> b) -> a -> b
$ BodyT lore -> Seq (Stm lore)
forall lore. BodyT lore -> Stms lore
bodyStms BodyT lore
b = BodyT lore -> Doc
forall a. Pretty a => a -> Doc
ppr BodyT lore
b
| Bool
otherwise = [Char] -> [Char] -> Doc -> Doc
nestedBlock [Char]
"{" [Char]
"}" (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ BodyT lore -> Doc
forall a. Pretty a => a -> Doc
ppr BodyT lore
b
ppr (BasicOp BasicOp
op) = BasicOp -> Doc
forall a. Pretty a => a -> Doc
ppr BasicOp
op
ppr (Apply Name
fname [(SubExp, Diet)]
args [RetType lore]
_ (Safety
safety, SrcLoc
_, [SrcLoc]
_)) =
[Char] -> Doc
text (Name -> [Char]
nameToString Name
fname) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
safety' Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
apply (((SubExp, Diet) -> Doc) -> [(SubExp, Diet)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Doc -> Doc
align (Doc -> Doc) -> ((SubExp, Diet) -> Doc) -> (SubExp, Diet) -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SubExp, Diet) -> Doc
forall a. Pretty a => (a, Diet) -> Doc
pprArg) [(SubExp, Diet)]
args)
where
pprArg :: (a, Diet) -> Doc
pprArg (a
arg, Diet
Consume) = [Char] -> Doc
text [Char]
"*" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> a -> Doc
forall a. Pretty a => a -> Doc
ppr a
arg
pprArg (a
arg, Diet
_) = a -> Doc
forall a. Pretty a => a -> Doc
ppr a
arg
safety' :: Doc
safety' = case Safety
safety of
Safety
Unsafe -> [Char] -> Doc
text [Char]
"<unsafe>"
Safety
Safe -> Doc
forall a. Monoid a => a
mempty
ppr (Op Op lore
op) = Op lore -> Doc
forall a. Pretty a => a -> Doc
ppr Op lore
op
ppr (DoLoop [(FParam lore, SubExp)]
ctx [(FParam lore, SubExp)]
val LoopForm lore
form BodyT lore
loopbody) =
[Doc] -> Doc -> Doc
annot ((FParam lore -> Maybe Doc) -> [FParam lore] -> [Doc]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe FParam lore -> Maybe Doc
forall a. PrettyAnnot a => a -> Maybe Doc
ppAnnot ([FParam lore]
ctxparams [FParam lore] -> [FParam lore] -> [FParam lore]
forall a. [a] -> [a] -> [a]
++ [FParam lore]
valparams)) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
[Char] -> Doc
text [Char]
"loop" Doc -> Doc -> Doc
<+> [FParam lore] -> [FParam lore] -> Doc
forall a b. (Pretty a, Pretty b) => [a] -> [b] -> Doc
ppPattern [FParam lore]
ctxparams [FParam lore]
valparams
Doc -> Doc -> Doc
<+> Doc
equals
Doc -> Doc -> Doc
<+> [SubExp] -> Doc
forall a. Pretty a => [a] -> Doc
ppTuple' ([SubExp]
ctxinit [SubExp] -> [SubExp] -> [SubExp]
forall a. [a] -> [a] -> [a]
++ [SubExp]
valinit)
Doc -> Doc -> Doc
</> ( case LoopForm lore
form of
ForLoop VName
i IntType
it SubExp
bound [] ->
[Char] -> Doc
text [Char]
"for"
Doc -> Doc -> Doc
<+> Doc -> Doc
align
( VName -> Doc
forall a. Pretty a => a -> Doc
ppr VName
i Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Char] -> Doc
text [Char]
":" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> IntType -> Doc
forall a. Pretty a => a -> Doc
ppr IntType
it
Doc -> Doc -> Doc
<+> [Char] -> Doc
text [Char]
"<"
Doc -> Doc -> Doc
<+> Doc -> Doc
align (SubExp -> Doc
forall a. Pretty a => a -> Doc
ppr SubExp
bound)
)
ForLoop VName
i IntType
it SubExp
bound [(LParam lore, VName)]
loop_vars ->
[Doc] -> Doc -> Doc
annot (((LParam lore, VName) -> Maybe Doc)
-> [(LParam lore, VName)] -> [Doc]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (LParam lore -> Maybe Doc
forall a. PrettyAnnot a => a -> Maybe Doc
ppAnnot (LParam lore -> Maybe Doc)
-> ((LParam lore, VName) -> LParam lore)
-> (LParam lore, VName)
-> Maybe Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LParam lore, VName) -> LParam lore
forall a b. (a, b) -> a
fst) [(LParam lore, VName)]
loop_vars) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
[Char] -> Doc
text [Char]
"for"
Doc -> Doc -> Doc
<+> Doc -> Doc
align
( VName -> Doc
forall a. Pretty a => a -> Doc
ppr VName
i Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Char] -> Doc
text [Char]
":" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> IntType -> Doc
forall a. Pretty a => a -> Doc
ppr IntType
it
Doc -> Doc -> Doc
<+> [Char] -> Doc
text [Char]
"<"
Doc -> Doc -> Doc
<+> Doc -> Doc
align (SubExp -> Doc
forall a. Pretty a => a -> Doc
ppr SubExp
bound)
Doc -> Doc -> Doc
</> [Doc] -> Doc
stack (((LParam lore, VName) -> Doc) -> [(LParam lore, VName)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (LParam lore, VName) -> Doc
forall a a. (Pretty a, Pretty a) => (a, a) -> Doc
pprLoopVar [(LParam lore, VName)]
loop_vars)
)
WhileLoop VName
cond ->
[Char] -> Doc
text [Char]
"while" Doc -> Doc -> Doc
<+> VName -> Doc
forall a. Pretty a => a -> Doc
ppr VName
cond
)
Doc -> Doc -> Doc
<+> [Char] -> Doc
text [Char]
"do"
Doc -> Doc -> Doc
<+> [Char] -> [Char] -> Doc -> Doc
nestedBlock [Char]
"{" [Char]
"}" (BodyT lore -> Doc
forall a. Pretty a => a -> Doc
ppr BodyT lore
loopbody)
where
([FParam lore]
ctxparams, [SubExp]
ctxinit) = [(FParam lore, SubExp)] -> ([FParam lore], [SubExp])
forall a b. [(a, b)] -> ([a], [b])
unzip [(FParam lore, SubExp)]
ctx
([FParam lore]
valparams, [SubExp]
valinit) = [(FParam lore, SubExp)] -> ([FParam lore], [SubExp])
forall a b. [(a, b)] -> ([a], [b])
unzip [(FParam lore, SubExp)]
val
pprLoopVar :: (a, a) -> Doc
pprLoopVar (a
p, a
a) = a -> Doc
forall a. Pretty a => a -> Doc
ppr a
p Doc -> Doc -> Doc
<+> [Char] -> Doc
text [Char]
"in" Doc -> Doc -> Doc
<+> a -> Doc
forall a. Pretty a => a -> Doc
ppr a
a
instance PrettyLore lore => Pretty (Lambda lore) where
ppr :: Lambda lore -> Doc
ppr (Lambda [] BodyT lore
_ []) = [Char] -> Doc
text [Char]
"nilFn"
ppr (Lambda [LParam lore]
params BodyT lore
body [Type]
rettype) =
[Doc] -> Doc -> Doc
annot ((LParam lore -> Maybe Doc) -> [LParam lore] -> [Doc]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe LParam lore -> Maybe Doc
forall a. PrettyAnnot a => a -> Maybe Doc
ppAnnot [LParam lore]
params) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
[Char] -> Doc
text [Char]
"fn" Doc -> Doc -> Doc
<+> [Type] -> Doc
forall a. Pretty a => [a] -> Doc
ppTuple' [Type]
rettype
Doc -> Doc -> Doc
<+/> Doc -> Doc
align (Doc -> Doc
parens ([Doc] -> Doc
commasep ((LParam lore -> Doc) -> [LParam lore] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map LParam lore -> Doc
forall a. Pretty a => a -> Doc
ppr [LParam lore]
params)))
Doc -> Doc -> Doc
<+> [Char] -> Doc
text [Char]
"=>" Doc -> Doc -> Doc
</> Int -> Doc -> Doc
indent Int
2 (BodyT lore -> Doc
forall a. Pretty a => a -> Doc
ppr BodyT lore
body)
instance PrettyLore lore => Pretty (FunDef lore) where
ppr :: FunDef lore -> Doc
ppr (FunDef Maybe EntryPoint
entry Attrs
attrs Name
name [RetType lore]
rettype [FParam lore]
fparams BodyT lore
body) =
[Doc] -> Doc -> Doc
annot ((FParam lore -> Maybe Doc) -> [FParam lore] -> [Doc]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe FParam lore -> Maybe Doc
forall a. PrettyAnnot a => a -> Maybe Doc
ppAnnot [FParam lore]
fparams [Doc] -> [Doc] -> [Doc]
forall a. Semigroup a => a -> a -> a
<> Attrs -> [Doc]
attrAnnots Attrs
attrs) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
[Char] -> Doc
text [Char]
fun Doc -> Doc -> Doc
<+> [RetType lore] -> Doc
forall a. Pretty a => [a] -> Doc
ppTuple' [RetType lore]
rettype
Doc -> Doc -> Doc
<+/> [Char] -> Doc
text (Name -> [Char]
nameToString Name
name)
Doc -> Doc -> Doc
<+> [Doc] -> Doc
apply ((FParam lore -> Doc) -> [FParam lore] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map FParam lore -> Doc
forall a. Pretty a => a -> Doc
ppr [FParam lore]
fparams)
Doc -> Doc -> Doc
<+> Doc
equals
Doc -> Doc -> Doc
<+> [Char] -> [Char] -> Doc -> Doc
nestedBlock [Char]
"{" [Char]
"}" (BodyT lore -> Doc
forall a. Pretty a => a -> Doc
ppr BodyT lore
body)
where
fun :: [Char]
fun
| Maybe EntryPoint -> Bool
forall a. Maybe a -> Bool
isJust Maybe EntryPoint
entry = [Char]
"entry"
| Bool
otherwise = [Char]
"fun"
instance PrettyLore lore => Pretty (Prog lore) where
ppr :: Prog lore -> Doc
ppr (Prog Stms lore
consts [FunDef lore]
funs) =
[Doc] -> Doc
stack ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate Doc
line ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ Stms lore -> Doc
forall a. Pretty a => a -> Doc
ppr Stms lore
consts Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (FunDef lore -> Doc) -> [FunDef lore] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map FunDef lore -> Doc
forall a. Pretty a => a -> Doc
ppr [FunDef lore]
funs
instance Pretty d => Pretty (DimChange d) where
ppr :: DimChange d -> Doc
ppr (DimCoercion d
se) = [Char] -> Doc
text [Char]
"~" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> d -> Doc
forall a. Pretty a => a -> Doc
ppr d
se
ppr (DimNew d
se) = d -> Doc
forall a. Pretty a => a -> Doc
ppr d
se
instance Pretty d => Pretty (DimIndex d) where
ppr :: DimIndex d -> Doc
ppr (DimFix d
i) = d -> Doc
forall a. Pretty a => a -> Doc
ppr d
i
ppr (DimSlice d
i d
n d
s) = d -> Doc
forall a. Pretty a => a -> Doc
ppr d
i Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Char] -> Doc
text [Char]
":+" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> d -> Doc
forall a. Pretty a => a -> Doc
ppr d
n Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Char] -> Doc
text [Char]
"*" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> d -> Doc
forall a. Pretty a => a -> Doc
ppr d
s
ppPattern :: (Pretty a, Pretty b) => [a] -> [b] -> Doc
ppPattern :: [a] -> [b] -> Doc
ppPattern [] [b]
bs = Doc -> Doc
braces (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
commasep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (b -> Doc) -> [b] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map b -> Doc
forall a. Pretty a => a -> Doc
ppr [b]
bs
ppPattern [a]
as [b]
bs = Doc -> Doc
braces (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
commasep ((a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map a -> Doc
forall a. Pretty a => a -> Doc
ppr [a]
as) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi Doc -> Doc -> Doc
</> [Doc] -> Doc
commasep ((b -> Doc) -> [b] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map b -> Doc
forall a. Pretty a => a -> Doc
ppr [b]
bs)
ppTuple' :: Pretty a => [a] -> Doc
ppTuple' :: [a] -> Doc
ppTuple' [a]
ets = Doc -> Doc
braces (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
commasep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map a -> Doc
forall a. Pretty a => a -> Doc
ppr [a]
ets