{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# 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,
    pretty,
    PrettyRep (..),
    ppTuple',
  )
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
  ppExpDec ExpDec rep
_ Exp rep
_ = forall a. Maybe a
Nothing

instance Pretty VName where
  ppr :: VName -> Doc
ppr (VName Name
vn Int
i) = forall a. Pretty a => a -> Doc
ppr Name
vn forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"_" forall a. Semigroup a => a -> a -> a
<> String -> Doc
text (forall a. Show a => a -> String
show Int
i)

instance Pretty Commutativity where
  ppr :: Commutativity -> Doc
ppr Commutativity
Commutative = String -> Doc
text String
"commutative"
  ppr Commutativity
Noncommutative = String -> Doc
text String
"noncommutative"

instance Pretty NoUniqueness where
  ppr :: NoUniqueness -> Doc
ppr NoUniqueness
_ = forall a. Monoid a => a
mempty

instance Pretty Shape where
  ppr :: Shape -> Doc
ppr = 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 (Doc -> Doc
brackets forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> Doc
ppr) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall d. ShapeBase d -> [d]
shapeDims

instance Pretty Rank where
  ppr :: Rank -> Doc
ppr (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
"[]"

instance Pretty a => Pretty (Ext a) where
  ppr :: Ext a -> Doc
ppr (Free a
e) = forall a. Pretty a => a -> Doc
ppr a
e
  ppr (Ext Int
x) = String -> Doc
text String
"?" forall a. Semigroup a => a -> a -> a
<> String -> Doc
text (forall a. Show a => a -> String
show Int
x)

instance Pretty ExtShape where
  ppr :: ExtShape -> Doc
ppr = 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 (Doc -> Doc
brackets forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> Doc
ppr) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall d. ShapeBase d -> [d]
shapeDims

instance Pretty Space where
  ppr :: Space -> Doc
ppr Space
DefaultSpace = forall a. Monoid a => a
mempty
  ppr (Space String
s) = String -> Doc
text String
"@" forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
s
  ppr (ScalarSpace [SubExp]
d PrimType
t) = String -> Doc
text String
"@" forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map (Doc -> Doc
brackets forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> Doc
ppr) [SubExp]
d) forall a. Semigroup a => a -> a -> a
<> 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
t) = forall a. Pretty a => a -> Doc
ppr PrimType
t
  ppr (Acc VName
acc Shape
ispace [Type]
ts u
u) =
    forall a. Pretty a => a -> Doc
ppr u
u forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"acc" forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
apply [forall a. Pretty a => a -> Doc
ppr VName
acc, forall a. Pretty a => a -> Doc
ppr Shape
ispace, forall a. Pretty a => [a] -> Doc
ppTuple' [Type]
ts]
  ppr (Array PrimType
et (Shape [SubExp]
ds) u
u) =
    forall a. Pretty a => a -> Doc
ppr u
u forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map (Doc -> Doc
brackets forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> Doc
ppr) [SubExp]
ds) forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Doc
ppr PrimType
et
  ppr (Mem Space
s) = String -> Doc
text String
"mem" forall a. Semigroup a => a -> a -> a
<> 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
t) = forall a. Pretty a => a -> Doc
ppr PrimType
t
  ppr (Acc VName
acc Shape
ispace [Type]
ts u
u) =
    forall a. Pretty a => a -> Doc
ppr u
u forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"acc" forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
apply [forall a. Pretty a => a -> Doc
ppr VName
acc, forall a. Pretty a => a -> Doc
ppr Shape
ispace, forall a. Pretty a => [a] -> Doc
ppTuple' [Type]
ts]
  ppr (Array PrimType
et (Shape [ExtSize]
ds) u
u) =
    forall a. Pretty a => a -> Doc
ppr u
u forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map (Doc -> Doc
brackets forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> Doc
ppr) [ExtSize]
ds) forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Doc
ppr PrimType
et
  ppr (Mem Space
s) = String -> Doc
text String
"mem" forall a. Semigroup a => a -> a -> a
<> 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
t) = forall a. Pretty a => a -> Doc
ppr PrimType
t
  ppr (Acc VName
acc Shape
ispace [Type]
ts u
u) =
    forall a. Pretty a => a -> Doc
ppr u
u forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"acc" forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
apply [forall a. Pretty a => a -> Doc
ppr VName
acc, forall a. Pretty a => a -> Doc
ppr Shape
ispace, forall a. Pretty a => [a] -> Doc
ppTuple' [Type]
ts]
  ppr (Array PrimType
et (Rank Int
n) u
u) =
    forall a. Pretty a => a -> Doc
ppr 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
$ Doc -> Doc
brackets forall a. Monoid a => a
mempty) forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Doc
ppr PrimType
et
  ppr (Mem Space
s) = String -> Doc
text String
"mem" forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Doc
ppr Space
s

