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

-- | Futhark prettyprinter.  This module defines 'Pretty' instances
-- for the AST defined in "Language.Futhark.Syntax".
module Language.Futhark.Pretty
  ( prettyString,
    prettyTuple,
    leadingOperator,
    IsName (..),
    prettyNameString,
    Annot (..),
  )
where

import Control.Monad
import Data.Char (chr)
import Data.Functor
import Data.List (intersperse)
import Data.List.NonEmpty qualified as NE
import Data.Map.Strict qualified as M
import Data.Maybe
import Data.Monoid hiding (Sum)
import Data.Ord
import Data.Text qualified as T
import Data.Word
import Futhark.Util
import Futhark.Util.Pretty
import Language.Futhark.Prop
import Language.Futhark.Syntax
import Prelude

-- | A class for types that are variable names in the Futhark source
-- language.  This is used instead of a mere 'Pretty' instance because
-- in the compiler frontend we want to print VNames differently
-- depending on whether the FUTHARK_COMPILER_DEBUGGING environment
-- variable is set, yet in the backend we want to always print VNames
-- with the tag.  To avoid erroneously using the 'Pretty' instance for
-- VNames, we in fact only define it inside the modules for the core
-- language (as an orphan instance).
class IsName v where
  prettyName :: v -> Doc a
  toName :: v -> Name

-- | Depending on the environment variable FUTHARK_COMPILER_DEBUGGING,
-- VNames are printed as either the name with an internal tag, or just
-- the base name.
instance IsName VName where
  prettyName :: forall a. VName -> Doc a
prettyName
    | String -> Int -> Bool
isEnvVarAtLeast String
"FUTHARK_COMPILER_DEBUGGING" Int
1 =
        \(VName Name
vn Int
i) -> Name -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. Name -> Doc ann
pretty Name
vn Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
"_" Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> String -> Doc a
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Int -> String
forall a. Show a => a -> String
show Int
i)
    | Bool
otherwise = Name -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. Name -> Doc ann
pretty (Name -> Doc a) -> (VName -> Name) -> VName -> Doc a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VName -> Name
baseName
  toName :: VName -> Name
toName = VName -> Name
baseName

instance IsName Name where
  prettyName :: forall ann. Name -> Doc ann
prettyName = Name -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. Name -> Doc ann
pretty
  toName :: Name -> Name
toName = Name -> Name
forall a. a -> a
id

-- | Prettyprint name as string.  Only use this for debugging.
prettyNameString :: (IsName v) => v -> String
prettyNameString :: forall v. IsName v => v -> String
prettyNameString = Text -> String
T.unpack (Text -> String) -> (v -> Text) -> v -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Any -> Text
forall a. Doc a -> Text
docText (Doc Any -> Text) -> (v -> Doc Any) -> v -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Doc Any
forall a. v -> Doc a
forall v a. IsName v => v -> Doc a
prettyName

-- | Class for type constructors that represent annotations.  Used in
-- the prettyprinter to either print the original AST, or the computed
-- decoration.
class Annot f where
  -- | Extract value, if any.
  unAnnot :: f a -> Maybe a

instance Annot NoInfo where
  unAnnot :: forall a. NoInfo a -> Maybe a
unAnnot = Maybe a -> NoInfo a -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing

instance Annot Info where
  unAnnot :: forall a. Info a -> Maybe a
unAnnot = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> (Info a -> a) -> Info a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Info a -> a
forall a. Info a -> a
unInfo

instance Pretty PrimValue where
  pretty :: forall ann. PrimValue -> Doc ann
pretty (UnsignedValue (Int8Value Int8
v)) =
    String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Word8 -> String
forall a. Show a => a -> String
show (Int8 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int8
v :: Word8)) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"u8"
  pretty (UnsignedValue (Int16Value Int16
v)) =
    String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Word16 -> String
forall a. Show a => a -> String
show (Int16 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int16
v :: Word16)) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"u16"
  pretty (UnsignedValue (Int32Value Int32
v)) =
    String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Word32 -> String
forall a. Show a => a -> String
show (Int32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
v :: Word32)) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"u32"
  pretty (UnsignedValue (Int64Value Int64
v)) =
    String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Word64 -> String
forall a. Show a => a -> String
show (Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
v :: Word64)) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"u64"
  pretty (SignedValue IntValue
v) = IntValue -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IntValue -> Doc ann
pretty IntValue
v
  pretty (BoolValue Bool
True) = Doc ann
"true"
  pretty (BoolValue Bool
False) = Doc ann
"false"
  pretty (FloatValue FloatValue
v) = FloatValue -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. FloatValue -> Doc ann
pretty FloatValue
v

instance (Eq vn, IsName vn, Annot f) => Pretty (SizeExp f vn) where
  pretty :: forall ann. SizeExp f vn -> Doc ann
