{-# 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,
    pretty,
    PrettyLore (..),
    ppTuple',
  )
where

import Data.Foldable (toList)
import Data.Maybe
import Futhark.IR.Syntax
import Futhark.Util.Pretty

-- | The class of lores whose annotations can be prettyprinted.
class
  ( Decorations lore,
    Pretty (RetType lore),
    Pretty (BranchType lore),
    Pretty (FParamInfo lore),
    Pretty (LParamInfo lore),
    Pretty (LetDec lore),
    Pretty (Op lore)
  ) =>
  PrettyLore lore
  where
  ppExpLore :: ExpDec lore -> Exp lore -> Maybe Doc
  ppExpLore ExpDec lore
_ Exp lore
_ = Maybe Doc
forall a. Maybe a
Nothing

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
<> String -> Doc
text String
"_" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text (Int -> String
forall a. Show a => a -> String
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 = String -> Doc
text String
"commutative"
  ppr Commutativity
Noncommutative = String -> Doc
text String
"noncommutative"

instance Pretty Shape where
  ppr :: Shape -> Doc
ppr = [Doc] -> Doc
forall a. Monoid a => [a] -> a
mconcat ([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 (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] -> [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) = String -> Doc
text String
"?" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text (Int -> String
forall a. Show a => a -> String
show Int
x)

instance Pretty ExtShape where
  ppr :: ExtShape -> Doc
ppr = [Doc] -> Doc
forall a. Monoid a => [a] -> a
mconcat ([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 (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] -> [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 String
s) = String -> Doc
text String
"@" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
s
  ppr (ScalarSpace [SubExp]
d PrimType
t) = String -> Doc
text String
"@" 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
t) = PrimType -> Doc
forall a. Pretty a => a -> Doc
ppr PrimType
t
  ppr (Acc VName
acc Shape
ispace [Type]
ts u
u) =
    u -> Doc
forall a. Pretty a => a -> Doc
ppr u
u Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"acc" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
apply [VName -> Doc
forall a. Pretty a => a -> Doc
ppr VName
acc, Shape -> Doc
forall a. Pretty a => a -> Doc
ppr Shape
ispace, [Type] -> Doc
forall a. Pretty a => [a] -> Doc
ppTuple' [Type]
ts]
  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) = String -> Doc
text String
"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
t) = PrimType -> Doc
forall a. Pretty a => a -> Doc
ppr PrimType
t
  ppr (Acc VName
acc Shape
ispace [Type]
ts u
u) =
    u -> Doc
forall a. Pretty a => a -> Doc
ppr u
u Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"acc" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
apply [VName -> Doc
forall a. Pretty a => a -> Doc
ppr VName
acc, Shape -> Doc
forall a. Pretty a => a -> Doc
ppr Shape
ispace, [Type] -> Doc
forall a. Pretty a => [a] -> Doc
ppTuple' [Type]
ts]
  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) = String -> Doc
text String
"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
t) = PrimType -> Doc
forall a. Pretty a => a -> Doc
ppr PrimType
t
  ppr (Acc VName
acc Shape
ispace [Type]
ts u
u) =
    u -> Doc
forall a. Pretty a => a -> Doc
ppr u
u Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"acc" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
apply [VName -> Doc
forall a. Pretty a => a -> Doc
ppr VName
acc, Shape -> Doc
forall a. Pretty a => a -> Doc
ppr Shape
ispace, [Type] -> Doc
forall a. Pretty a => [a] -> Doc
ppTuple' [Type]
ts]
  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) = String -> Doc
text String
"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) = String -> Doc
text String
"#" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
braces ([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))

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
</> String -> Doc
text String
"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 = String -> Doc
text String
"#[" 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
<> String -> Doc
text String
"]"

stmAttrAnnots :: Stm lore -> [Doc]
stmAttrAnnots :: forall lore. 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

certAnnots :: Certificates -> [Doc]
certAnnots :: Certificates -> [Doc]
certAnnots Certificates
cs
  | Certificates
cs Certificates -> Certificates -> Bool
forall a. Eq a => a -> a -> Bool
== Certificates
forall a. Monoid a => a
mempty = []
  | Bool
otherwise = [Certificates -> Doc
forall a. Pretty a => a -> Doc
ppr Certificates
cs]

stmCertAnnots :: Stm lore -> [Doc]
stmCertAnnots :: forall lore. Stm lore -> [Doc]
stmCertAnnots = Certificates -> [Doc]
certAnnots (Certificates -> [Doc])
-> (Stm lore -> Certificates) -> Stm lore -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StmAux (ExpDec lore) -> Certificates
forall dec. StmAux dec -> Certificates
stmAuxCerts (StmAux (ExpDec lore) -> Certificates)
-> (Stm lore -> StmAux (ExpDec lore)) -> Stm lore -> Certificates
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 t => Pretty (PatElemT t) where
  ppr :: PatElemT t -> Doc