instance Pretty Ident where
  ppr :: Ident -> Doc
ppr Ident
ident = forall a. Pretty a => a -> Doc
ppr (Ident -> Type
identType Ident
ident) Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
ppr (Ident -> VName
identName Ident
ident)

instance Pretty SubExp where
  ppr :: SubExp -> Doc
ppr (Var VName
v) = forall a. Pretty a => a -> Doc
ppr VName
v
  ppr (Constant PrimValue
v) = forall a. Pretty a => a -> Doc
ppr PrimValue
v

instance Pretty Certs where
  ppr :: Certs -> Doc
ppr (Certs []) = Doc
empty
  ppr (Certs [VName]
cs) = String -> Doc
text String
"#" forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
braces ([Doc] -> Doc
commasep (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
ppr [VName]
cs))

instance PrettyRep rep => Pretty (Stms rep) where
  ppr :: Stms rep -> Doc
ppr = [Doc] -> Doc
stack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
ppr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall rep. Stms rep -> [Stm rep]
stmsToList

instance Pretty SubExpRes where
  ppr :: SubExpRes -> Doc
ppr (SubExpRes Certs
cs SubExp
se) = [Doc] -> Doc
spread forall a b. (a -> b) -> a -> b
$ Certs -> [Doc]
certAnnots Certs
cs forall a. [a] -> [a] -> [a]
++ [forall a. Pretty a => a -> Doc
ppr SubExp
se]

instance PrettyRep rep => Pretty (Body rep) where
  ppr :: Body rep -> Doc
ppr (Body BodyDec rep
_ Stms rep
stms [SubExpRes]
res)
    | forall (t :: * -> *) a. Foldable t => t a -> Bool
null Stms rep
stms = Doc -> Doc
braces ([Doc] -> Doc
commasep forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
ppr [SubExpRes]
res)
    | Bool
otherwise =
        [Doc] -> Doc
stack (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
ppr forall a b. (a -> b) -> a -> b
$ forall rep. Stms rep -> [Stm rep]
stmsToList Stms rep
stms)
          Doc -> Doc -> Doc
</> String -> Doc
text String
"in"
          Doc -> Doc -> Doc
<+> Doc -> Doc
braces ([Doc] -> Doc
commasep forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
ppr [SubExpRes]
res)

instance Pretty Attr where
  ppr :: Attr -> Doc
ppr (AttrName Name
v) = forall a. Pretty a => a -> Doc
ppr Name
v
  ppr (AttrInt Integer
x) = forall a. Pretty a => a -> Doc
ppr Integer
x
  ppr (AttrComp Name
f [Attr]
attrs) = forall a. Pretty a => a -> Doc
ppr Name
f forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens ([Doc] -> Doc
commasep forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
ppr [Attr]
attrs)

attrAnnots :: Attrs -> [Doc]
attrAnnots :: Attrs -> [Doc]
attrAnnots = forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
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
f a
v = String -> Doc
text String
"#[" forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Doc
ppr a
v forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"]"

stmAttrAnnots :: Stm rep -> [Doc]
stmAttrAnnots :: forall rep. Stm rep -> [Doc]
stmAttrAnnots = Attrs -> [Doc]
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]
certAnnots :: Certs -> [Doc]
certAnnots Certs
cs
  | Certs
cs forall a. Eq a => a -> a -> Bool
== forall a. Monoid a => a
mempty = []
  | Bool
otherwise = [forall a. Pretty a => a -> Doc
ppr Certs
cs]

stmCertAnnots :: Stm rep -> [Doc]
stmCertAnnots :: forall rep. Stm rep -> [Doc]
stmCertAnnots = Certs -> [Doc]
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
  ppr :: Attrs -> Doc
ppr = [Doc] -> Doc
spread forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attrs -> [Doc]
attrAnnots

instance Pretty t => Pretty (Pat t) where
  ppr :: Pat t -> Doc
ppr (Pat [PatElem t]
xs) = Doc -> Doc
braces forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
commastack forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
ppr [PatElem t]
xs

instance Pretty t => Pretty (PatElem t) where
  ppr :: PatElem t -> Doc
ppr (PatElem VName
name t
t) = forall a. Pretty a => a -> Doc
ppr VName
name Doc -> Doc -> Doc
<+> Doc
colon Doc -> Doc -> Doc
<+> Doc -> Doc
align (forall a. Pretty a => a -> Doc
ppr t
t)

instance Pretty t => Pretty (Param t) where
  ppr :: Param t -> Doc
ppr (Param Attrs
attrs VName
name t
t) =
    [Doc] -> Doc -> Doc
annot (Attrs -> [Doc]
attrAnnots Attrs
attrs) forall a b. (a -> b) -> a -> b
$ forall a. Pretty a => a -> Doc
ppr VName
name Doc -> Doc -> Doc
<+> Doc
colon Doc -> Doc -> Doc
<+> Doc -> Doc
align (forall a. Pretty a => a -> Doc
ppr t
t)

