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

-- | Futhark prettyprinter.  This module defines 'Pretty' instances
-- for the AST defined in "Futhark.IR.Syntax",
-- but also a number of convenience functions if you don't want to use
-- the interface from 'Pretty'.
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

-- | The class of representations whose annotations can be prettyprinted.
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 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 {k} (rep :: k). 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 {k} (rep :: k). 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 {k} (rep :: k) 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 {k} (rep :: k). 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 {k} (rep :: k) 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 {k} (rep :: k). 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 {k} (rep :: k) 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 {k} (rep :: k) a. Stm rep -> [Doc a]
stmAttrAnnots Stm rep
stm,
            forall {k} (rep :: k) 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 {k} (rep :: k) 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 {k} (rep :: k). 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 {k} (rep :: k) 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 {k} (rep :: k) 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 {k} (rep :: k) 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
ppTuple' (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 {k} (rep :: k) 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
ppTuple' (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 a. [Doc a] -> Doc a
ppTuple' (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 b. Pretty a => [a] -> Doc b
ppTupleLines' [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 -> String
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 String
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 String
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 a. [Doc a] -> Doc a
apply (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
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 [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 b. Pretty a => [a] -> Doc b
ppTupleLines' [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 b. Pretty a => [a] -> Doc b
ppTupleLines' [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 [(String, 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 [(String, 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

-- | Like 'prettyTupleLines', but produces a 'Doc'.
ppTupleLines' :: Pretty a => [a] -> Doc b
ppTupleLines' :: forall a b. Pretty a => [a] -> Doc b
ppTupleLines' = forall ann. Doc ann -> Doc ann
braces forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Doc a] -> Doc a
stack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate forall ann. Doc ann
comma forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 -> Doc ann
pretty)