ppr (PatElem VName
name t
t) = VName -> Doc
forall a. Pretty a => a -> Doc
ppr VName
name Doc -> Doc -> Doc
<+> Doc
colon Doc -> Doc -> Doc
<+> Doc -> Doc
align (t -> Doc
forall a. Pretty a => a -> Doc
ppr t
t)

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

instance PrettyLore lore => Pretty (Stm lore) where
  ppr :: Stm lore -> Doc
ppr bnd :: Stm lore
bnd@(Let PatternT (LetDec lore)
pat StmAux (ExpDec lore)
aux Exp lore
e) =
    Doc -> Doc
align (Doc -> Doc) -> (Doc -> Doc) -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Doc -> Doc
hang Int
2 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
      String -> Doc
text String
"let" Doc -> Doc -> Doc
<+> Doc -> Doc
align (PatternT (LetDec lore) -> Doc
forall a. Pretty a => a -> Doc
ppr PatternT (LetDec lore)
pat)
        Doc -> Doc -> Doc
<+> case (Bool
linebreak, [Doc]
stmannot) of
          (Bool
True, []) -> Doc
equals Doc -> Doc -> Doc
</> Exp lore -> Doc
forall a. Pretty a => a -> Doc
ppr Exp lore
e
          (Bool
False, []) -> Doc
equals Doc -> Doc -> Doc
<+/> Exp lore -> Doc
forall a. Pretty a => a -> Doc
ppr Exp lore
e
          (Bool
_, [Doc]
ann) -> Doc
equals Doc -> Doc -> Doc
</> ([Doc] -> Doc
stack [Doc]
ann Doc -> Doc -> Doc
</> Exp lore -> Doc
forall a. Pretty a => a -> Doc
ppr Exp lore
e)
    where
      linebreak :: Bool
linebreak = case Exp lore
e of
        BasicOp BinOp {} -> Bool
False
        BasicOp CmpOp {} -> Bool
False
        BasicOp ConvOp {} -> Bool
False
        BasicOp UnOp {} -> Bool
False
        BasicOp SubExp {} -> Bool
False
        Exp lore
_ -> Bool
True

      stmannot :: [Doc]
stmannot =
        [[Doc]] -> [Doc]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
          [ Maybe Doc -> [Doc]
forall a. Maybe a -> [a]
maybeToList (ExpDec lore -> Exp lore -> Maybe Doc
forall lore.
PrettyLore lore =>
ExpDec lore -> Exp lore -> Maybe Doc
ppExpLore (StmAux (ExpDec lore) -> ExpDec lore
forall dec. StmAux dec -> dec
stmAuxDec StmAux (ExpDec lore)
aux) Exp lore
e),
            Stm lore -> [Doc]
forall lore. Stm lore -> [Doc]
stmAttrAnnots Stm lore
bnd,
            Stm lore -> [Doc]
forall lore. Stm lore -> [Doc]
stmCertAnnots Stm lore
bnd
          ]

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) = String -> Doc
text String
"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 [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
      Doc -> Doc -> Doc
<+> Doc
colon
      Doc -> Doc -> Doc
<+> String -> Doc
text String
"[]" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Type -> Doc
forall a. Pretty a => a -> Doc
ppr Type
rt
  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) =
    String -> Doc
text (ConvOp -> String
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
<+> String -> Doc
text String
"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
<+> String -> Doc
text String
"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
<+> String -> Doc
text String
"="
      Doc -> Doc -> Doc
<+> SubExp -> Doc
forall a. Pretty a => a -> Doc
ppr SubExp
se
  ppr (Iota SubExp
e SubExp
x SubExp
s IntType
et) = String -> Doc
text String
"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' = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
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) =
    String -> Doc
text String
"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) =
    String -> Doc
text String
"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) =
    String -> Doc
text String
"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) =
    String -> Doc
text String
"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) =
    String -> Doc
text String
"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
w) =
    String -> Doc
text String
"concat" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"@" 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 (SubExp -> Doc
forall a. Pretty a => a -> Doc
ppr SubExp
w Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: 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) = String -> Doc
text String
"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) = String -> Doc
text String
"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]
_)) =
    String -> Doc
text String
"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, String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. Show a => a -> String
show (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ SrcLoc -> String
forall a. Located a => a -> String
locStr SrcLoc
loc]
  ppr (UpdateAcc VName
acc [SubExp]
is [SubExp]
v) =
    String -> Doc