instance PrettyRep rep => Pretty (Stm rep) where
  ppr :: Stm rep -> Doc
ppr stm :: Stm rep
stm@(Let Pat (LetDec rep)
pat StmAux (ExpDec rep)
aux Exp rep
e) =
    Doc -> Doc
align forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Doc -> Doc
hang Int
2 forall a b. (a -> b) -> a -> b
$
      String -> Doc
text String
"let"
        Doc -> Doc -> Doc
<+> Doc -> Doc
align (forall a. Pretty a => a -> Doc
ppr Pat (LetDec rep)
pat)
        Doc -> Doc -> Doc
<+> case (Bool
linebreak, [Doc]
stmannot) of
          (Bool
True, []) -> Doc
equals Doc -> Doc -> Doc
</> forall a. Pretty a => a -> Doc
ppr Exp rep
e
          (Bool
False, []) -> Doc
equals Doc -> Doc -> Doc
<+/> forall a. Pretty a => a -> Doc
ppr Exp rep
e
          (Bool
_, [Doc]
ann) -> Doc
equals Doc -> Doc -> Doc
</> ([Doc] -> Doc
stack [Doc]
ann Doc -> Doc -> Doc
</> forall a. Pretty a => a -> Doc
ppr 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]
stmannot =
        forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
          [ forall a. Maybe a -> [a]
maybeToList (forall rep. PrettyRep rep => ExpDec rep -> Exp rep -> Maybe Doc
ppExpDec (forall dec. StmAux dec -> dec
stmAuxDec StmAux (ExpDec rep)
aux) Exp rep
e),
            forall rep. Stm rep -> [Doc]
stmAttrAnnots Stm rep
stm,
            forall rep. Stm rep -> [Doc]
stmCertAnnots Stm rep
stm
          ]

instance Pretty a => Pretty (Slice a) where
  ppr :: Slice a -> Doc
ppr (Slice [DimIndex a]
xs) = Doc -> Doc
brackets ([Doc] -> Doc
commasep (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
ppr [DimIndex a]
xs))

instance Pretty d => Pretty (FlatDimIndex d) where
  ppr :: FlatDimIndex d -> Doc
ppr (FlatDimIndex d
n d
s) = forall a. Pretty a => a -> Doc
ppr d
n Doc -> Doc -> Doc
<+> String -> Doc
text String
":" Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
ppr d
s

instance Pretty a => Pretty (FlatSlice a) where
  ppr :: FlatSlice a -> Doc
ppr (FlatSlice a
offset [FlatDimIndex a]
xs) = Doc -> Doc
brackets (forall a. Pretty a => a -> Doc
ppr a
offset forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
";" Doc -> Doc -> Doc
<+> [Doc] -> Doc
commasep (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
ppr [FlatDimIndex a]
xs))

instance Pretty BasicOp where
  ppr :: BasicOp -> Doc
ppr (SubExp SubExp
se) = forall a. Pretty a => a -> Doc
ppr SubExp
se
  ppr (Opaque OpaqueOp
OpaqueNil SubExp
e) = String -> Doc
text String
"opaque" forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
apply [forall a. Pretty a => a -> Doc
ppr SubExp
e]
  ppr (Opaque (OpaqueTrace String
s) SubExp
e) = String -> Doc
text String
"trace" forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
apply [forall a. Pretty a => a -> Doc
ppr (forall a. Show a => a -> String
show String
s), forall a. Pretty a => a -> Doc
ppr SubExp
e]
  ppr (ArrayLit [SubExp]
es Type
rt) =
    case Type
rt of
      Array {} -> Doc -> Doc
brackets forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
commastack forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
ppr [SubExp]
es
      Type
_ -> Doc -> Doc
brackets forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
commasep forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
ppr [SubExp]
es
      Doc -> Doc -> Doc
<+> Doc
colon
      Doc -> Doc -> Doc
<+> String -> Doc
text String
"[]" forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Doc
ppr Type
rt
  ppr (BinOp BinOp
bop SubExp
x SubExp
y) = forall a. Pretty a => a -> Doc
ppr BinOp
bop forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens (forall a. Pretty a => a -> Doc
ppr SubExp
x forall a. Semigroup a => a -> a -> a
<> Doc
comma Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
ppr SubExp
y)
  ppr (CmpOp CmpOp
op SubExp
x SubExp
y) = forall a. Pretty a => a -> Doc
ppr CmpOp
op forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens (forall a. Pretty a => a -> Doc
ppr SubExp
x forall a. Semigroup a => a -> a -> a
<> Doc
comma Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
ppr SubExp
y)
  ppr (ConvOp ConvOp
conv SubExp
x) =
    String -> Doc