pretty SizeExpAny {} = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
brackets Doc ann
forall a. Monoid a => a
mempty
  pretty (SizeExp ExpBase f vn
e SrcLoc
_) = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
brackets (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ ExpBase f vn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ExpBase f vn -> Doc ann
pretty ExpBase f vn
e

instance Pretty (Shape Size) where
  pretty :: forall ann. Shape Size -> Doc ann
pretty (Shape [Size]
ds) = [Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat ((Size -> Doc ann) -> [Size] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map (Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
brackets (Doc ann -> Doc ann) -> (Size -> Doc ann) -> Size -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Size -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Size -> Doc ann
pretty) [Size]
ds)

instance Pretty (Shape ()) where
  pretty :: forall ann. Shape () -> Doc ann
pretty (Shape [()]
ds) = [Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ Int -> Doc ann -> [Doc ann]
forall a. Int -> a -> [a]
replicate ([()] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [()]
ds) Doc ann
"[]"

instance Pretty (Shape Int64) where
  pretty :: forall ann. Shape Int64 -> Doc ann
pretty (Shape [Int64]
ds) = [Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat ((Int64 -> Doc ann) -> [Int64] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map (Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
brackets (Doc ann -> Doc ann) -> (Int64 -> Doc ann) -> Int64 -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Doc ann
forall ann. Int64 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty) [Int64]
ds)

instance Pretty (Shape Bool) where
  pretty :: forall ann. Shape Bool -> Doc ann
pretty (Shape [Bool]
ds) = [Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat ((Bool -> Doc ann) -> [Bool] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map (Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
brackets (Doc ann -> Doc ann) -> (Bool -> Doc ann) -> Bool -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Doc ann
forall ann. Bool -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty) [Bool]
ds)

prettyRetType :: (Pretty (Shape dim), Pretty u) => Int -> RetTypeBase dim u -> Doc a
prettyRetType :: forall dim u a.
(Pretty (Shape dim), Pretty u) =>
Int -> RetTypeBase dim u -> Doc a
prettyRetType Int
p (RetType [] TypeBase dim u
t) =
  Int -> TypeBase dim u -> Doc a
forall dim u a.
(Pretty (Shape dim), Pretty u) =>
Int -> TypeBase dim u -> Doc a
prettyType Int
p TypeBase dim u
t
prettyRetType Int
_ (RetType [VName]
dims TypeBase dim u
t) =
  Doc a
"?"
    Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> [Doc a] -> Doc a
forall a. Monoid a => [a] -> a
mconcat ((VName -> Doc a) -> [VName] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map (Doc a -> Doc a
forall ann. Doc ann -> Doc ann
brackets (Doc a -> Doc a) -> (VName -> Doc a) -> VName -> Doc a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VName -> Doc a
forall a. VName -> Doc a
forall v a. IsName v => v -> Doc a
prettyName) [VName]
dims)
    Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
"."
    Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> TypeBase dim u -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. TypeBase dim u -> Doc ann
pretty TypeBase dim u
t

instance (Pretty (Shape dim), Pretty u) => Pretty (RetTypeBase dim u) where
  pretty :: forall ann. RetTypeBase dim u -> Doc ann
pretty = Int -> RetTypeBase dim u -> Doc ann
forall dim u a.
(Pretty (Shape dim), Pretty u) =>
Int -> RetTypeBase dim u -> Doc a
prettyRetType Int
0

instance Pretty Diet where
  pretty :: forall ann. Diet -> Doc ann
pretty Diet
Consume = Doc ann
"*"
  pretty Diet
Observe = Doc ann
""

prettyScalarType :: (Pretty (Shape dim), Pretty u) => Int -> ScalarTypeBase dim u -> Doc a
prettyScalarType :: forall dim u a.
(Pretty (Shape dim), Pretty u) =>
Int -> ScalarTypeBase dim u -> Doc a
prettyScalarType Int
_ (Prim PrimType
et) = PrimType -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. PrimType -> Doc ann
pretty PrimType
et
prettyScalarType Int
p (TypeVar u
u QualName VName
v [TypeArg dim]
targs) =
  Bool -> Doc a -> Doc a
forall a. Bool -> Doc a -> Doc a
parensIf (Bool -> Bool
not ([TypeArg dim] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TypeArg dim]
targs) Bool -> Bool -> Bool
&& Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
3) (Doc a -> Doc a) -> Doc a -> Doc a
forall a b. (a -> b) -> a -> b
$
    u -> Doc a
forall ann. u -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty u
u Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> [Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
hsep (QualName VName -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. QualName VName -> Doc ann
pretty QualName VName
v Doc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
: (TypeArg dim -> Doc a) -> [TypeArg dim] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> TypeArg dim -> Doc a
forall dim a. Pretty (Shape dim) => Int -> TypeArg dim -> Doc a
prettyTypeArg Int
3) [TypeArg dim]
targs)
prettyScalarType Int
_ (Record Map Name (TypeBase dim u)
fs)
  | Just [TypeBase dim u]
ts <- Map Name (TypeBase dim u) -> Maybe [TypeBase dim u]
forall a. Map Name a -> Maybe [a]
areTupleFields Map Name (TypeBase dim u)
fs =
      Doc a -> Doc a
forall ann. Doc ann -> Doc ann
group (Doc a -> Doc a) -> Doc a -> Doc a
forall a b. (a -> b) -> a -> b
$ Doc a -> Doc a
forall ann. Doc ann -> Doc ann
parens (Doc a -> Doc a) -> Doc a -> Doc a
forall a b. (a -> b) -> a -> b
$ Doc a -> Doc a
forall ann. Doc ann -> Doc ann
align (Doc a -> Doc a) -> Doc a -> Doc a
forall a b. (a -> b) -> a -> b
$ [Doc a] -> Doc a
forall a. Monoid a => [a] -> a
mconcat ([Doc a] -> Doc a) -> [Doc a] -> Doc a
forall a b. (a -> b) -> a -> b
$ Doc a -> [Doc a] -> [Doc a]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate (Doc a
"," Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
forall ann. Doc ann
line) ([Doc a] -> [Doc a]) -> [Doc a] -> [Doc a]
forall a b. (a -> b) -> a -> b
$ (TypeBase dim u -> Doc a) -> [TypeBase dim u] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map TypeBase dim u -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. TypeBase dim u -> Doc ann
pretty [TypeBase dim u]
ts
  | Bool
otherwise =
      Doc a -> Doc a
forall ann. Doc ann -> Doc ann
group (Doc a -> Doc a) -> Doc a -> Doc a
forall a b. (a -> b) -> a -> b
$ Doc a -> Doc a
forall ann. Doc ann -> Doc ann
braces (Doc a -> Doc a) -> Doc a -> Doc a
forall a b. (a -> b) -> a -> b
$ Doc a -> Doc a
forall ann. Doc ann -> Doc ann
align (Doc a -> Doc a) -> Doc a -> Doc a
forall a b. (a -> b) -> a -> b
$ [Doc a] -> Doc a
forall a. Monoid a => [a] -> a
mconcat ([Doc a] -> Doc a) -> [Doc a] -> Doc a
forall a b. (a -> b) -> a -> b
$ Doc a -> [Doc a] -> [Doc a]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate (Doc a
"," Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
forall ann. Doc ann
line) [Doc a]
forall {ann}. [Doc ann]
fs'
  where
    ppField :: (Name, a) -> Doc ann
ppField (Name
name, a
t) = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Name -> String
nameToString Name
name) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
colon Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align (a -> Doc ann
forall ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
t)
    fs' :: [Doc ann]
fs' = ((Name, TypeBase dim u) -> Doc ann)
-> [(Name, TypeBase dim u)] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map (Name, TypeBase dim u) -> Doc ann
forall {a} {ann}. Pretty a => (Name, a) -> Doc ann
ppField ([(Name, TypeBase dim u)] -> [Doc ann])
-> [(Name, TypeBase dim u)] -> [Doc ann]
forall a b. (a -> b) -> a -> b
$ Map Name (TypeBase dim u) -> [(Name, TypeBase dim u)]
forall k a. Map k a -> [(k, a)]
M.toList Map Name (TypeBase dim u)
fs
prettyScalarType Int
p (Arrow u
_ (Named VName
v) Diet
d TypeBase dim NoUniqueness
t1 RetTypeBase dim Uniqueness
t2) =
  Bool -> Doc a -> Doc a
forall a. Bool -> Doc a -> Doc a
parensIf (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) (Doc a -> Doc a) -> Doc a -> Doc a
forall a b. (a -> b) -> a -> b
$
    Doc a -> Doc a
forall ann. Doc ann -> Doc ann
parens (VName -> Doc a
forall a. VName -> Doc a
forall v a. IsName v => v -> Doc a
prettyName VName
v Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
forall ann. Doc ann
colon Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Diet -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. Diet -> Doc ann
pretty Diet
d Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
align (TypeBase dim NoUniqueness -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. TypeBase dim NoUniqueness -> Doc ann
pretty TypeBase dim NoUniqueness
t1))
      Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc a
"->"
      Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> RetTypeBase dim Uniqueness -> Doc a
forall dim u a.
(Pretty (Shape dim), Pretty u) =>
Int -> RetTypeBase dim u -> Doc a
prettyRetType Int
1 RetTypeBase dim Uniqueness
t2
prettyScalarType Int
p (Arrow u
_ PName
Unnamed Diet
d TypeBase dim NoUniqueness
t1 RetTypeBase dim Uniqueness
t2) =
  Bool -> Doc a -> Doc a
forall a. Bool -> Doc a -> Doc a
parensIf (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) (Doc a -> Doc a) -> Doc a -> Doc a
forall a b. (a -> b) -> a -> b
$
    (Diet -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. Diet -> Doc ann
pretty Diet
d Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Int -> TypeBase dim NoUniqueness -> Doc a
forall dim u a.
(Pretty (Shape dim), Pretty u) =>
Int -> TypeBase dim u -> Doc a
prettyType Int
2 TypeBase dim NoUniqueness
t1)
      Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc a
"->"
      Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> RetTypeBase dim Uniqueness -> Doc a
forall dim u a.
(Pretty (Shape dim), Pretty u) =>
Int -> RetTypeBase dim u -> Doc a
prettyRetType Int
1 RetTypeBase dim Uniqueness
t2
prettyScalarType Int
p (Sum Map Name [TypeBase dim u]
cs) =
  Bool -> Doc a -> Doc a
forall a. Bool -> Doc a -> Doc a
parensIf (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (Doc a -> Doc a) -> Doc a -> Doc a
forall a b. (a -> b) -> a -> b
$
    Doc a -> Doc a
forall ann. Doc ann -> Doc ann
group (Doc a -> Doc a
forall ann. Doc ann -> Doc ann
align ([Doc a] -> Doc a
forall a. Monoid a => [a] -> a
mconcat ([Doc a] -> Doc a) -> [Doc a] -> Doc a
forall a b. (a -> b) -> a -> b
$ Doc a -> [Doc a] -> [Doc a]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate (Doc a
" |" Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
forall ann. Doc ann
line) [Doc a]
forall {ann}. [Doc ann]
cs'))
  where
    ppConstr :: (a, [TypeBase dim u]) -> Doc ann
ppConstr (a
name, [TypeBase dim u]
fs) = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
sep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ (Doc ann
"#" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> a -> Doc ann
forall ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
name) Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: (TypeBase dim u -> Doc ann) -> [TypeBase dim u] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> TypeBase dim u -> Doc ann
forall dim u a.
(Pretty (Shape dim), Pretty u) =>
Int -> TypeBase dim u -> Doc a
prettyType Int
2) [TypeBase dim u]
fs
    cs' :: [Doc ann]
cs' = ((Name, [TypeBase dim u]) -> Doc ann)
-> [(Name, [TypeBase dim u])] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map (Name, [TypeBase dim u]) -> Doc ann
forall {a} {u} {dim} {ann}.
(Pretty a, Pretty u, Pretty (Shape dim)) =>
(a, [TypeBase dim u]) -> Doc ann
ppConstr ([(Name, [TypeBase dim u])] -> [Doc ann])
-> [(Name, [TypeBase dim u])] -> [Doc ann]
forall a b. (a -> b) -> a -> b
$ Map Name [TypeBase dim u] -> [(Name, [TypeBase dim u])]
forall k a. Map k a -> [(k, a)]
M.toList Map Name [TypeBase dim u]
cs

instance (Pretty (Shape dim), Pretty u) => Pretty (ScalarTypeBase dim u) where
  pretty :: forall ann. ScalarTypeBase dim u -> Doc ann
pretty = Int -> ScalarTypeBase dim u -> Doc ann
forall dim u a.
(Pretty (Shape dim), Pretty u) =>
Int -> ScalarTypeBase dim u -> Doc a
prettyScalarType Int
0

prettyType :: (Pretty (Shape dim), Pretty u) => Int -> TypeBase dim u -> Doc a
prettyType :: forall dim u a.
(Pretty (Shape dim), Pretty u) =>
Int -> TypeBase dim u -> Doc a
prettyType Int
_ (Array u
u Shape dim
shape ScalarTypeBase dim NoUniqueness
at) =
  u -> Doc a
forall ann. u -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty u
u Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Shape dim -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. Shape dim -> Doc ann
pretty Shape dim
shape Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
align (Int -> ScalarTypeBase dim NoUniqueness -> Doc a
forall dim u a.
(Pretty (Shape dim), Pretty u) =>
Int -> ScalarTypeBase dim u -> Doc a
prettyScalarType Int
1 ScalarTypeBase dim NoUniqueness
at)
prettyType Int
p (Scalar ScalarTypeBase dim u
t) =
  Int -> ScalarTypeBase dim u -> Doc a
forall dim u a.
(Pretty (Shape dim), Pretty u) =>
Int -> ScalarTypeBase dim u -> Doc a
prettyScalarType Int
p ScalarTypeBase dim u
t

instance (Pretty (Shape dim), Pretty u) => Pretty (TypeBase dim u) where
  pretty :: forall ann. TypeBase dim u -> Doc ann
pretty = Int -> TypeBase dim u -> Doc ann
forall dim u a.
(Pretty (Shape dim), Pretty u) =>
Int -> TypeBase dim u -> Doc a
prettyType Int
0

prettyTypeArg :: (Pretty (Shape dim)) => Int -> TypeArg dim -> Doc a
prettyTypeArg :: forall dim a. Pretty (Shape dim) => Int -> TypeArg dim -> Doc a
prettyTypeArg Int
_ (TypeArgDim dim
d) = Shape dim -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. Shape dim -> Doc ann
pretty (Shape dim -> Doc a) -> Shape dim -> Doc a
forall a b. (a -> b) -> a -> b
$ [dim] -> Shape dim
forall dim. [dim] -> Shape dim
Shape [dim
d]
prettyTypeArg Int
p (TypeArgType TypeBase dim NoUniqueness
t) = Int -> TypeBase dim NoUniqueness -> Doc a
forall dim u a.
(Pretty (Shape dim), Pretty u) =>
Int -> TypeBase dim u -> Doc a
prettyType Int
p TypeBase dim NoUniqueness
t

instance Pretty (TypeArg Size) where
  pretty :: forall ann. TypeArg Size -> Doc ann
pretty = Int -> TypeArg Size -> Doc ann
forall dim a. Pretty (Shape dim) => Int -> TypeArg dim -> Doc a
prettyTypeArg Int
0

instance (Eq vn, IsName vn, Annot f) => Pretty (TypeExp f vn) where
  pretty :: forall ann. TypeExp f vn -> Doc ann
pretty (TEUnique TypeExp f vn
t SrcLoc
_) = Doc ann
"*" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> TypeExp f vn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. TypeExp f vn -> Doc ann
pretty TypeExp f vn
t
  pretty (TEArray SizeExp f vn
d TypeExp f vn
at SrcLoc
_) = SizeExp f vn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. SizeExp f vn -> Doc ann
pretty SizeExp f vn
d Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> TypeExp f vn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. TypeExp f vn -> Doc ann
pretty TypeExp f vn
at
  pretty (TETuple [TypeExp f vn]
ts SrcLoc
_) = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
commasep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ (TypeExp f vn -> Doc ann) -> [TypeExp f vn] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map TypeExp f vn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. TypeExp f vn -> Doc ann
pretty [TypeExp f vn]
ts
  pretty (TERecord [(Name, TypeExp f vn)]
fs SrcLoc
_) = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
braces (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
commasep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ ((Name, TypeExp f vn) -> Doc ann)
-> [(Name, TypeExp f vn)] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map (Name, TypeExp f vn) -> Doc ann
forall {a} {ann}. Pretty a => (Name, a) -> Doc ann
ppField [(Name, TypeExp f vn)]
fs
    where
      ppField :: (Name, a) -> Doc ann
ppField (Name
name, a
t) = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Name -> String
nameToString Name
name) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
colon Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> a -> Doc ann
forall ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
t
  pretty (TEVar QualName vn
name SrcLoc
_) = QualName vn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. QualName vn -> Doc ann
pretty QualName vn
name
  pretty (TEParens TypeExp f vn
te SrcLoc
_) = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ TypeExp f vn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. TypeExp f vn -> Doc ann
pretty TypeExp f vn
te
  pretty (TEApply TypeExp f vn
t TypeArgExp f vn
arg SrcLoc
_) = TypeExp f vn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. TypeExp f vn -> Doc ann
pretty TypeExp f vn
t Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> TypeArgExp f vn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. TypeArgExp f vn -> Doc ann
pretty TypeArgExp f vn
arg
  pretty (TEArrow (Just vn
v) TypeExp f vn
t1 TypeExp f vn
t2 SrcLoc
_) = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens Doc ann
forall ann. Doc ann
v' Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"->" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> TypeExp f vn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. TypeExp f vn -> Doc ann
pretty TypeExp f vn
t2
    where
      v' :: Doc a
v' = vn -> Doc a
forall a. vn -> Doc a
forall v a. IsName v => v -> Doc a
prettyName vn
v Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
forall ann. Doc ann
colon Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
<+> TypeExp f vn -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. TypeExp f vn -> Doc ann
pretty TypeExp f vn
t1
  pretty (TEArrow Maybe vn
Nothing TypeExp f vn
t1 TypeExp f vn
t2 SrcLoc
_) = TypeExp f vn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. TypeExp f vn -> Doc ann
pretty TypeExp f vn
t1 Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"->" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> TypeExp f vn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. TypeExp f vn -> Doc ann
pretty TypeExp f vn
t2
  pretty (TESum [(Name, [TypeExp f vn])]
cs SrcLoc
_) =
    Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
cat ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate (Doc ann
" |" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
softline) ([Doc ann] -> [Doc ann]) -> [Doc ann] -> [Doc ann]
forall a b. (a -> b) -> a -> b
$ ((Name, [TypeExp f vn]) -> Doc ann)
-> [(Name, [TypeExp f vn])] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map (Name, [TypeExp f vn]) -> Doc ann
forall {a} {a} {ann}. (Pretty a, Pretty a) => (a, [a]) -> Doc ann
ppConstr [(Name, [TypeExp f vn])]
cs
    where
      ppConstr :: (a, [a]) -> Doc ann
ppConstr (a
name, [a]
fs) = Doc ann
"#" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> a -> Doc ann
forall ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
name Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
sep ((a -> Doc ann) -> [a] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map a -> Doc ann
forall ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [a]
fs)
  pretty (TEDim [vn]
dims TypeExp f vn
te SrcLoc
_) =
    Doc ann
"?" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat ((vn -> Doc ann) -> [vn] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map (Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
brackets (Doc ann -> Doc ann) -> (vn -> Doc ann) -> vn -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. vn -> Doc ann
forall a. vn -> Doc a
forall v a. IsName v => v -> Doc a
prettyName) [vn]
dims) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"." Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> TypeExp f vn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. TypeExp f vn -> Doc ann
pretty TypeExp f vn
te

instance (Eq vn, IsName vn, Annot f) => Pretty (TypeArgExp f vn) where
  pretty :: forall ann. TypeArgExp f vn -> Doc ann
pretty (TypeArgExpSize SizeExp f vn
d) = SizeExp f vn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. SizeExp f vn -> Doc ann
pretty SizeExp f vn
d
  pretty (TypeArgExpType TypeExp f vn
t) = TypeExp f vn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. TypeExp f vn -> Doc ann
pretty TypeExp f vn
t

instance (IsName vn) => Pretty (QualName vn) where
  pretty :: forall ann. QualName vn -> Doc ann
pretty (QualName [vn]
names vn
name) =
    [Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
"." ([Doc ann] -> [Doc ann]) -> [Doc ann] -> [Doc ann]
forall a b. (a -> b) -> a -> b
$ (vn -> Doc ann) -> [vn] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map vn -> Doc ann
forall a. vn -> Doc a
forall v a. IsName v => v -> Doc a
prettyName [vn]
names [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. [a] -> [a] -> [a]
++ [vn -> Doc ann
forall a. vn -> Doc a
forall v a. IsName v => v -> Doc a
prettyName vn
name]

instance (IsName vn) => Pretty (IdentBase f vn t) where
  pretty :: forall ann. IdentBase f vn t -> Doc ann
pretty = vn -> Doc ann
forall a. vn -> Doc a
forall v a. IsName v => v -> Doc a
prettyName (vn -> Doc ann)
-> (IdentBase f vn t -> vn) -> IdentBase f vn t -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdentBase f vn t -> vn
forall {k} (f :: k -> *) vn (t :: k). IdentBase f vn t -> vn
identName

hasArrayLit :: ExpBase ty vn -> Bool
hasArrayLit :: forall (ty :: * -> *) vn. ExpBase ty vn -> Bool
hasArrayLit ArrayLit {} = Bool
True
hasArrayLit (TupLit [ExpBase ty vn]
es2 SrcLoc
_) = (ExpBase ty vn -> Bool) -> [ExpBase ty vn] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ExpBase ty vn -> Bool
forall (ty :: * -> *) vn. ExpBase ty vn -> Bool
hasArrayLit [ExpBase ty vn]
es2
hasArrayLit ExpBase ty vn
_ = Bool
False

instance (Eq vn, IsName vn, Annot f) => Pretty (DimIndexBase f vn) where
  pretty :: forall ann. DimIndexBase f vn -> Doc ann
pretty (DimFix ExpBase f vn
e) = ExpBase f vn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ExpBase f vn -> Doc ann
pretty ExpBase f vn
e
  pretty (DimSlice Maybe (ExpBase f vn)
i Maybe (ExpBase f vn)
j (Just ExpBase f vn
s)) =
    Doc ann
-> (ExpBase f vn -> Doc ann) -> Maybe (ExpBase f vn) -> Doc ann
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc ann
forall a. Monoid a => a
mempty ExpBase f vn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ExpBase f vn -> Doc ann
pretty Maybe (ExpBase f vn)
i
      Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
":"
      Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
-> (ExpBase f vn -> Doc ann) -> Maybe (ExpBase f vn) -> Doc ann
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc ann
forall a. Monoid a => a
mempty ExpBase f vn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ExpBase f vn -> Doc ann
pretty Maybe (ExpBase f vn)
j
      Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
":"
      Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> ExpBase f vn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ExpBase f vn -> Doc ann
pretty ExpBase f vn
s
  pretty (DimSlice Maybe (ExpBase f vn)
i (Just ExpBase f vn
j) Maybe (ExpBase f vn)
s) =
    Doc ann
-> (ExpBase f vn -> Doc ann) -> Maybe (ExpBase f vn) -> Doc ann
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc ann
forall a. Monoid a => a
mempty ExpBase f vn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ExpBase f vn -> Doc ann
pretty Maybe (ExpBase f vn)
i
      Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
":"
      Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> ExpBase f vn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ExpBase f vn -> Doc ann
pretty ExpBase f vn
j
      Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
-> (ExpBase f vn -> Doc ann) -> Maybe (ExpBase f vn) -> Doc ann
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc ann
forall a. Monoid a => a
mempty ((Doc ann
":" <>) (Doc ann -> Doc ann)
-> (ExpBase f vn -> Doc ann) -> ExpBase f vn -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExpBase f vn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ExpBase f vn -> Doc ann
pretty) Maybe (ExpBase f vn)
s
  pretty (DimSlice Maybe (ExpBase f vn)
i Maybe (ExpBase f vn)
Nothing Maybe (ExpBase f vn)
Nothing) =
    Doc ann
-> (ExpBase f vn -> Doc ann) -> Maybe (ExpBase f vn) -> Doc ann
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc ann
forall a. Monoid a => a
mempty ExpBase f vn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ExpBase f vn -> Doc ann
pretty Maybe (ExpBase f vn)
i Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
":"

instance (IsName vn) => Pretty (SizeBinder vn) where
  pretty :: forall ann. SizeBinder vn -> Doc ann
pretty (SizeBinder vn
v SrcLoc
_) = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
brackets (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ vn -> Doc ann
forall a. vn -> Doc a
forall v a. IsName v => v -> Doc a
prettyName vn
v

letBody :: (Eq vn, IsName vn, Annot f) => ExpBase f vn -> Doc a
letBody :: forall vn (f :: * -> *) a.
(Eq vn, IsName vn, Annot f) =>
ExpBase f vn -> Doc a
letBody body :: ExpBase f vn
body@(AppExp LetPat {} f AppRes
_) = ExpBase f vn -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. ExpBase f vn -> Doc ann
pretty ExpBase f vn
body
letBody body :: ExpBase f vn
body@(AppExp LetFun {} f AppRes
_) = ExpBase f vn -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. ExpBase f vn -> Doc ann
pretty ExpBase f vn
body
letBody ExpBase f vn
body = Doc a
"in" Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
align (ExpBase f vn -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. ExpBase f vn -> Doc ann
pretty ExpBase f vn
body)

prettyAppExp :: (Eq vn, IsName vn, Annot f) => Int -> AppExpBase f vn -> Doc a
prettyAppExp :: forall vn (f :: * -> *) a.
(Eq vn, IsName vn, Annot f) =>
Int -> AppExpBase f vn -> Doc a
prettyAppExp Int
p (BinOp (QualName vn
bop, SrcLoc
_) f StructType
_ (ExpBase f vn
x, f (Maybe VName)
_) (ExpBase f vn
y, f (Maybe VName)
_) SrcLoc
_) = Int -> QualName vn -> ExpBase f vn -> ExpBase f vn -> Doc a
forall vn (f :: * -> *) a.
(Eq vn, IsName vn, Annot f) =>
Int -> QualName vn -> ExpBase f vn -> ExpBase f vn -> Doc a
prettyBinOp Int
p QualName vn
bop ExpBase f vn
x ExpBase f vn
y
prettyAppExp Int
_ (Match ExpBase f vn
e NonEmpty (CaseBase f vn)
cs SrcLoc
_) = Doc a
"match" Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ExpBase f vn -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. ExpBase f vn -> Doc ann
pretty ExpBase f vn
e Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
</> ([Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
stack ([Doc a] -> Doc a)
-> ([CaseBase f vn] -> [Doc a]) -> [CaseBase f vn] -> Doc a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CaseBase f vn -> Doc a) -> [CaseBase f vn] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map CaseBase f vn -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. CaseBase f vn -> Doc ann
pretty) (NonEmpty (CaseBase f vn) -> [CaseBase f vn]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (CaseBase f vn)
cs)
prettyAppExp Int
_ (Loop [VName]
sizeparams PatBase f vn ParamType
pat ExpBase f vn
initexp LoopFormBase f vn
form ExpBase f vn
loopbody SrcLoc
_) =
  Doc a
"loop"
    Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
align
      ( [Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
hsep ((VName -> Doc a) -> [VName] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map (Doc a -> Doc a
forall ann. Doc ann -> Doc ann
brackets (Doc a -> Doc a) -> (VName -> Doc a) -> VName -> Doc a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VName -> Doc a
forall a. VName -> Doc a
forall v a. IsName v => v -> Doc a
prettyName) [VName]
sizeparams [Doc a] -> [Doc a] -> [Doc a]
forall a. [a] -> [a] -> [a]
++ [PatBase f vn ParamType -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. PatBase f vn ParamType -> Doc ann
pretty PatBase f vn ParamType
pat])
          Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc a
forall ann. Doc ann
equals
          Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ExpBase f vn -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. ExpBase f vn -> Doc ann
pretty ExpBase f vn
initexp
          Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
</> LoopFormBase f vn -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. LoopFormBase f vn -> Doc ann
pretty LoopFormBase f vn
form
          Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
</> Doc a
"do"
      )
    Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
</> Int -> Doc a -> Doc a
forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (ExpBase f vn -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. ExpBase f vn -> Doc ann
pretty ExpBase f vn
loopbody)
prettyAppExp Int
_ (Index ExpBase f vn
e SliceBase f vn
idxs SrcLoc
_) =
  Int -> ExpBase f vn -> Doc a
forall vn (f :: * -> *) a.
(Eq vn, IsName vn, Annot f) =>
Int -> ExpBase f vn -> Doc a
prettyExp Int
9 ExpBase f vn
e Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
brackets ([Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
commasep ((DimIndexBase f vn -> Doc a) -> SliceBase f vn -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map DimIndexBase f vn -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. DimIndexBase f vn -> Doc ann
pretty SliceBase f vn
idxs))
prettyAppExp Int
p (LetPat [SizeBinder vn]
sizes PatBase f vn StructType
pat ExpBase f vn
e ExpBase f vn
body SrcLoc
_) =
  Bool -> Doc a -> Doc a
forall a. Bool -> Doc a -> Doc a
parensIf (Int
p Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= -Int
1) (Doc a -> Doc a) -> (Doc a -> Doc a) -> Doc a -> Doc a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc a -> Doc a
forall ann. Doc ann -> Doc ann
align (Doc a -> Doc a) -> Doc a -> Doc a
forall a b. (a -> b) -> a -> b
$
    [Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
hsep (Doc a
"let" Doc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
: (SizeBinder vn -> Doc a) -> [SizeBinder vn] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map SizeBinder vn -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. SizeBinder vn -> Doc ann
pretty [SizeBinder vn]
sizes [Doc a] -> [Doc a] -> [Doc a]
forall a. [a] -> [a] -> [a]
++ [Doc a -> Doc a
forall ann. Doc ann -> Doc ann
align (PatBase f vn StructType -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. PatBase f vn StructType -> Doc ann
pretty PatBase f vn StructType
pat)])
      Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ( if Bool
linebreak
              then Doc a
forall ann. Doc ann
equals Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
</> Int -> Doc a -> Doc a
forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (ExpBase f vn -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. ExpBase f vn -> Doc ann
pretty ExpBase f vn
e)
              else Doc a
forall ann. Doc ann
equals Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
align (ExpBase f vn -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. ExpBase f vn -> Doc ann
pretty ExpBase f vn
e)
          )
      Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
</> ExpBase f vn -> Doc a
forall vn (f :: * -> *) a.
(Eq vn, IsName vn, Annot f) =>
ExpBase f vn -> Doc a
letBody ExpBase f vn
body
  where
    linebreak :: Bool
linebreak = case ExpBase f vn
e of
      AppExp {} -> Bool
True
      Coerce {} -> Bool
True
      Attr {} -> Bool
True
      ArrayLit {} -> Bool
False
      Lambda {} -> Bool
True
      ExpBase f vn
_ -> ExpBase f vn -> Bool
forall (ty :: * -> *) vn. ExpBase ty vn -> Bool
hasArrayLit ExpBase f vn
e
prettyAppExp Int
_ (LetFun vn
fname ([TypeParamBase vn]
tparams, [PatBase f vn ParamType]
params, Maybe (TypeExp f vn)
retdecl, f ResRetType
rettype, ExpBase f vn
e) ExpBase f vn
body SrcLoc
_) =
  Doc a
"let"
    Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
hsep (vn -> Doc a
forall a. vn -> Doc a
forall v a. IsName v => v -> Doc a
prettyName vn
fname Doc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
: (TypeParamBase vn -> Doc a) -> [TypeParamBase vn] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map TypeParamBase vn -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. TypeParamBase vn -> Doc ann
pretty [TypeParamBase vn]
tparams [Doc a] -> [Doc a] -> [Doc a]
forall a. [a] -> [a] -> [a]
++ (PatBase f vn ParamType -> Doc a)
-> [PatBase f vn ParamType] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map PatBase f vn ParamType -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. PatBase f vn ParamType -> Doc ann
pretty [PatBase f vn ParamType]
params)
    Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
forall ann. Doc ann
retdecl'
      Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc a
forall ann. Doc ann
equals
      Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
</> Int -> Doc a -> Doc a
forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (ExpBase f vn -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. ExpBase f vn -> Doc ann
pretty ExpBase f vn
e)
      Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
</> ExpBase f vn -> Doc a
forall vn (f :: * -> *) a.
(Eq vn, IsName vn, Annot f) =>
ExpBase f vn -> Doc a
letBody ExpBase f vn
body
  where
    retdecl' :: Doc ann
retdecl' = case (ResRetType -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ResRetType -> Doc ann
pretty (ResRetType -> Doc ann) -> Maybe ResRetType -> Maybe (Doc ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f ResRetType -> Maybe ResRetType
forall a. f a -> Maybe a
forall (f :: * -> *) a. Annot f => f a -> Maybe a
unAnnot f ResRetType
rettype) Maybe (Doc ann) -> Maybe (Doc ann) -> Maybe (Doc ann)
forall a. Maybe a -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` (TypeExp f vn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. TypeExp f vn -> Doc ann
pretty (TypeExp f vn -> Doc ann)
-> Maybe (TypeExp f vn) -> Maybe (Doc ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (TypeExp f vn)
retdecl) of
      Just Doc ann
rettype' -> Doc ann
forall ann. Doc ann
colon Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align Doc ann
rettype'
      Maybe (Doc ann)
Nothing -> Doc ann
forall a. Monoid a => a
mempty
prettyAppExp Int
_ (LetWith IdentBase f vn StructType
dest IdentBase f vn StructType
src SliceBase f vn
idxs ExpBase f vn
ve ExpBase f vn
body SrcLoc
_)
  | IdentBase f vn StructType
dest IdentBase f vn StructType -> IdentBase f vn StructType -> Bool
forall a. Eq a => a -> a -> Bool
== IdentBase f vn StructType
src =
      Doc a
"let"
        Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
<+> IdentBase f vn StructType -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. IdentBase f vn StructType -> Doc ann
pretty IdentBase f vn StructType
dest
        Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> [Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
list ((DimIndexBase f vn -> Doc a) -> SliceBase f vn -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map DimIndexBase f vn -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. DimIndexBase f vn -> Doc ann
pretty SliceBase f vn
idxs)
          Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc a
forall ann. Doc ann
equals
          Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
align (ExpBase f vn -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. ExpBase f vn -> Doc ann
pretty ExpBase f vn
ve)
          Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
</> ExpBase f vn -> Doc a
forall vn (f :: * -> *) a.
(Eq vn, IsName vn, Annot f) =>
ExpBase f vn -> Doc a
letBody ExpBase f vn
body
  | Bool
otherwise =
      Doc a
"let"
        Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
<+> IdentBase f vn StructType -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. IdentBase f vn StructType -> Doc ann
pretty IdentBase f vn StructType
dest
        Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc a
forall ann. Doc ann
equals
        Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
<+> IdentBase f vn StructType -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. IdentBase f vn StructType -> Doc ann
pretty IdentBase f vn StructType
src
        Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc a
"with"
        Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
brackets ([Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
commasep ((DimIndexBase f vn -> Doc a) -> SliceBase f vn -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map DimIndexBase f vn -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. DimIndexBase f vn -> Doc ann
pretty SliceBase f vn
idxs))
        Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc a
"="
        Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
align (ExpBase f vn -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. ExpBase f vn -> Doc ann
pretty ExpBase f vn
ve)
        Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
</> ExpBase f vn -> Doc a
forall vn (f :: * -> *) a.
(Eq vn, IsName vn, Annot f) =>
ExpBase f vn -> Doc a
letBody ExpBase f vn
body
prettyAppExp Int
p (Range ExpBase f vn
start Maybe (ExpBase f vn)
maybe_step Inclusiveness (ExpBase f vn)
end SrcLoc
_) =
  Bool -> Doc a -> Doc a
forall a. Bool -> Doc a -> Doc a
parensIf (Int
p Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= -Int
1) (Doc a -> Doc a) -> Doc a -> Doc a
forall a b. (a -> b) -> a -> b
$
    ExpBase f vn -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. ExpBase f vn -> Doc ann
pretty ExpBase f vn
start
      Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a -> (ExpBase f vn -> Doc a) -> Maybe (ExpBase f vn) -> Doc a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc a
forall a. Monoid a => a
mempty ((Doc a
".." <>) (Doc a -> Doc a)
-> (ExpBase f vn -> Doc a) -> ExpBase f vn -> Doc a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExpBase f vn -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. ExpBase f vn -> Doc ann
pretty) Maybe (ExpBase f vn)
maybe_step
      Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> case Inclusiveness (ExpBase f vn)
end of
        DownToExclusive ExpBase f vn
end' -> Doc a
"..>" Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> ExpBase f vn -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. ExpBase f vn -> Doc ann
pretty ExpBase f vn
end'
        ToInclusive ExpBase f vn
end' -> Doc a
"..." Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> ExpBase f vn -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. ExpBase f vn -> Doc ann
pretty ExpBase f vn
end'
        UpToExclusive ExpBase f vn
end' -> Doc a
"..<" Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> ExpBase f vn -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. ExpBase f vn -> Doc ann
pretty ExpBase f vn
end'
prettyAppExp Int
_ (If ExpBase f vn
c ExpBase f vn
t ExpBase f vn
f SrcLoc
_) =
  Doc a
"if"
    Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ExpBase f vn -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. ExpBase f vn -> Doc ann
pretty ExpBase f vn
c
    Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
</> Doc a
"then"
    Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
align (ExpBase f vn -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. ExpBase f vn -> Doc ann
pretty ExpBase f vn
t)
    Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
</> Doc a
"else"
    Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
align (ExpBase f vn -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. ExpBase f vn -> Doc ann
pretty ExpBase f vn
f)
prettyAppExp Int
p (Apply ExpBase f vn
f NonEmpty (f (Diet, Maybe VName), ExpBase f vn)
args SrcLoc
_) =
  Bool -> Doc a -> Doc a
forall a. Bool -> Doc a -> Doc a
parensIf (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
10) (Doc a -> Doc a) -> Doc a -> Doc a
forall a b. (a -> b) -> a -> b
$
    Int -> ExpBase f vn -> Doc a
forall vn (f :: * -> *) a.
(Eq vn, IsName vn, Annot f) =>
Int -> ExpBase f vn -> Doc a
prettyExp Int
0 ExpBase f vn
f
      Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
hsep (((f (Diet, Maybe VName), ExpBase f vn) -> Doc a)
-> [(f (Diet, Maybe VName), ExpBase f vn)] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> ExpBase f vn -> Doc a
forall vn (f :: * -> *) a.
(Eq vn, IsName vn, Annot f) =>
Int -> ExpBase f vn -> Doc a
prettyExp Int
10 (ExpBase f vn -> Doc a)
-> ((f (Diet, Maybe VName), ExpBase f vn) -> ExpBase f vn)
-> (f (Diet, Maybe VName), ExpBase f vn)
-> Doc a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f (Diet, Maybe VName), ExpBase f vn) -> ExpBase f vn
forall a b. (a, b) -> b
snd) ([(f (Diet, Maybe VName), ExpBase f vn)] -> [Doc a])
-> [(f (Diet, Maybe VName), ExpBase f vn)] -> [Doc a]
forall a b. (a -> b) -> a -> b
$ NonEmpty (f (Diet, Maybe VName), ExpBase f vn)
-> [(f (Diet, Maybe VName), ExpBase f vn)]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (f (Diet, Maybe VName), ExpBase f vn)
args)

instance (Eq vn, IsName vn, Annot f) => Pretty (AppExpBase f vn) where
  pretty :: forall ann. AppExpBase f vn -> Doc ann
pretty = Int -> AppExpBase f vn -> Doc ann
forall vn (f :: * -> *) a.
(Eq vn, IsName vn, Annot f) =>
Int -> AppExpBase f vn -> Doc a
prettyAppExp (-Int
1)

prettyInst :: (Annot f, Pretty t) => f t -> Doc a
prettyInst :: forall (f :: * -> *) t a. (Annot f, Pretty t) => f t -> Doc a
prettyInst f t
t =
  case f t -> Maybe t
forall a. f a -> Maybe a
forall (f :: * -> *) a. Annot f => f a -> Maybe a
unAnnot f t
t of
    Just t
t'
      | String -> Int -> Bool
isEnvVarAtLeast String
"FUTHARK_COMPILER_DEBUGGING" Int
2 ->
          Doc a
"@" Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
parens (Doc a -> Doc a
forall ann. Doc ann -> Doc ann
align (Doc a -> Doc a) -> Doc a -> Doc a
forall a b. (a -> b) -> a -> b
$ t -> Doc a
forall ann. t -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty t
t')
    Maybe t
_ -> Doc a
forall a. Monoid a => a
mempty

prettyAttr :: (Pretty a) => a -> Doc ann
prettyAttr :: forall a ann. Pretty a => a -> Doc ann
prettyAttr a
attr = Doc ann
"#[" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> a -> Doc ann
forall ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
attr Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"]"

operatorName :: Name -> Bool
operatorName :: Name -> Bool
operatorName = (Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
opchars) (Char -> Bool) -> (Name -> Char) -> Name -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Char
Text -> Char
T.head (Text -> Char) -> (Name -> Text) -> Name -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Text
nameToText
  where
    opchars :: String
    opchars :: String
opchars = String
"+-*/%=!><|&^."

prettyExp :: (Eq vn, IsName vn, Annot f) => Int -> ExpBase f vn -> Doc a
prettyExp :: forall vn (f :: * -> *) a.
(Eq vn, IsName vn, Annot f) =>
Int -> ExpBase f vn -> Doc a
prettyExp Int
_ (Var QualName vn
name f StructType
t SrcLoc
_)
  -- The first case occurs only for programs that have been normalised
  -- by the compiler.
  | Name -> Bool
operatorName (vn -> Name
forall v. IsName v => v -> Name
toName (QualName vn -> vn
forall vn. QualName vn -> vn
qualLeaf QualName vn
name)) = Doc a -> Doc a
forall ann. Doc ann -> Doc ann
parens (Doc a -> Doc a) -> Doc a -> Doc a
forall a b. (a -> b) -> a -> b
$ QualName vn -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. QualName vn -> Doc ann
pretty QualName vn
name Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> f StructType -> Doc a
forall (f :: * -> *) t a. (Annot f, Pretty t) => f t -> Doc a
prettyInst f StructType
t
  | Bool
otherwise = QualName vn -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. QualName vn -> Doc ann
pretty QualName vn
name Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> f StructType -> Doc a
forall (f :: * -> *) t a. (Annot f, Pretty t) => f t -> Doc a
prettyInst f StructType
t
prettyExp Int
_ (Hole f StructType
t SrcLoc
_) = Doc a
"???" Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> f StructType -> Doc a
forall (f :: * -> *) t a. (Annot f, Pretty t) => f t -> Doc a
prettyInst f StructType
t
prettyExp Int
_ (Parens ExpBase f vn
e SrcLoc
_) = Doc a -> Doc a
forall ann. Doc ann -> Doc ann
align (Doc a -> Doc a) -> Doc a -> Doc a
forall a b. (a -> b) -> a -> b
$ Doc a -> Doc a
forall ann. Doc ann -> Doc ann
parens (Doc a -> Doc a) -> Doc a -> Doc a
forall a b. (a -> b) -> a -> b
$ ExpBase f vn -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. ExpBase f vn -> Doc ann
pretty ExpBase f vn
e
prettyExp Int
_ (QualParens (QualName vn
v, SrcLoc
_) ExpBase f vn
e SrcLoc
_) = QualName vn -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. QualName vn -> Doc ann
pretty QualName vn
v Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
"." Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
align (Doc a -> Doc a
forall ann. Doc ann -> Doc ann
parens (Doc a -> Doc a) -> Doc a -> Doc a
forall a b. (a -> b) -> a -> b
$ ExpBase f vn -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. ExpBase f vn -> Doc ann
pretty ExpBase f vn
e)
prettyExp Int
p (Ascript ExpBase f vn
e TypeExp f vn
t SrcLoc
_) =
  Bool -> Doc a -> Doc a
forall a. Bool -> Doc a -> Doc a
parensIf (Int
p Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= -Int
1) (Doc a -> Doc a) -> Doc a -> Doc a
forall a b. (a -> b) -> a -> b
$ Int -> ExpBase f vn -> Doc a
forall vn (f :: * -> *) a.
(Eq vn, IsName vn, Annot f) =>
Int -> ExpBase f vn -> Doc a
prettyExp Int
0 ExpBase f vn
e Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc a
":" Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
align (TypeExp f vn -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. TypeExp f vn -> Doc ann
pretty TypeExp f vn
t)
prettyExp Int
p (Coerce ExpBase f vn
e TypeExp f vn
t f StructType
_ SrcLoc
_) =
  Bool -> Doc a -> Doc a
forall a. Bool -> Doc a -> Doc a
parensIf (Int
p Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= -Int
1) (Doc a -> Doc a) -> Doc a -> Doc a
forall a b. (a -> b) -> a -> b
$ Int -> ExpBase f vn -> Doc a
forall vn (f :: * -> *) a.
(Eq vn, IsName vn, Annot f) =>
Int -> ExpBase f vn -> Doc a
prettyExp Int
0 ExpBase f vn
e Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc a
":>" Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
align (TypeExp f vn -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. TypeExp f vn -> Doc ann
pretty TypeExp f vn
t)
prettyExp Int
_ (Literal PrimValue
v SrcLoc
_) = PrimValue -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. PrimValue -> Doc ann
pretty PrimValue
v
prettyExp Int
_ (IntLit Integer
v f StructType
t SrcLoc
_) = Integer -> Doc a
forall ann. Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Integer
v Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> f StructType -> Doc a
forall (f :: * -> *) t a. (Annot f, Pretty t) => f t -> Doc a
prettyInst f StructType
t
prettyExp Int
_ (FloatLit Double
v f StructType
t SrcLoc
_) = Double -> Doc a
forall ann. Double -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Double
v Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> f StructType -> Doc a
forall (f :: * -> *) t a. (Annot f, Pretty t) => f t -> Doc a
prettyInst f StructType
t
prettyExp Int
_ (TupLit [ExpBase f vn]
es SrcLoc
_)
  | (ExpBase f vn -> Bool) -> [ExpBase f vn] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ExpBase f vn -> Bool
forall (ty :: * -> *) vn. ExpBase ty vn -> Bool
hasArrayLit [ExpBase f vn]
es = Doc a -> Doc a
forall ann. Doc ann -> Doc ann
parens (Doc a -> Doc a) -> Doc a -> Doc a
forall a b. (a -> b) -> a -> b
$ [Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
commastack ([Doc a] -> Doc a) -> [Doc a] -> Doc a
forall a b. (a -> b) -> a -> b
$ (ExpBase f vn -> Doc a) -> [ExpBase f vn] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map ExpBase f vn -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. ExpBase f vn -> Doc ann
pretty [ExpBase f vn]
es
  | Bool
otherwise = Doc a -> Doc a
forall ann. Doc ann -> Doc ann
parens (Doc a -> Doc a) -> Doc a -> Doc a
forall a b. (a -> b) -> a -> b
$ [Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
commasep ([Doc a] -> Doc a) -> [Doc a] -> Doc a
forall a b. (a -> b) -> a -> b
$ (ExpBase f vn -> Doc a) -> [ExpBase f vn] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map ExpBase f vn -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. ExpBase f vn -> Doc ann
pretty [ExpBase f vn]
es
prettyExp Int
_ (RecordLit [FieldBase f vn]
fs SrcLoc
_)
  | (FieldBase f vn -> Bool) -> [FieldBase f vn] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any FieldBase f vn -> Bool
forall {ty :: * -> *} {vn}. FieldBase ty vn -> Bool
fieldArray [FieldBase f vn]
fs = Doc a -> Doc a
forall ann. Doc ann -> Doc ann
braces (Doc a -> Doc a) -> Doc a -> Doc a
forall a b. (a -> b) -> a -> b
$ [Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
commastack ([Doc a] -> Doc a) -> [Doc a] -> Doc a
forall a b. (a -> b) -> a -> b
$ (FieldBase f vn -> Doc a) -> [FieldBase f vn] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map FieldBase f vn -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. FieldBase f vn -> Doc ann
pretty [FieldBase f vn]
fs
  | Bool
otherwise = Doc a -> Doc a
forall ann. Doc ann -> Doc ann
braces (Doc a -> Doc a) -> Doc a -> Doc a
forall a b. (a -> b) -> a -> b
$ [Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
commasep ([Doc a] -> Doc a) -> [Doc a] -> Doc a
forall a b. (a -> b) -> a -> b
$ (FieldBase f vn -> Doc a) -> [FieldBase f vn] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map FieldBase f vn -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. FieldBase f vn -> Doc ann
pretty [FieldBase f vn]
fs
  where
    fieldArray :: FieldBase ty vn -> Bool
fieldArray (RecordFieldExplicit Name
_ ExpBase ty vn
e SrcLoc
_) = ExpBase ty vn -> Bool
forall (ty :: * -> *) vn. ExpBase ty vn -> Bool
hasArrayLit ExpBase ty vn
e
    fieldArray RecordFieldImplicit {} = Bool
False
prettyExp Int
_ (ArrayLit [ExpBase f vn]
es f StructType
t SrcLoc
_) =
  Doc a -> Doc a
forall ann. Doc ann -> Doc ann
brackets ([Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
commasep ([Doc a] -> Doc a) -> [Doc a] -> Doc a
forall a b. (a -> b) -> a -> b
$ (ExpBase f vn -> Doc a) -> [ExpBase f vn] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map ExpBase f vn -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. ExpBase f vn -> Doc ann
pretty [ExpBase f vn]
es) Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> f StructType -> Doc a
forall (f :: * -> *) t a. (Annot f, Pretty t) => f t -> Doc a
prettyInst f StructType
t
prettyExp Int
_ (StringLit [Word8]
s SrcLoc
_) =
  String -> Doc a
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (String -> Doc a) -> String -> Doc a
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
$ (Word8 -> Char) -> [Word8] -> String
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Char
chr (Int -> Char) -> (Word8 -> Int) -> Word8 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) [Word8]
s
prettyExp Int
_ (Project Name
k ExpBase f vn
e f StructType
_ SrcLoc
_) = ExpBase f vn -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. ExpBase f vn -> Doc ann
pretty ExpBase f vn
e Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
"." Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Name -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. Name -> Doc ann
pretty Name
k
prettyExp Int
_ (Negate ExpBase f vn
e SrcLoc
_) = Doc a
"-" Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> ExpBase f vn -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. ExpBase f vn -> Doc ann
pretty ExpBase f vn
e
prettyExp Int
_ (Not ExpBase f vn
e SrcLoc
_) = Doc a
"-" Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> ExpBase f vn -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. ExpBase f vn -> Doc ann
pretty ExpBase f vn
e
prettyExp Int
_ (Update ExpBase f vn
src SliceBase f vn
idxs ExpBase f vn
ve SrcLoc
_) =
  ExpBase f vn -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. ExpBase f vn -> Doc ann
pretty ExpBase f vn
src
    Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc a
"with"
    Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
brackets ([Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
commasep ((DimIndexBase f vn -> Doc a) -> SliceBase f vn -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map DimIndexBase f vn -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. DimIndexBase f vn -> Doc ann
pretty SliceBase f vn
idxs))
    Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc a
"="
    Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
align (ExpBase f vn -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. ExpBase f vn -> Doc ann
pretty ExpBase f vn
ve)
prettyExp Int
_ (RecordUpdate ExpBase f vn
src [Name]
fs ExpBase f vn
ve f StructType
_ SrcLoc
_) =
  ExpBase f vn -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. ExpBase f vn -> Doc ann
pretty ExpBase f vn
src
    Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc a
"with"
    Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Doc a] -> Doc a
forall a. Monoid a => [a] -> a
mconcat (Doc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
intersperse Doc a
"." ((Name -> Doc a) -> [Name] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. Name -> Doc ann
pretty [Name]
fs))
    Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc a
"="
    Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
align (ExpBase f vn -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. ExpBase f vn -> Doc ann
pretty ExpBase f vn
ve)
prettyExp Int
_ (Assert ExpBase f vn
e1 ExpBase f vn
e2 f Text
_ SrcLoc
_) =
  Doc a
"assert" Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> ExpBase f vn -> Doc a
forall vn (f :: * -> *) a.
(Eq vn, IsName vn, Annot f) =>
Int -> ExpBase f vn -> Doc a
prettyExp Int
10 ExpBase f vn
e1 Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> ExpBase f vn -> Doc a
forall vn (f :: * -> *) a.
(Eq vn, IsName vn, Annot f) =>
Int -> ExpBase f vn -> Doc a
prettyExp Int
10 ExpBase f vn
e2
prettyExp Int
p (Lambda [PatBase f vn ParamType]
params ExpBase f vn
body Maybe (TypeExp f vn)
rettype f ResRetType
_ SrcLoc
_) =
  Bool -> Doc a -> Doc a
forall a. Bool -> Doc a -> Doc a
parensIf (Int
p Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= -Int
1) (Doc a -> Doc a) -> Doc a -> Doc a
forall a b. (a -> b) -> a -> b
$
    Doc a
"\\"
      Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> [Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
hsep ((PatBase f vn ParamType -> Doc a)
-> [PatBase f vn ParamType] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map PatBase f vn ParamType -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. PatBase f vn ParamType -> Doc ann
pretty [PatBase f vn ParamType]
params)
      Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Maybe (TypeExp f vn) -> Doc a
forall t a. Pretty t => Maybe t -> Doc a
ppAscription Maybe (TypeExp f vn)
rettype
        Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc a
"->"
        Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
</> Int -> Doc a -> Doc a
forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (Doc a -> Doc a
forall ann. Doc ann -> Doc ann
align (ExpBase f vn -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. ExpBase f vn -> Doc ann
pretty ExpBase f vn
body))
prettyExp Int
_ (OpSection QualName vn
binop f StructType
_ SrcLoc
_) =
  Doc a -> Doc a
forall ann. Doc ann -> Doc ann
parens (Doc a -> Doc a) -> Doc a -> Doc a
forall a b. (a -> b) -> a -> b
$ QualName vn -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. QualName vn -> Doc ann
pretty QualName vn
binop
prettyExp Int
_ (OpSectionLeft QualName vn
binop f StructType
_ ExpBase f vn
x (f (PName, ParamType, Maybe VName), f (PName, ParamType))
_ (f ResRetType, f [VName])
_ SrcLoc
_) =
  Doc a -> Doc a
forall ann. Doc ann -> Doc ann
parens (Doc a -> Doc a) -> Doc a -> Doc a
forall a b. (a -> b) -> a -> b
$ ExpBase f vn -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. ExpBase f vn -> Doc ann
pretty ExpBase f vn
x Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
<+> QualName vn -> Doc a
forall v a. IsName v => QualName v -> Doc a
ppBinOp QualName vn
binop
prettyExp Int
_ (OpSectionRight QualName vn
binop f StructType
_ ExpBase f vn
x (f (PName, ParamType), f (PName, ParamType, Maybe VName))
_ f ResRetType
_ SrcLoc
_) =
  Doc a -> Doc a
forall ann. Doc ann -> Doc ann
parens (Doc a -> Doc a) -> Doc a -> Doc a
forall a b. (a -> b) -> a -> b
$ QualName vn -> Doc a
forall v a. IsName v => QualName v -> Doc a
ppBinOp QualName vn
binop Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ExpBase f vn -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. ExpBase f vn -> Doc ann
pretty ExpBase f vn
x
prettyExp Int
_ (ProjectSection [Name]
fields f StructType
_ SrcLoc
_) =
  Doc a -> Doc a
forall ann. Doc ann -> Doc ann
parens (Doc a -> Doc a) -> Doc a -> Doc a
forall a b. (a -> b) -> a -> b
$ [Doc a] -> Doc a
forall a. Monoid a => [a] -> a
mconcat ([Doc a] -> Doc a) -> [Doc a] -> Doc a
forall a b. (a -> b) -> a -> b
$ (Name -> Doc a) -> [Name] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Doc a
forall a ann. Pretty a => a -> Doc ann
p [Name]
fields
  where
    p :: a -> Doc ann
p a
name = Doc ann
"." Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> a -> Doc ann
forall ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
name
prettyExp Int
_ (IndexSection SliceBase f vn
idxs f StructType
_ SrcLoc
_) =
  Doc a -> Doc a
forall ann. Doc ann -> Doc ann
parens (Doc a -> Doc a) -> Doc a -> Doc a
forall a b. (a -> b) -> a -> b
$ Doc a
"." Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
brackets ([Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
commasep ((DimIndexBase f vn -> Doc a) -> SliceBase f vn -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map DimIndexBase f vn -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. DimIndexBase f vn -> Doc ann
pretty SliceBase f vn
idxs))
prettyExp Int
p (Constr Name
n [ExpBase f vn]
cs f StructType
t SrcLoc
_) =
  Bool -> Doc a -> Doc a
forall a. Bool -> Doc a -> Doc a
parensIf (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
10) (Doc a -> Doc a) -> Doc a -> Doc a
forall a b. (a -> b) -> a -> b
$
    Doc a
"#" Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Name -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. Name -> Doc ann
pretty Name
n Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
sep ((ExpBase f vn -> Doc a) -> [ExpBase f vn] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> ExpBase f vn -> Doc a
forall vn (f :: * -> *) a.
(Eq vn, IsName vn, Annot f) =>
Int -> ExpBase f vn -> Doc a
prettyExp Int
10) [ExpBase f vn]
cs) Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> f StructType -> Doc a
forall (f :: * -> *) t a. (Annot f, Pretty t) => f t -> Doc a
prettyInst f StructType
t
prettyExp Int
_ (Attr AttrInfo vn
attr ExpBase f vn
e SrcLoc
_) =
  AttrInfo vn -> Doc a
forall a ann. Pretty a => a -> Doc ann
prettyAttr AttrInfo vn
attr Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
</> Int -> ExpBase f vn -> Doc a
forall vn (f :: * -> *) a.
(Eq vn, IsName vn, Annot f) =>
Int -> ExpBase f vn -> Doc a
prettyExp (-Int
1) ExpBase f vn
e
prettyExp Int
i (AppExp AppExpBase f vn
e f AppRes
res)
  | String -> Int -> Bool
isEnvVarAtLeast String
"FUTHARK_COMPILER_DEBUGGING" Int
2,
    Just (AppRes StructType
t [VName]
ext) <- f AppRes -> Maybe AppRes
forall a. f a -> Maybe a
forall (f :: * -> *) a. Annot f => f a -> Maybe a
unAnnot f AppRes
res,
    Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [VName] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [VName]
ext =
      Doc a -> Doc a
forall ann. Doc ann -> Doc ann
parens (Int -> AppExpBase f vn -> Doc a
forall vn (f :: * -> *) a.
(Eq vn, IsName vn, Annot f) =>
Int -> AppExpBase f vn -> Doc a
prettyAppExp Int
i AppExpBase f vn
e)
        Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
</> Doc a
"@"
        Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
parens (StructType -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. StructType -> Doc ann
pretty StructType
t Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
"," Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
brackets ([Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
commasep ([Doc a] -> Doc a) -> [Doc a] -> Doc a
forall a b. (a -> b) -> a -> b
$ (VName -> Doc a) -> [VName] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map VName -> Doc a
forall a. VName -> Doc a
forall v a. IsName v => v -> Doc a
prettyName [VName]
ext))
  | Bool
otherwise = Int -> AppExpBase f vn -> Doc a
forall vn (f :: * -> *) a.
(Eq vn, IsName vn, Annot f) =>
Int -> AppExpBase f vn -> Doc a
prettyAppExp Int
i AppExpBase f vn
e

instance (Eq vn, IsName vn, Annot f) => Pretty (ExpBase f vn) where
  pretty :: forall ann. ExpBase f vn -> Doc ann
pretty = Int -> ExpBase f vn -> Doc ann
forall vn (f :: * -> *) a.
(Eq vn, IsName vn, Annot f) =>
Int -> ExpBase f vn -> Doc a
prettyExp (-Int
1)

instance (IsName vn) => Pretty (AttrAtom vn) where
  pretty :: forall ann. AttrAtom vn -> Doc ann
pretty (AtomName Name
v) = Name -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Name -> Doc ann
pretty Name
v
  pretty (AtomInt Integer
x) = Integer -> Doc ann
forall ann. Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Integer
x

instance (IsName vn) => Pretty (AttrInfo vn) where
  pretty :: forall ann. AttrInfo vn -> Doc ann
pretty (AttrAtom AttrAtom vn
attr SrcLoc
_) = AttrAtom vn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. AttrAtom vn -> Doc ann
pretty AttrAtom vn
attr
  pretty (AttrComp Name
f [AttrInfo vn]
attrs SrcLoc
_) = Name -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Name -> Doc ann
pretty Name
f Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
commasep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ (AttrInfo vn -> Doc ann) -> [AttrInfo vn] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map AttrInfo vn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. AttrInfo vn -> Doc ann
pretty [AttrInfo vn]
attrs)

instance (Eq vn, IsName vn, Annot f) => Pretty (FieldBase f vn) where
  pretty :: forall ann. FieldBase f vn -> Doc ann
pretty (RecordFieldExplicit Name
name ExpBase f vn
e SrcLoc
_) = Name -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Name -> Doc ann
pretty Name
name Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
equals Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> ExpBase f vn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ExpBase f vn -> Doc ann
pretty ExpBase f vn
e
  pretty (RecordFieldImplicit vn
name f StructType
_ SrcLoc
_) = vn -> Doc ann
forall a. vn -> Doc a
forall v a. IsName v => v -> Doc a
prettyName vn
name

instance (Eq vn, IsName vn, Annot f) => Pretty (CaseBase f vn) where
  pretty :: forall ann. CaseBase f vn -> Doc ann
pretty (CasePat PatBase f vn StructType
p ExpBase f vn
e SrcLoc
_) = Doc ann
"case" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> PatBase f vn StructType -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. PatBase f vn StructType -> Doc ann
pretty PatBase f vn StructType
p Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"->" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
</> Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (ExpBase f vn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ExpBase f vn -> Doc ann
pretty ExpBase f vn
e)

instance (Eq vn, IsName vn, Annot f) => Pretty (LoopFormBase f vn) where
  pretty :: forall ann. LoopFormBase f vn -> Doc ann
pretty (For IdentBase f vn StructType
i ExpBase f vn
ubound) =
    Doc ann
"for" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> IdentBase f vn StructType -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IdentBase f vn StructType -> Doc ann
pretty IdentBase f vn StructType
i Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"<" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align (ExpBase f vn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ExpBase f vn -> Doc ann
pretty ExpBase f vn
ubound)
  pretty (ForIn PatBase f vn StructType
x ExpBase f vn
e) =
    Doc ann
"for" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> PatBase f vn StructType -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. PatBase f vn StructType -> Doc ann
pretty PatBase f vn StructType
x Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"in" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ExpBase f vn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ExpBase f vn -> Doc ann
pretty ExpBase f vn
e
  pretty (While ExpBase f vn
cond) =
    Doc ann
"while" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ExpBase f vn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ExpBase f vn -> Doc ann
pretty ExpBase f vn
cond

instance Pretty PatLit where
  pretty :: forall ann. PatLit -> Doc ann
pretty (PatLitInt Integer
x) = Integer -> Doc ann
forall ann. Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Integer
x
  pretty (PatLitFloat Double
f) = Double -> Doc ann
forall ann. Double -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Double
f
  pretty (PatLitPrim PrimValue
v) = PrimValue -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. PrimValue -> Doc ann
pretty PrimValue
v

instance (Eq vn, IsName vn, Annot f, Pretty t) => Pretty (PatBase f vn t) where
  pretty :: forall ann. PatBase f vn t -> Doc ann
pretty (PatAscription PatBase f vn t
p TypeExp f vn
t SrcLoc
_) = PatBase f vn t -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. PatBase f vn t -> Doc ann
pretty PatBase f vn t
p Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
colon Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align (TypeExp f vn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. TypeExp f vn -> Doc ann
pretty TypeExp f vn
t)
  pretty (PatParens PatBase f vn t
p SrcLoc
_) = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ PatBase f vn t -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. PatBase f vn t -> Doc ann
pretty PatBase f vn t
p
  pretty (Id vn
v f t
t SrcLoc
_) = case f t -> Maybe t
forall a. f a -> Maybe a
forall (f :: * -> *) a. Annot f => f a -> Maybe a
unAnnot f t
t of
    Just t
t' -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ vn -> Doc ann
forall a. vn -> Doc a
forall v a. IsName v => v -> Doc a
prettyName vn
v Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
colon Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align (t -> Doc ann
forall ann. t -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty t
t')
    Maybe t
Nothing -> vn -> Doc ann
forall a. vn -> Doc a
forall v a. IsName v => v -> Doc a
prettyName vn
v
  pretty (TuplePat [PatBase f vn t]
pats SrcLoc
_) = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
commasep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ (PatBase f vn t -> Doc ann) -> [PatBase f vn t] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map PatBase f vn t -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. PatBase f vn t -> Doc ann
pretty [PatBase f vn t]
pats
  pretty (RecordPat [(Name, PatBase f vn t)]
fs SrcLoc
_) = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
braces (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
commasep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ ((Name, PatBase f vn t) -> Doc ann)
-> [(Name, PatBase f vn t)] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map (Name, PatBase f vn t) -> Doc ann
forall {a} {ann}. Pretty a => (Name, a) -> Doc ann
ppField [(Name, PatBase f vn t)]
fs
    where
      ppField :: (Name, a) -> Doc ann
ppField (Name
name, a
t) = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Name -> String
nameToString Name
name) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
equals Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> a -> Doc ann
forall ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
t
  pretty (Wildcard f t
t SrcLoc
_) = case f t -> Maybe t
forall a. f a -> Maybe a
forall (f :: * -> *) a. Annot f => f a -> Maybe a
unAnnot f t
t of
    Just t
t' -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ Doc ann
"_" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
colon Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> t -> Doc ann
forall ann. t -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty t
t'
    Maybe t
Nothing -> Doc ann
"_"
  pretty (PatLit PatLit
e f t
_ SrcLoc
_) = PatLit -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. PatLit -> Doc ann
pretty PatLit
e
  pretty (PatConstr Name
n f t
_ [PatBase f vn t]
ps SrcLoc
_) = Doc ann
"#" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Name -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Name -> Doc ann
pretty Name
n Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
sep ((PatBase f vn t -> Doc ann) -> [PatBase f vn t] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map PatBase f vn t -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. PatBase f vn t -> Doc ann
pretty [PatBase f vn t]
ps)
  pretty (PatAttr AttrInfo vn
attr PatBase f vn t
p SrcLoc
_) = Doc ann
"#[" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> AttrInfo vn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. AttrInfo vn -> Doc ann
pretty AttrInfo vn
attr Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"]" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
</> PatBase f vn t -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. PatBase f vn t -> Doc ann
pretty PatBase f vn t
p

ppAscription :: (Pretty t) => Maybe t -> Doc a
ppAscription :: forall t a. Pretty t => Maybe t -> Doc a
ppAscription Maybe t
Nothing = Doc a
forall a. Monoid a => a
mempty
ppAscription (Just t
t) = Doc a
forall ann. Doc ann
colon Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a -> Doc a
forall ann. Doc ann -> Doc ann
align (t -> Doc a
forall ann. t -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty t
t)

instance (Eq vn, IsName vn, Annot f) => Pretty (ProgBase f vn) where
  pretty :: forall ann. ProgBase f vn -> Doc ann
pretty = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
stack ([Doc ann] -> Doc ann)
-> (ProgBase f vn -> [Doc ann]) -> ProgBase f vn -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
line ([Doc ann] -> [Doc ann])
-> (ProgBase f vn -> [Doc ann]) -> ProgBase f vn -> [Doc ann]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DecBase f vn -> Doc ann) -> [DecBase f vn] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map DecBase f vn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. DecBase f vn -> Doc ann
pretty ([DecBase f vn] -> [Doc ann])
-> (ProgBase f vn -> [DecBase f vn]) -> ProgBase f vn -> [Doc ann]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProgBase f vn -> [DecBase f vn]
forall (f :: * -> *) vn. ProgBase f vn -> [DecBase f vn]
progDecs

instance (Eq vn, IsName vn, Annot f) => Pretty (DecBase f vn) where
  pretty :: forall ann. DecBase f vn -> Doc ann
pretty (ValDec ValBindBase f vn
dec) = ValBindBase f vn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ValBindBase f vn -> Doc ann
pretty ValBindBase f vn
dec
  pretty (TypeDec TypeBindBase f vn
dec) = TypeBindBase f vn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. TypeBindBase f vn -> Doc ann
pretty TypeBindBase f vn
dec
  pretty (ModTypeDec ModTypeBindBase f vn
sig) = ModTypeBindBase f vn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ModTypeBindBase f vn -> Doc ann
pretty ModTypeBindBase f vn
sig
  pretty (ModDec ModBindBase f vn
sd) = ModBindBase f vn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ModBindBase f vn -> Doc ann
pretty ModBindBase f vn
sd
  pretty (OpenDec ModExpBase f vn
x SrcLoc
_) = Doc ann
"open" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ModExpBase f vn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ModExpBase f vn -> Doc ann
pretty ModExpBase f vn
x
  pretty (LocalDec DecBase f vn
dec SrcLoc
_) = Doc ann
"local" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> DecBase f vn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. DecBase f vn -> Doc ann
pretty DecBase f vn
dec
  pretty (ImportDec String
x f ImportName
_ SrcLoc
_) = Doc ann
"import" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
x

prettyModExp :: (Eq vn, IsName vn, Annot f) => Int -> ModExpBase f vn -> Doc a
prettyModExp :: forall vn (f :: * -> *) a.
(Eq vn, IsName vn, Annot f) =>
Int -> ModExpBase f vn -> Doc a
prettyModExp Int
_ (ModVar QualName vn
v SrcLoc
_) =
  QualName vn -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. QualName vn -> Doc ann
pretty QualName vn
v
prettyModExp Int
_ (ModParens ModExpBase f vn
e SrcLoc
_) =
  Doc a -> Doc a
forall ann. Doc ann -> Doc ann
align (Doc a -> Doc a) -> Doc a -> Doc a
forall a b. (a -> b) -> a -> b
$ Doc a -> Doc a
forall ann. Doc ann -> Doc ann
parens (Doc a -> Doc a) -> Doc a -> Doc a
forall a b. (a -> b) -> a -> b
$ ModExpBase f vn -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. ModExpBase f vn -> Doc ann
pretty ModExpBase f vn
e
prettyModExp Int
_ (ModImport String
v f ImportName
_ SrcLoc
_) =
  Doc a
"import" Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc a
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (String -> String
forall a. Show a => a -> String
show String
v)
prettyModExp Int
_ (ModDecs [DecBase f vn]
ds SrcLoc
_) =
  Doc a -> Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a -> Doc a
nestedBlock Doc a
"{" Doc a
"}" (Doc a -> Doc a) -> Doc a -> Doc a
forall a b. (a -> b) -> a -> b
$ [Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
stack ([Doc a] -> Doc a) -> [Doc a] -> Doc a
forall a b. (a -> b) -> a -> b
$ Doc a -> [Doc a] -> [Doc a]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc a
forall ann. Doc ann
line ([Doc a] -> [Doc a]) -> [Doc a] -> [Doc a]
forall a b. (a -> b) -> a -> b
$ (DecBase f vn -> Doc a) -> [DecBase f vn] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map DecBase f vn -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. DecBase f vn -> Doc ann
pretty [DecBase f vn]
ds
prettyModExp Int
p (ModApply ModExpBase f vn
f ModExpBase f vn
a f (Map VName VName)
_ f (Map VName VName)
_ SrcLoc
_) =
  Bool -> Doc a -> Doc a
forall a. Bool -> Doc a -> Doc a
parensIf (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
10) (Doc a -> Doc a) -> Doc a -> Doc a
forall a b. (a -> b) -> a -> b
$ Int -> ModExpBase f vn -> Doc a
forall vn (f :: * -> *) a.
(Eq vn, IsName vn, Annot f) =>
Int -> ModExpBase f vn -> Doc a
prettyModExp Int
0 ModExpBase f vn
f Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> ModExpBase f vn -> Doc a
forall vn (f :: * -> *) a.
(Eq vn, IsName vn, Annot f) =>
Int -> ModExpBase f vn -> Doc a
prettyModExp Int
10 ModExpBase f vn
a
prettyModExp Int
p (ModAscript ModExpBase f vn
me ModTypeExpBase f vn
se f (Map VName VName)
_ SrcLoc
_) =
  Bool -> Doc a -> Doc a
forall a. Bool -> Doc a -> Doc a
parensIf (Int
p Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= -Int
1) (Doc a -> Doc a) -> Doc a -> Doc a
forall a b. (a -> b) -> a -> b
$ ModExpBase f vn -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. ModExpBase f vn -> Doc ann
pretty ModExpBase f vn
me Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
forall ann. Doc ann
colon Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ModTypeExpBase f vn -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. ModTypeExpBase f vn -> Doc ann
pretty ModTypeExpBase f vn
se
prettyModExp Int
p (ModLambda ModParamBase f vn
param Maybe (ModTypeExpBase f vn, f (Map VName VName))
maybe_sig ModExpBase f vn
body SrcLoc
_) =
  Bool -> Doc a -> Doc a
forall a. Bool -> Doc a -> Doc a
parensIf (Int
p Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= -Int
1) (Doc a -> Doc a) -> Doc a -> Doc a
forall a b. (a -> b) -> a -> b
$
    Doc a
"\\"
      Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> ModParamBase f vn -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. ModParamBase f vn -> Doc ann
pretty ModParamBase f vn
param
      Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
forall ann. Doc ann
maybe_sig'
        Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc a
"->"
        Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
</> Int -> Doc a -> Doc a
forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (ModExpBase f vn -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. ModExpBase f vn -> Doc ann
pretty ModExpBase f vn
body)
  where
    maybe_sig' :: Doc ann
maybe_sig' = case Maybe (ModTypeExpBase f vn, f (Map VName VName))
maybe_sig of
      Maybe (ModTypeExpBase f vn, f (Map VName VName))
Nothing -> Doc ann
forall a. Monoid a => a
mempty
      Just (ModTypeExpBase f vn
sig, f (Map VName VName)
_) -> Doc ann
forall ann. Doc ann
colon Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ModTypeExpBase f vn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ModTypeExpBase f vn -> Doc ann
pretty ModTypeExpBase f vn
sig

instance (Eq vn, IsName vn, Annot f) => Pretty (ModExpBase f vn) where
  pretty :: forall ann. ModExpBase f vn -> Doc ann
pretty = Int -> ModExpBase f vn -> Doc ann
forall vn (f :: * -> *) a.
(Eq vn, IsName vn, Annot f) =>
Int -> ModExpBase f vn -> Doc a
prettyModExp (-Int
1)

instance Pretty Liftedness where
  pretty :: forall ann. Liftedness -> Doc ann
pretty Liftedness
Unlifted = Doc ann
""
  pretty Liftedness
SizeLifted = Doc ann
"~"
  pretty Liftedness
Lifted = Doc ann
"^"

instance (Eq vn, IsName vn, Annot f) => Pretty (TypeBindBase f vn) where
  pretty :: forall ann. TypeBindBase f vn -> Doc ann
pretty (TypeBind vn
name Liftedness
l [TypeParamBase vn]
params TypeExp f vn
te f StructRetType
rt Maybe DocComment
_ SrcLoc
_) =
    Doc ann
"type"
      Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Liftedness -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Liftedness -> Doc ann
pretty Liftedness
l
        Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (vn -> Doc ann
forall a. vn -> Doc a
forall v a. IsName v => v -> Doc a
prettyName vn
name Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: (TypeParamBase vn -> Doc ann) -> [TypeParamBase vn] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map TypeParamBase vn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. TypeParamBase vn -> Doc ann
pretty [TypeParamBase vn]
params)
        Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
forall ann. Doc ann
equals
        Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
-> (StructRetType -> Doc ann) -> Maybe StructRetType -> Doc ann
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (TypeExp f vn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. TypeExp f vn -> Doc ann
pretty TypeExp f vn
te) StructRetType -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. StructRetType -> Doc ann
pretty (f StructRetType -> Maybe StructRetType
forall a. f a -> Maybe a
forall (f :: * -> *) a. Annot f => f a -> Maybe a
unAnnot f StructRetType
rt)

instance (Eq vn, IsName vn) => Pretty (TypeParamBase vn) where
  pretty :: forall ann. TypeParamBase vn -> Doc ann
pretty (TypeParamDim vn
name SrcLoc
_) = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
brackets (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ vn -> Doc ann
forall a. vn -> Doc a
forall v a. IsName v => v -> Doc a
prettyName vn
name
  pretty (TypeParamType Liftedness
l vn
name SrcLoc
_) = Doc ann
"'" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Liftedness -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Liftedness -> Doc ann
pretty Liftedness
l Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> vn -> Doc ann
forall a. vn -> Doc a
forall v a. IsName v => v -> Doc a
prettyName vn
name

instance (Eq vn, IsName vn, Annot f) => Pretty (ValBindBase f vn) where
  pretty :: forall ann. ValBindBase f vn -> Doc ann
pretty (ValBind Maybe (f EntryPoint)
entry vn
name Maybe (TypeExp f vn)
retdecl f ResRetType
rettype [TypeParamBase vn]
tparams [PatBase f vn ParamType]
args ExpBase f vn
body Maybe DocComment
_ [AttrInfo vn]
attrs SrcLoc
_) =
    [Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat ((AttrInfo vn -> Doc ann) -> [AttrInfo vn] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map ((Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
line) (Doc ann -> Doc ann)
-> (AttrInfo vn -> Doc ann) -> AttrInfo vn -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttrInfo vn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
prettyAttr) [AttrInfo vn]
attrs)
      Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
fun
        Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align
          ( [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
sep
              ( vn -> Doc ann
forall a. vn -> Doc a
forall v a. IsName v => v -> Doc a
prettyName vn
name
                  Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: (TypeParamBase vn -> Doc ann) -> [TypeParamBase vn] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map TypeParamBase vn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. TypeParamBase vn -> Doc ann
pretty [TypeParamBase vn]
tparams
                  [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. [a] -> [a] -> [a]
++ (PatBase f vn ParamType -> Doc ann)
-> [PatBase f vn ParamType] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map PatBase f vn ParamType -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. PatBase f vn ParamType -> Doc ann
pretty [PatBase f vn ParamType]
args
                  [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. [a] -> [a] -> [a]
++ [Doc ann]
forall {ann}. [Doc ann]
retdecl'
                  [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. [a] -> [a] -> [a]
++ [Doc ann
"="]
              )
          )
        Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
</> Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (ExpBase f vn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ExpBase f vn -> Doc ann
pretty ExpBase f vn
body)
    where
      fun :: Doc ann
fun
        | Maybe (f EntryPoint) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (f EntryPoint)
entry = Doc ann
"entry"
        | Bool
otherwise = Doc ann
"def"
      retdecl' :: [Doc ann]
retdecl' = case (ResRetType -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ResRetType -> Doc ann
pretty (ResRetType -> Doc ann) -> Maybe ResRetType -> Maybe (Doc ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f ResRetType -> Maybe ResRetType
forall a. f a -> Maybe a
forall (f :: * -> *) a. Annot f => f a -> Maybe a
unAnnot f ResRetType
rettype) Maybe (Doc ann) -> Maybe (Doc ann) -> Maybe (Doc ann)
forall a. Maybe a -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` (TypeExp f vn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. TypeExp f vn -> Doc ann
pretty (TypeExp f vn -> Doc ann)
-> Maybe (TypeExp f vn) -> Maybe (Doc ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (TypeExp f vn)
retdecl) of
        Just Doc ann
rettype' -> [Doc ann
forall ann. Doc ann
colon Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align Doc ann
rettype']
        Maybe (Doc ann)
Nothing -> [Doc ann]
forall a. Monoid a => a
mempty

instance (Eq vn, IsName vn, Annot f) => Pretty (SpecBase f vn) where
  pretty :: forall ann. SpecBase f vn -> Doc ann
pretty (TypeAbbrSpec TypeBindBase f vn
tpsig) = TypeBindBase f vn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. TypeBindBase f vn -> Doc ann
pretty TypeBindBase f vn
tpsig
  pretty (TypeSpec Liftedness
l vn
name [TypeParamBase vn]
ps Maybe DocComment
_ SrcLoc
_) =
    Doc ann
"type" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Liftedness -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Liftedness -> Doc ann
pretty Liftedness
l Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (vn -> Doc ann
forall a. vn -> Doc a
forall v a. IsName v => v -> Doc a
prettyName vn
name Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: (TypeParamBase vn -> Doc ann) -> [TypeParamBase vn] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map TypeParamBase vn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. TypeParamBase vn -> Doc ann
pretty [TypeParamBase vn]
ps)
  pretty (ValSpec vn
name [TypeParamBase vn]
tparams TypeExp f vn
vtype f StructType
_ Maybe DocComment
_ SrcLoc
_) =
    Doc ann
"val" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (vn -> Doc ann
forall a. vn -> Doc a
forall v a. IsName v => v -> Doc a
prettyName vn
name Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: (TypeParamBase vn -> Doc ann) -> [TypeParamBase vn] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map TypeParamBase vn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. TypeParamBase vn -> Doc ann
pretty [TypeParamBase vn]
tparams) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
colon Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> TypeExp f vn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. TypeExp f vn -> Doc ann
pretty TypeExp f vn
vtype
  pretty (ModSpec vn
name ModTypeExpBase f vn
sig Maybe DocComment
_ SrcLoc
_) =
    Doc ann
"module" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> vn -> Doc ann
forall a. vn -> Doc a
forall v a. IsName v => v -> Doc a
prettyName vn
name Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
colon Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ModTypeExpBase f vn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ModTypeExpBase f vn -> Doc ann
pretty ModTypeExpBase f vn
sig
  pretty (IncludeSpec ModTypeExpBase f vn
e SrcLoc
_) =
    Doc ann
"include" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ModTypeExpBase f vn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ModTypeExpBase f vn -> Doc ann
pretty ModTypeExpBase f vn
e

instance (Eq vn, IsName vn, Annot f) => Pretty (ModTypeExpBase f vn) where
  pretty :: forall ann. ModTypeExpBase f vn -> Doc ann
pretty (ModTypeVar QualName vn
v f (Map VName VName)
_ SrcLoc
_) = QualName vn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. QualName vn -> Doc ann
pretty QualName vn
v
  pretty (ModTypeParens ModTypeExpBase f vn
e SrcLoc
_) = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ ModTypeExpBase f vn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ModTypeExpBase f vn -> Doc ann
pretty ModTypeExpBase f vn
e
  pretty (ModTypeSpecs [SpecBase f vn]
ss SrcLoc
_) = Doc ann -> Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a -> Doc a
nestedBlock Doc ann
"{" Doc ann
"}" ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
stack ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
line ([Doc ann] -> [Doc ann]) -> [Doc ann] -> [Doc ann]
forall a b. (a -> b) -> a -> b
$ (SpecBase f vn -> Doc ann) -> [SpecBase f vn] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map SpecBase f vn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. SpecBase f vn -> Doc ann
pretty [SpecBase f vn]
ss)
  pretty (ModTypeWith ModTypeExpBase f vn
s (TypeRef QualName vn
v [TypeParamBase vn]
ps TypeExp f vn
td SrcLoc
_) SrcLoc
_) =
    ModTypeExpBase f vn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ModTypeExpBase f vn -> Doc ann
pretty ModTypeExpBase f vn
s Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"with" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> QualName vn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. QualName vn -> Doc ann
pretty QualName vn
v Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep ((TypeParamBase vn -> Doc ann) -> [TypeParamBase vn] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map TypeParamBase vn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. TypeParamBase vn -> Doc ann
pretty [TypeParamBase vn]
ps) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
" =" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> TypeExp f vn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. TypeExp f vn -> Doc ann
pretty TypeExp f vn
td
  pretty (ModTypeArrow (Just vn
v) ModTypeExpBase f vn
e1 ModTypeExpBase f vn
e2 SrcLoc
_) =
    Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (vn -> Doc ann
forall a. vn -> Doc a
forall v a. IsName v => v -> Doc a
prettyName vn
v Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
colon Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ModTypeExpBase f vn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ModTypeExpBase f vn -> Doc ann
pretty ModTypeExpBase f vn
e1) Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"->" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ModTypeExpBase f vn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ModTypeExpBase f vn -> Doc ann
pretty ModTypeExpBase f vn
e2
  pretty (ModTypeArrow Maybe vn
Nothing ModTypeExpBase f vn
e1 ModTypeExpBase f vn
e2 SrcLoc
_) =
    ModTypeExpBase f vn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ModTypeExpBase f vn -> Doc ann
pretty ModTypeExpBase f vn
e1 Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"->" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ModTypeExpBase f vn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ModTypeExpBase f vn -> Doc ann
pretty ModTypeExpBase f vn
e2

instance (Eq vn, IsName vn, Annot f) => Pretty (ModTypeBindBase f vn) where
  pretty :: forall ann. ModTypeBindBase f vn -> Doc ann
pretty (ModTypeBind vn
name ModTypeExpBase f vn
e Maybe DocComment
_ SrcLoc
_) =
    Doc ann
"module type" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> vn -> Doc ann
forall a. vn -> Doc a
forall v a. IsName v => v -> Doc a
prettyName vn
name Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
forall ann. Doc ann
equals Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ModTypeExpBase f vn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ModTypeExpBase f vn -> Doc ann
pretty ModTypeExpBase f vn
e

instance (Eq vn, IsName vn, Annot f) => Pretty (ModParamBase f vn) where
  pretty :: forall ann. ModParamBase f vn -> Doc ann
pretty (ModParam vn
pname ModTypeExpBase f vn
psig f [VName]
_ SrcLoc
_) =
    Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (vn -> Doc ann
forall a. vn -> Doc a
forall v a. IsName v => v -> Doc a
prettyName vn
pname Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
colon Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ModTypeExpBase f vn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ModTypeExpBase f vn -> Doc ann
pretty ModTypeExpBase f vn
psig)

instance (Eq vn, IsName vn, Annot f) => Pretty (ModBindBase f vn) where
  pretty :: forall ann. ModBindBase f vn -> Doc ann
pretty (ModBind vn
name [ModParamBase f vn]
ps Maybe (ModTypeExpBase f vn, f (Map VName VName))
sig ModExpBase f vn
e Maybe DocComment
_ SrcLoc
_) =
    Doc ann
"module" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (vn -> Doc ann
forall a. vn -> Doc a
forall v a. IsName v => v -> Doc a
prettyName vn
name Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: (ModParamBase f vn -> Doc ann) -> [ModParamBase f vn] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map ModParamBase f vn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ModParamBase f vn -> Doc ann
pretty [ModParamBase f vn]
ps) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
sig' Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
" =" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ModExpBase f vn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ModExpBase f vn -> Doc ann
pretty ModExpBase f vn
e
    where
      sig' :: Doc ann
sig' = case Maybe (ModTypeExpBase f vn, f (Map VName VName))
sig of
        Maybe (ModTypeExpBase f vn, f (Map VName VName))
Nothing -> Doc ann
forall a. Monoid a => a
mempty
        Just (ModTypeExpBase f vn
s, f (Map VName VName)
_) -> Doc ann
" " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
colon Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ModTypeExpBase f vn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ModTypeExpBase f vn -> Doc ann
pretty ModTypeExpBase f vn
s Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
" "

ppBinOp :: (IsName v) => QualName v -> Doc a
ppBinOp :: forall v a. IsName v => QualName v -> Doc a
ppBinOp QualName v
bop =
  case BinOp
leading of
    BinOp
Backtick -> Doc a
"`" Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> QualName v -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. QualName v -> Doc ann
pretty QualName v
bop Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
"`"
    BinOp
_ -> QualName v -> Doc a
forall a ann. Pretty a => a -> Doc ann
forall ann. QualName v -> Doc ann
pretty QualName v
bop
  where
    leading :: BinOp
leading = Name -> BinOp
leadingOperator (Name -> BinOp) -> Name -> BinOp
forall a b. (a -> b) -> a -> b
$ v -> Name
forall v. IsName v => v -> Name
toName (v -> Name) -> v -> Name
forall a b. (a -> b) -> a -> b
$ QualName v -> v
forall vn. QualName vn -> vn
qualLeaf QualName v
bop

prettyBinOp ::
  (Eq vn, IsName vn, Annot f) =>
  Int ->
  QualName vn ->
  ExpBase f vn ->
  ExpBase f vn ->
  Doc a
prettyBinOp :: forall vn (f :: * -> *) a.
(Eq vn, IsName vn, Annot f) =>
Int -> QualName vn -> ExpBase f vn -> ExpBase f vn -> Doc a
prettyBinOp Int
p QualName vn
bop ExpBase f vn
x ExpBase f vn
y =
  Bool -> Doc a -> Doc a
forall a. Bool -> Doc a -> Doc a
parensIf (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
symPrecedence) (Doc a -> Doc a) -> Doc a -> Doc a
forall a b. (a -> b) -> a -> b
$
    Int -> ExpBase f vn -> Doc a
forall vn (f :: * -> *) a.
(Eq vn, IsName vn, Annot f) =>
Int -> ExpBase f vn -> Doc a
prettyExp Int
symPrecedence ExpBase f vn
x
      Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc a
forall ann. Doc ann
bop'
      Doc a -> Doc a -> Doc a
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> ExpBase f vn -> Doc a
forall vn (f :: * -> *) a.
(Eq vn, IsName vn, Annot f) =>
Int -> ExpBase f vn -> Doc a
prettyExp Int
symRPrecedence ExpBase f vn
y
  where
    bop' :: Doc ann
bop' = case BinOp
leading of
      BinOp
Backtick -> Doc ann
"`" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> QualName vn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. QualName vn -> Doc ann
pretty QualName vn
bop Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"`"
      BinOp
_ -> QualName vn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. QualName vn -> Doc ann
pretty QualName vn
bop
    leading :: BinOp
leading = Name -> BinOp
leadingOperator (Name -> BinOp) -> Name -> BinOp
forall a b. (a -> b) -> a -> b
$ vn -> Name
forall v. IsName v => v -> Name
toName (vn -> Name) -> vn -> Name
forall a b. (a -> b) -> a -> b
$ QualName vn -> vn
forall vn. QualName vn -> vn
qualLeaf QualName vn
bop
    symPrecedence :: Int
symPrecedence = BinOp -> Int
forall {a}. Num a => BinOp -> a
precedence BinOp
leading
    symRPrecedence :: Int
symRPrecedence = BinOp -> Int
forall {a}. Num a => BinOp -> a
rprecedence BinOp
leading
    precedence :: BinOp -> a
precedence BinOp
PipeRight = -a
1
    precedence BinOp
PipeLeft = -a
1
    precedence BinOp
LogAnd = a
0
    precedence BinOp
LogOr = a
0
    precedence BinOp
Band = a
1
    precedence BinOp
Bor = a
1
    precedence BinOp
Xor = a
1
    precedence BinOp
Equal = a
2
    precedence BinOp
NotEqual = a
2
    precedence BinOp
Bang = a
2
    precedence BinOp
Equ = a
2
    precedence BinOp
Less = a
2
    precedence BinOp
Leq = a
2
    precedence BinOp
Greater = a
2
    precedence BinOp
Geq = a
2
    precedence BinOp
ShiftL = a
3
    precedence BinOp
ShiftR = a
3
    precedence BinOp
Plus = a
4
    precedence BinOp
Minus = a
4
    precedence BinOp
Times = a
5
    precedence BinOp
Divide = a
5
    precedence BinOp
Mod = a
5
    precedence BinOp
Quot = a
5
    precedence BinOp
Rem = a
5
    precedence BinOp
Pow = a
6
    precedence BinOp
Backtick = a
9
    rprecedence :: BinOp -> a
rprecedence BinOp
Minus = a
10
    rprecedence BinOp
Divide = a
10
    rprecedence BinOp
op = BinOp -> a
forall {a}. Num a => BinOp -> a
precedence BinOp
op