text String
"update_acc" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
apply [VName -> Doc
forall a. Pretty a => a -> Doc
ppr VName
acc, [SubExp] -> Doc
forall a. Pretty a => [a] -> Doc
ppTuple' [SubExp]
is, [SubExp] -> Doc
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 (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
$ [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 String
s) = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. Show a => a -> String
show String
s
      p (ErrorInt32 a
x) = a -> Doc
forall a. Pretty a => a -> Doc
ppr a
x Doc -> Doc -> Doc
<+> Doc
colon Doc -> Doc -> Doc
<+> String -> Doc
text String
"i32"
      p (ErrorInt64 a
x) = a -> Doc
forall a. Pretty a => a -> Doc
ppr a
x Doc -> Doc -> Doc
<+> Doc
colon Doc -> Doc -> Doc
<+> String -> Doc
text String
"i64"

instance PrettyLore lore => Pretty (Exp lore) where
  ppr :: Exp lore -> Doc
ppr (If SubExp
c BodyT lore
t BodyT lore
f (IfDec [BranchType lore]
ret IfSort
ifsort)) =
    String -> Doc
text String
"if" Doc -> Doc -> Doc
<+> Doc
info' Doc -> Doc -> Doc
<+> SubExp -> Doc
forall a. Pretty a => a -> Doc
ppr SubExp
c
      Doc -> Doc -> Doc
</> String -> Doc
text String
"then"
      Doc -> Doc -> Doc
<+> BodyT lore -> Doc
forall lore. PrettyLore lore => Body lore -> Doc
maybeNest BodyT lore
t
      Doc -> Doc -> Doc
<+> String -> Doc
text String
"else"
      Doc -> Doc -> Doc
<+> BodyT lore -> Doc
forall lore. PrettyLore lore => Body lore -> Doc
maybeNest BodyT lore
f
      Doc -> Doc -> Doc
<+> Doc
colon
      Doc -> Doc -> Doc
<+> Doc -> Doc
braces ([Doc] -> Doc
commasep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (BranchType lore -> Doc) -> [BranchType lore] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map BranchType lore -> Doc
forall a. Pretty a => a -> Doc
ppr [BranchType lore]
ret)
    where
      info' :: Doc
info' = case IfSort
ifsort of
        IfSort
IfNormal -> Doc
forall a. Monoid a => a
mempty
        IfSort
IfFallback -> String -> Doc
text String
"<fallback>"
        IfSort
IfEquiv -> String -> Doc
text String
"<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 = String -> String -> Doc -> Doc
nestedBlock String
"{" String
"}" (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]
ret (Safety
safety, SrcLoc
_, [SrcLoc]
_)) =
    String -> Doc
text String
"apply"
      Doc -> Doc -> Doc
<+> String -> Doc
text (Name -> String
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)
      Doc -> Doc -> Doc
</> Doc
colon
      Doc -> Doc -> Doc
<+> Doc -> Doc
braces ([Doc] -> Doc
commasep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (RetType lore -> Doc) -> [RetType lore] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map RetType lore -> Doc
forall a. Pretty a => a -> Doc
ppr [RetType lore]
ret)
    where
      pprArg :: (a, Diet) -> Doc
pprArg (a
arg, Diet
Consume) = String -> Doc
text String
"*" 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 -> String -> Doc
text String
"<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 [(Param (FParamInfo lore), SubExp)]
ctx [(Param (FParamInfo lore), SubExp)]
val LoopForm lore
form BodyT lore
loopbody) =
    String -> Doc
text String
"loop" Doc -> Doc -> Doc
<+> [Param (FParamInfo lore)] -> [Param (FParamInfo lore)] -> Doc
forall a b. (Pretty a, Pretty b) => [a] -> [b] -> Doc
ppPattern [Param (FParamInfo lore)]
ctxparams [Param (FParamInfo 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 [] ->
                String -> Doc
text String
"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
<> String -> Doc
text String
":" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> IntType -> Doc
forall a. Pretty a => a -> Doc
ppr IntType
it
                        Doc -> Doc -> Doc
<+> String -> Doc
text String
"<"
                        Doc -> Doc -> Doc
<+> Doc -> Doc
align (SubExp -> Doc
forall a. Pretty a => a -> Doc
ppr SubExp
bound)
                    )
              ForLoop VName
i IntType
it SubExp
bound [(Param (LParamInfo lore), VName)]
loop_vars ->
                String -> Doc
text String
"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
<> String -> Doc
text String
":" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> IntType -> Doc
forall a. Pretty a => a -> Doc
ppr IntType
it
                        Doc -> Doc -> Doc
<+> String -> Doc
text String
"<"
                        Doc -> Doc -> Doc
<+> Doc -> Doc
align (SubExp -> Doc
forall a. Pretty a => a -> Doc
ppr SubExp
bound)
                        Doc -> Doc -> Doc
</> [Doc] -> Doc
stack (((Param (LParamInfo lore), VName) -> Doc)
-> [(Param (LParamInfo lore), VName)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Param (LParamInfo lore), VName) -> Doc
forall {a} {a}. (Pretty a, Pretty a) => (a, a) -> Doc
pprLoopVar [(Param (LParamInfo lore), VName)]
loop_vars)
                    )
              WhileLoop VName