text (ConvOp -> String
convOpFun ConvOp
conv) Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
ppr PrimType
fromtype Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
ppr SubExp
x Doc -> Doc -> Doc
<+> String -> Doc
text String
"to" Doc -> Doc -> 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) = forall a. Pretty a => a -> Doc
ppr UnOp
op Doc -> Doc -> Doc
<+> forall a. Pretty a => Int -> a -> Doc
pprPrec Int
9 SubExp
e
  ppr (Index VName
v Slice SubExp
slice) = forall a. Pretty a => a -> Doc
ppr VName
v forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Doc
ppr Slice SubExp
slice
  ppr (Update Safety
safety VName
src Slice SubExp
slice SubExp
se) =
    forall a. Pretty a => a -> Doc
ppr VName
src Doc -> Doc -> Doc
<+> Doc
with Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
ppr Slice SubExp
slice Doc -> Doc -> Doc
<+> String -> Doc
text String
"=" Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
ppr SubExp
se
    where
      with :: Doc
with = case Safety
safety of
        Safety
Unsafe -> String -> Doc
text String
"with"
        Safety
Safe -> String -> Doc
text String
"with?"
  ppr (FlatIndex VName
v FlatSlice SubExp
slice) = forall a. Pretty a => a -> Doc
ppr VName
v forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Doc
ppr FlatSlice SubExp
slice
  ppr (FlatUpdate VName
src FlatSlice SubExp
slice VName
se) =
    forall a. Pretty a => a -> Doc
ppr VName
src Doc -> Doc -> Doc
<+> String -> Doc
text String
"with" Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
ppr FlatSlice SubExp
slice Doc -> Doc -> Doc
<+> String -> Doc
text String
"=" Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
ppr VName
se
  ppr (Iota SubExp
e SubExp
x SubExp
s IntType
et) = String -> Doc
text String
"iota" forall a. Semigroup a => a -> a -> a
<> Doc
et' forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
apply [forall a. Pretty a => a -> Doc
ppr SubExp
e, forall a. Pretty a => a -> Doc
ppr SubExp
x, forall a. Pretty a => a -> Doc
ppr SubExp
s]
    where
      et' :: Doc
et' = String -> Doc
text 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
  ppr (Replicate Shape
ne SubExp
ve) =
    String -> Doc
text String
"replicate" forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
apply [forall a. Pretty a => a -> Doc
ppr Shape
ne, Doc -> Doc
align (forall a. Pretty a => a -> Doc
ppr SubExp
ve)]
  ppr (Scratch PrimType
t [SubExp]
shape) =
    String -> Doc
text String
"scratch" forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
apply (forall a. Pretty a => a -> Doc
ppr PrimType
t forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
ppr [SubExp]
shape)
  ppr (Reshape ReshapeKind
ReshapeArbitrary Shape
shape VName
e) =
    String -> Doc
text String
"reshape" forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
apply [forall a. Pretty a => a -> Doc
ppr Shape
shape, forall a. Pretty a => a -> Doc
ppr VName
e]
  ppr (Reshape ReshapeKind
ReshapeCoerce Shape
shape VName
e) =
    String -> Doc
text String
"coerce" forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
apply [forall a. Pretty a => a -> Doc
ppr Shape
shape, forall a. Pretty a => a -> Doc
ppr VName
e]
  ppr (Rearrange [Int]
perm VName
e) =
    String -> Doc
text String
"rearrange" forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
apply [[Doc] -> Doc
apply (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
ppr [Int]
perm), forall a. Pretty a => a -> Doc
ppr VName
e]
  ppr (Rotate [SubExp]
es VName
e) =
    String -> Doc
text String
"rotate" forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
apply [[Doc] -> Doc
apply (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
ppr [SubExp]
es), forall a. Pretty a => a -> Doc
ppr VName
e]
  ppr (Concat Int
i (VName
x :| [VName]
xs) SubExp
w) =
    String -> Doc
text String
"concat" forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"@" forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Doc
ppr Int
i forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
apply (forall a. Pretty a => a -> Doc
ppr SubExp
w forall a. a -> [a] -> [a]
: forall a. Pretty a => a -> Doc
ppr VName
x forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
ppr [VName]
xs)
  ppr (Copy VName
e) = String -> Doc
text String
"copy" forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens (forall a. Pretty a => a -> Doc
ppr VName
e)
  ppr (Manifest [Int]
perm VName
e) = String -> Doc
text String
"manifest" forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
apply [[Doc] -> Doc
apply (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
ppr [Int]
perm), forall a. Pretty a => a -> Doc
ppr VName
e]
  ppr (Assert SubExp
e ErrorMsg SubExp
msg (SrcLoc
loc, [SrcLoc]
_)) =
    String -> Doc
text String
"assert" forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
apply [forall a. Pretty a => a -> Doc
ppr SubExp
e, forall a. Pretty a => a -> Doc
ppr ErrorMsg SubExp
msg, String -> Doc
text 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]
  ppr (UpdateAcc VName
acc [SubExp]
is [SubExp]
v) =
    String -> Doc
text String
"update_acc" forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
apply [forall a. Pretty a => a -> Doc
ppr VName
acc, forall a. Pretty a => [a] -> Doc
ppTuple' [SubExp]
is, forall a. Pretty a => [a] -> Doc
ppTuple' [SubExp]
v]

instance Pretty a => Pretty (ErrorMsg a) where
  ppr :: ErrorMsg a -> Doc
ppr (ErrorMsg [ErrorMsgPart a]
parts) = Doc -> Doc
braces forall a b. (a -> b) -> a -> b
$ Doc -> Doc
align forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
commasep forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Pretty a => ErrorMsgPart a -> Doc
p [ErrorMsgPart a]
parts
    where
      p :: ErrorMsgPart a -> Doc
p (ErrorString String
s) = String -> Doc
text forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show String
s
      p (ErrorVal PrimType
t a
x) = forall a. Pretty a => a -> Doc
ppr a
x Doc -> Doc -> Doc
<+> Doc
colon Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
ppr PrimType
t

maybeNest :: PrettyRep rep => Body rep -> Doc
maybeNest :: forall rep. PrettyRep rep => Body rep -> Doc
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. Pretty a => a -> Doc
ppr Body rep
b
  | Bool
otherwise = String -> String -> Doc -> Doc
nestedBlock String
"{" String
"}" forall a b. (a -> b) -> a -> b
$ forall a. Pretty a => a -> Doc
ppr Body rep
b

instance PrettyRep rep => Pretty (Case (Body rep)) where
  ppr :: Case (Body rep) -> Doc
ppr (Case [Maybe PrimValue]
vs Body rep
b) =
    Doc
"case" Doc -> Doc -> Doc
<+> forall a. Pretty a => [a] -> Doc
ppTuple' (forall a b. (a -> b) -> [a] -> [b]
map (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
"_" forall a. Pretty a => a -> Doc
ppr) [Maybe PrimValue]
vs) Doc -> Doc -> Doc
<+> Doc
"->" Doc -> Doc -> Doc
<+> forall rep. PrettyRep rep => Body rep -> Doc
maybeNest Body rep
b

instance PrettyRep rep => Pretty (Exp rep) where
  ppr :: Exp rep -> Doc
ppr (Match [SubExp
c] [Case [Just (BoolValue Bool
True)] Body rep
t] Body rep
f (MatchDec [BranchType rep]
ret MatchSort
ifsort)) =
    String -> Doc
text String
"if"
      Doc -> Doc -> Doc
<+> Doc
info'
      Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
ppr SubExp
c
      Doc -> Doc -> Doc
</> String -> Doc
text String
"then"
      Doc -> Doc -> Doc
<+> forall rep. PrettyRep rep => Body rep -> Doc
maybeNest Body rep
t
      Doc -> Doc -> Doc
<+> String -> Doc
text String
"else"
      Doc -> Doc -> Doc
<+> forall rep. PrettyRep rep => Body rep -> Doc
maybeNest Body rep
f
      Doc -> Doc -> Doc
</> Doc
colon
      Doc -> Doc -> Doc
<+> forall a. Pretty a => [a] -> Doc
ppTuple' [BranchType rep]
ret
    where
      info' :: Doc
info' = case MatchSort
ifsort of
        MatchSort
MatchNormal -> forall a. Monoid a => a
mempty
        MatchSort
MatchFallback -> String -> Doc
text String
"<fallback>"
        MatchSort
MatchEquiv -> String -> Doc
text String
"<equiv>"
  ppr (Match [SubExp]
ses [Case (Body rep)]
cs Body rep
defb (MatchDec [BranchType rep]
ret MatchSort
ifsort)) =
    (Doc
"match" Doc -> Doc -> Doc
<+> Doc
info' Doc -> Doc -> Doc
<+> forall a. Pretty a => [a] -> Doc
ppTuple' [SubExp]
ses)
      Doc -> Doc -> Doc
</> [Doc] -> Doc
stack (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
ppr [Case (Body rep)]
cs)
      Doc -> Doc -> Doc
</> Doc
"default"
      Doc -> Doc -> Doc
<+> Doc
"->"
      Doc -> Doc -> Doc
<+> forall rep. PrettyRep rep => Body rep -> Doc
maybeNest Body rep
defb
      Doc -> Doc -> Doc
</> Doc
colon
      Doc -> Doc -> Doc
<+> forall a. Pretty a => [a] -> Doc
ppTuple' [BranchType rep]
ret
    where
      info' :: Doc
info' = case MatchSort
ifsort of
        MatchSort
MatchNormal -> forall a. Monoid a => a
mempty
        MatchSort