cond ->
                String -> Doc
text String
"while" Doc -> Doc -> Doc
<+> VName -> 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
"}" (BodyT lore -> Doc
forall a. Pretty a => a -> Doc
ppr BodyT lore
loopbody)
    where
      ([Param (FParamInfo lore)]
ctxparams, [SubExp]
ctxinit) = [(Param (FParamInfo lore), SubExp)]
-> ([Param (FParamInfo lore)], [SubExp])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Param (FParamInfo lore), SubExp)]
ctx
      ([Param (FParamInfo lore)]
valparams, [SubExp]
valinit) = [(Param (FParamInfo lore), SubExp)]
-> ([Param (FParamInfo lore)], [SubExp])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Param (FParamInfo 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
<+> String -> Doc
text String
"in" Doc -> Doc -> Doc
<+> a -> Doc
forall a. Pretty a => a -> Doc
ppr a
a
  ppr (WithAcc [(Shape, [VName], Maybe (Lambda lore, [SubExp]))]
inputs Lambda lore
lam) =
    String -> Doc
text String
"with_acc"
      Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens (Doc -> Doc
braces ([Doc] -> Doc
commasep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ ((Shape, [VName], Maybe (Lambda lore, [SubExp])) -> Doc)
-> [(Shape, [VName], Maybe (Lambda lore, [SubExp]))] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Shape, [VName], Maybe (Lambda lore, [SubExp])) -> Doc
forall {a} {a} {a} {a}.
(Pretty a, Pretty a, Pretty a, Pretty a) =>
(a, [a], Maybe (a, [a])) -> Doc
ppInput [(Shape, [VName], Maybe (Lambda lore, [SubExp]))]
inputs) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
comma Doc -> Doc -> Doc
</> Lambda lore -> Doc
forall a. Pretty a => a -> Doc
ppr Lambda lore
lam)
    where
      ppInput :: (a, [a], Maybe (a, [a])) -> Doc
ppInput (a
shape, [a]
arrs, Maybe (a, [a])
op) =
        Doc -> Doc
parens
          ( a -> Doc
forall a. Pretty a => a -> Doc
ppr a
shape Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
comma Doc -> Doc -> Doc
<+> [a] -> Doc
forall a. Pretty a => [a] -> Doc
ppTuple' [a]
arrs
              Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> case Maybe (a, [a])
op of
                Maybe (a, [a])
Nothing -> Doc
forall a. Monoid a => a
mempty
                Just (a
op', [a]
nes) ->
                  Doc
comma Doc -> Doc -> Doc
</> Doc -> Doc
parens (a -> Doc
forall a. Pretty a => a -> Doc
ppr a
op' Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
comma Doc -> Doc -> Doc
</> [Doc] -> Doc
forall a. Pretty a => [a] -> Doc
ppTuple' ((a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map a -> Doc
forall a. Pretty a => a -> Doc
ppr [a]
nes))
          )

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

instance Pretty EntryPointType where
  ppr :: EntryPointType -> Doc
ppr EntryPointType
TypeDirect = Doc
"direct"
  ppr EntryPointType
TypeUnsigned = Doc
"unsigned"
  ppr (TypeOpaque String
desc Int
n) = Doc
"opaque" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
apply [String -> Doc
forall a. Pretty a => a -> Doc
ppr (String -> String
forall a. Show a => a -> String
show String
desc), Int -> Doc
forall a. Pretty a => a -> Doc
ppr Int
n]

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

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) = String -> Doc
text String
"~" 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
<+> String -> Doc
text String
":+" Doc -> Doc -> Doc
<+> d -> Doc
forall a. Pretty a => a -> Doc
ppr d
n Doc -> Doc -> Doc
<+> String -> Doc
text String
"*" Doc -> Doc -> Doc
<+> d -> Doc
forall a. Pretty a => a -> Doc
ppr d
s

ppPattern :: (Pretty a, Pretty b) => [a] -> [b] -> Doc
ppPattern :: forall a b. (Pretty a, Pretty b) => [a] -> [b] -> Doc
ppPattern [] [b]
bs = Doc -> Doc
braces (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
$ (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
commastack ((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)

-- | Like 'prettyTuple', but produces a 'Doc'.
ppTuple' :: Pretty a => [a] -> Doc
ppTuple' :: forall a. Pretty a => [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