MatchFallback -> String -> Doc
text String
"<fallback>"
        MatchSort
MatchEquiv -> String -> Doc
text String
"<equiv>"
  ppr (BasicOp BasicOp
op) = forall a. Pretty a => a -> Doc
ppr BasicOp
op
  ppr (Apply Name
fname [(SubExp, Diet)]
args [RetType rep]
ret (Safety
safety, SrcLoc
_, [SrcLoc]
_)) =
    Doc
applykw
      Doc -> Doc -> Doc
<+> String -> Doc
text (Name -> String
nameToString Name
fname)
        forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
apply (forall a b. (a -> b) -> [a] -> [b]
map (Doc -> Doc
align forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. Pretty a => (a, Diet) -> Doc
pprArg) [(SubExp, Diet)]
args)
      Doc -> Doc -> Doc
</> Doc
colon
      Doc -> Doc -> Doc
<+> Doc -> Doc
braces ([Doc] -> Doc
commasep forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
ppr [RetType rep]
ret)
    where
      pprArg :: (a, Diet) -> Doc
pprArg (a
arg, Diet
Consume) = String -> Doc
text String
"*" forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Doc
ppr a
arg
      pprArg (a
arg, Diet
_) = forall a. Pretty a => a -> Doc
ppr a
arg
      applykw :: Doc
applykw = case Safety
safety of
        Safety
Unsafe -> String -> Doc
text String
"apply <unsafe>"
        Safety
Safe -> String -> Doc
text String
"apply"
  ppr (Op Op rep
op) = forall a. Pretty a => a -> Doc
ppr Op rep
op
  ppr (DoLoop [(Param (FParamInfo rep), SubExp)]
merge LoopForm rep
form Body rep
loopbody) =
    String -> Doc
text String
"loop"
      Doc -> Doc -> Doc
<+> Doc -> Doc
braces ([Doc] -> Doc
commastack forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
ppr [Param (FParamInfo rep)]
params)
      Doc -> Doc -> Doc
<+> Doc
equals
      Doc -> Doc -> Doc
<+> forall a. Pretty a => [a] -> Doc
ppTuple' [SubExp]
args
      Doc -> Doc -> Doc
</> ( case LoopForm rep
form of
              ForLoop VName
i IntType
it SubExp
bound [] ->
                String -> Doc
text String
"for"
                  Doc -> Doc -> Doc
<+> Doc -> Doc
align
                    ( forall a. Pretty a => a -> Doc
ppr VName
i forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
":" forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Doc
ppr IntType
it
                        Doc -> Doc -> Doc
<+> String -> Doc
text String
"<"
                        Doc -> Doc -> Doc
<+> Doc -> Doc
align (forall a. Pretty a => a -> Doc
ppr SubExp
bound)
                    )
              ForLoop VName
i IntType
it SubExp
bound [(Param (LParamInfo rep), VName)]
loop_vars ->
                String -> Doc
text String
"for"
                  Doc -> Doc -> Doc
<+> Doc -> Doc
align
                    ( forall a. Pretty a => a -> Doc
ppr VName
i forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
":" forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Doc
ppr IntType
it
                        Doc -> Doc -> Doc
<+> String -> Doc
text String
"<"
                        Doc -> Doc -> Doc
<+> Doc -> Doc
align (forall a. Pretty a => a -> Doc
ppr SubExp
bound)
                        Doc -> Doc -> Doc
</> [Doc] -> Doc
stack (forall a b. (a -> b) -> [a] -> [b]
map forall {a} {a}. (Pretty a, Pretty a) => (a, a) -> Doc
pprLoopVar [(Param (LParamInfo rep), VName)]
loop_vars)
                    )
              WhileLoop VName
cond ->
                String -> Doc
text String
"while" Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
ppr VName
cond
          )
      Doc -> Doc -> Doc
<+> String -> Doc
text String
"do"
      Doc -> Doc -> Doc
<+> String -> String -> Doc -> Doc
nestedBlock String
"{" String
"}" (forall a. Pretty a => a -> Doc
ppr Body rep
loopbody)
    where
      ([Param (FParamInfo rep)]
params, [SubExp]
args) = forall a b. [(a, b)] -> ([a], [b])
unzip [(Param (FParamInfo rep), SubExp)]
merge
      pprLoopVar :: (a, a) -> Doc
pprLoopVar (a
p, a
a) = forall a. Pretty a => a -> Doc
ppr a
p Doc -> Doc -> Doc
<+> String -> Doc
text String
"in" Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
ppr a
a
  ppr (WithAcc [WithAccInput rep]
inputs Lambda rep
lam) =
    String -> Doc
text String
"with_acc"
      forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens (Doc -> Doc
braces ([Doc] -> Doc
commastack forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {a} {a} {a} {a}.
(Pretty a, Pretty a, Pretty a, Pretty a) =>
(a, [a], Maybe (a, [a])) -> Doc
ppInput [WithAccInput rep]
inputs) forall a. Semigroup a => a -> a -> a
<> Doc
comma Doc -> Doc -> Doc
</> forall a. Pretty a => a -> Doc
ppr Lambda rep
lam)
    where
      ppInput :: (a, [a], Maybe (a, [a])) -> Doc
ppInput (a
shape, [a]
arrs, Maybe (a, [a])
op) =
        Doc -> Doc
parens
          ( forall a. Pretty a => a -> Doc
ppr a
shape forall a. Semigroup a => a -> a -> a
<> Doc
comma
              Doc -> Doc -> Doc
<+> forall a. Pretty a => [a] -> Doc
ppTuple' [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) ->
                    Doc
comma Doc -> Doc -> Doc
</> Doc -> Doc
parens (forall a. Pretty a => a -> Doc
ppr a
op' forall a. Semigroup a => a -> a -> a
<> Doc
comma Doc -> Doc -> Doc
</> forall a. Pretty a => [a] -> Doc
ppTuple' (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
ppr [a]
nes))
          )

instance PrettyRep rep => Pretty (Lambda rep) where
  ppr :: Lambda rep -> Doc
ppr (Lambda [] (Body BodyDec rep
_ Stms rep
stms []) []) | Stms rep
stms forall a. Eq a => a -> a -> Bool
== forall a. Monoid a => a
mempty = String -> Doc
text String
"nilFn"
  ppr (Lambda [Param (LParamInfo rep)]
params Body rep
body [Type]
rettype) =
    String -> Doc
text String
"\\"
      Doc -> Doc -> Doc
<+> forall a. Pretty a => [a] -> Doc
ppTuple' [Param (LParamInfo rep)]
params
      Doc -> Doc -> Doc
</> Int -> Doc -> Doc
indent Int
2 (Doc
colon Doc -> Doc -> Doc
<+> forall a. Pretty a => [a] -> Doc
ppTupleLines' [Type]
rettype Doc -> Doc -> Doc
<+> String -> Doc
text String
"->")
      Doc -> Doc -> Doc
</> Int -> Doc -> Doc
indent Int
2 (forall a. Pretty a => a -> Doc
ppr Body rep
body)

instance Pretty Signedness where
  ppr :: Signedness -> Doc
ppr Signedness
Signed = Doc
"signed"
  ppr Signedness
Unsigned = Doc
"unsigned"

instance Pretty ValueType where
  ppr :: ValueType -> Doc
ppr (ValueType Signedness
s (Rank Int
r) PrimType
t) =
    forall a. Monoid a => [a] -> a
mconcat (forall a. Int -> a -> [a]
replicate Int
r Doc
"[]") forall a. Semigroup a => a -> a -> a
<> String -> Doc
text (Bool -> PrimType -> String
prettySigned (Signedness
s forall a. Eq a => a -> a -> Bool
== Signedness
Unsigned) PrimType
t)

instance Pretty EntryPointType where
  ppr :: EntryPointType -> Doc
ppr (TypeTransparent ValueType
t) = forall a. Pretty a => a -> Doc
ppr ValueType
t
  ppr (TypeOpaque String
desc) = Doc
"opaque" Doc -> Doc -> Doc
<+> Doc -> Doc
pquote (String -> Doc
text String
desc)

instance Pretty EntryParam where
  ppr :: EntryParam -> Doc
ppr (EntryParam Name
name Uniqueness
u EntryPointType
t) = forall a. Pretty a => a -> Doc
ppr Name
name forall a. Semigroup a => a -> a -> a
<> Doc
colon Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
ppr Uniqueness
u forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Doc
ppr EntryPointType
t

instance Pretty EntryResult where
  ppr :: EntryResult -> Doc
ppr (EntryResult Uniqueness
u EntryPointType
t) = forall a. Pretty a => a -> Doc
ppr Uniqueness
u forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Doc
ppr EntryPointType
t

instance PrettyRep rep => Pretty (FunDef rep) where
  ppr :: FunDef rep -> Doc
ppr (FunDef Maybe EntryPoint
entry Attrs
attrs Name
name [RetType rep]
rettype [Param (FParamInfo rep)]
fparams Body rep
body) =
    [Doc] -> Doc -> Doc
annot (Attrs -> [Doc]
attrAnnots Attrs
attrs) forall a b. (a -> b) -> a -> b
$
      Doc
fun
        Doc -> Doc -> Doc
</> Int -> Doc -> Doc
indent Int
2 (String -> Doc
text (Name -> String
nameToString Name
name))
        Doc -> Doc -> Doc
<+> [Doc] -> Doc
apply (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
ppr [Param (FParamInfo rep)]
fparams)
        Doc -> Doc -> Doc
</> Int -> Doc -> Doc
indent Int
2 (Doc
colon Doc -> Doc -> Doc
<+> Doc -> Doc
align (forall a. Pretty a => [a] -> Doc
ppTuple' [RetType rep]
rettype))
        Doc -> Doc -> Doc
<+> Doc
equals
        Doc -> Doc -> Doc
<+> String -> String -> Doc -> Doc
nestedBlock String
"{" String
"}" (forall a. Pretty a => a -> Doc
ppr Body rep
body)
    where
      fun :: Doc
fun = case Maybe EntryPoint
entry of
        Maybe EntryPoint
Nothing -> Doc
"fun"
        Just (Name
p_name, [EntryParam]
p_entry, [EntryResult]
ret_entry) ->
          Doc
"entry"
            forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens
              ( Doc
"\"" forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Doc
ppr Name
p_name forall a. Semigroup a => a -> a -> a
<> Doc
"\"" forall a. Semigroup a => a -> a -> a
<> Doc
comma
                  Doc -> Doc -> Doc
</> forall a. Pretty a => [a] -> Doc
ppTupleLines' [EntryParam]
p_entry forall a. Semigroup a => a -> a -> a
<> Doc
comma
                  Doc -> Doc -> Doc
</> forall a. Pretty a => [a] -> Doc
ppTupleLines' [EntryResult]
ret_entry
              )

instance Pretty OpaqueType where
  ppr :: OpaqueType -> Doc
ppr (OpaqueType [ValueType]
ts) =
    Doc
"opaque" Doc -> Doc -> Doc
<+> String -> String -> Doc -> Doc
nestedBlock String
"{" String
"}" ([Doc] -> Doc
stack forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
ppr [ValueType]
ts)
  ppr (OpaqueRecord [(Name, EntryPointType)]
fs) =
    Doc
"record" Doc -> Doc -> Doc
<+> String -> String -> Doc -> Doc
nestedBlock String
"{" String
"}" ([Doc] -> Doc
stack forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {a} {a}. (Pretty a, Pretty a) => (a, a) -> Doc
p [(Name, EntryPointType)]
fs)
    where
      p :: (a, a) -> Doc
p (a
f, a
et) = forall a. Pretty a => a -> Doc
ppr a
f forall a. Semigroup a => a -> a -> a
<> Doc
":" Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
ppr a
et

instance Pretty OpaqueTypes where
  ppr :: OpaqueTypes -> Doc
ppr (OpaqueTypes [(String, OpaqueType)]
ts) = Doc
"types" Doc -> Doc -> Doc
<+> String -> String -> Doc -> Doc
nestedBlock String
"{" String
"}" ([Doc] -> Doc
stack forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {a} {a}. (Pretty a, Pretty a) => (a, a) -> Doc
p [(String, OpaqueType)]
ts)
    where
      p :: (a, a) -> Doc
p (a
name, a
t) = Doc
"type" Doc -> Doc -> Doc
<+> Doc -> Doc
pquote (forall a. Pretty a => a -> Doc
ppr a
name) Doc -> Doc -> Doc
<+> Doc
equals Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
ppr a
t

instance PrettyRep rep => Pretty (Prog rep) where
  ppr :: Prog rep -> Doc
ppr (Prog OpaqueTypes
types Stms rep
consts [FunDef rep]
funs) =
    [Doc] -> Doc
stack forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate Doc
line forall a b. (a -> b) -> a -> b
$ forall a. Pretty a => a -> Doc
ppr OpaqueTypes
types forall a. a -> [a] -> [a]
: forall a. Pretty a => a -> Doc
ppr Stms rep
consts forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
ppr [FunDef rep]
funs

instance Pretty d => Pretty (DimIndex d) where
  ppr :: DimIndex d -> Doc
ppr (DimFix d
i) = forall a. Pretty a => a -> Doc
ppr d
i
  ppr (DimSlice d
i d
n d
s) = forall a. Pretty a => a -> Doc
ppr d
i Doc -> Doc -> Doc
<+> String -> Doc
text String
":+" Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
ppr d
n Doc -> Doc -> Doc
<+> String -> Doc
text String
"*" Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
ppr d
s

-- | Like 'prettyTuple', but produces a 'Doc'.
ppTuple' :: Pretty a => [a] -> Doc
ppTuple' :: forall a. Pretty a => [a] -> Doc
ppTuple' [a]
ets = Doc -> Doc
braces forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
commasep forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Doc -> Doc
align forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> Doc
ppr) [a]
ets

-- | Like 'prettyTupleLines', but produces a 'Doc'.
ppTupleLines' :: Pretty a => [a] -> Doc
ppTupleLines' :: forall a. Pretty a => [a] -> Doc
ppTupleLines' [a]
ets = Doc -> Doc
braces forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
stack forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate Doc
comma forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Doc -> Doc
align forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> Doc
ppr) [a]
ets