{-# LANGUAGE FlexibleInstances   #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE PatternGuards       #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE RecordWildCards     #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications    #-}
{-# LANGUAGE TypeOperators       #-}
{-# LANGUAGE ViewPatterns        #-}
-- |
-- Module      : Data.Array.Accelerate.Pretty.Print
-- Copyright   : [2008..2020] The Accelerate Team
-- License     : BSD3
--
-- Maintainer  : Trevor L. McDonell <trevor.mcdonell@gmail.com>
-- Stability   : experimental
-- Portability : non-portable (GHC extensions)
--

module Data.Array.Accelerate.Pretty.Print (

  PrettyAcc, ExtractAcc,
  prettyPreOpenAcc,
  prettyPreOpenAfun,
  prettyOpenExp, prettyExp,
  prettyOpenFun, prettyFun,
  prettyArray,
  prettyConst,
  prettyELhs,
  prettyALhs,

  -- ** Configuration
  PrettyConfig(..),
  configPlain,
  configWithHash,

  -- ** Internals
  Adoc,
  Val(..),
  PrettyEnv(..),
  Context(..),
  Keyword(..),
  Operator(..),
  parensIf, needsParens,
  ansiKeyword,
  shiftwidth,
  context0,
  app,
  manifest, delayed,
  primOperator,
  isInfix,
  prj, sizeEnv,

) where

import Data.Array.Accelerate.AST                                    hiding ( Direction )
import Data.Array.Accelerate.AST.Idx
import Data.Array.Accelerate.AST.LeftHandSide
import Data.Array.Accelerate.AST.Var
import Data.Array.Accelerate.Representation.Array
import Data.Array.Accelerate.Representation.Elt
import Data.Array.Accelerate.Representation.Stencil
import Data.Array.Accelerate.Representation.Tag
import Data.Array.Accelerate.Representation.Type
import Data.Array.Accelerate.Sugar.Foreign
import Data.Array.Accelerate.Type
import qualified Data.Array.Accelerate.AST                          as AST
import qualified Data.Array.Accelerate.Analysis.Hash                as Hash
import qualified Data.Array.Accelerate.Trafo.Delayed                as Delayed

import Data.Char
import Data.String
import Prettyprinter
import Prettyprinter.Render.Terminal
import Prelude                                                      hiding ( exp )


-- Implementation
-- --------------

type PrettyAcc acc =
  forall aenv a. PrettyConfig acc -> Context -> Val aenv -> acc aenv a -> Adoc
type ExtractAcc acc =
  forall aenv a. acc aenv a -> PreOpenAcc acc aenv a

type Adoc = Doc Keyword

data Keyword
  = Statement     -- do | case of | let in
  | Conditional   -- if then else
  | Manifest      -- collective operations (kernel functions)
  | Delayed       -- fused operators
  deriving (Keyword -> Keyword -> Bool
(Keyword -> Keyword -> Bool)
-> (Keyword -> Keyword -> Bool) -> Eq Keyword
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Keyword -> Keyword -> Bool
== :: Keyword -> Keyword -> Bool
$c/= :: Keyword -> Keyword -> Bool
/= :: Keyword -> Keyword -> Bool
Eq, Precedence -> Keyword -> ShowS
[Keyword] -> ShowS
Keyword -> String
(Precedence -> Keyword -> ShowS)
-> (Keyword -> String) -> ([Keyword] -> ShowS) -> Show Keyword
forall a.
(Precedence -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Precedence -> Keyword -> ShowS
showsPrec :: Precedence -> Keyword -> ShowS
$cshow :: Keyword -> String
show :: Keyword -> String
$cshowList :: [Keyword] -> ShowS
showList :: [Keyword] -> ShowS
Show)

let_, in_ :: Adoc
let_ :: Doc Keyword
let_ = Keyword -> Doc Keyword -> Doc Keyword
forall ann. ann -> Doc ann -> Doc ann
annotate Keyword
Statement Doc Keyword
"let"
in_ :: Doc Keyword
in_  = Keyword -> Doc Keyword -> Doc Keyword
forall ann. ann -> Doc ann -> Doc ann
annotate Keyword
Statement Doc Keyword
"in"

case_, of_ :: Adoc
case_ :: Doc Keyword
case_ = Keyword -> Doc Keyword -> Doc Keyword
forall ann. ann -> Doc ann -> Doc ann
annotate Keyword
Statement Doc Keyword
"case"
of_ :: Doc Keyword
of_   = Keyword -> Doc Keyword -> Doc Keyword
forall ann. ann -> Doc ann -> Doc ann
annotate Keyword
Statement Doc Keyword
"of"

if_, then_, else_ :: Adoc
if_ :: Doc Keyword
if_   = Keyword -> Doc Keyword -> Doc Keyword
forall ann. ann -> Doc ann -> Doc ann
annotate Keyword
Statement Doc Keyword
"if"
then_ :: Doc Keyword
then_ = Keyword -> Doc Keyword -> Doc Keyword
forall ann. ann -> Doc ann -> Doc ann
annotate Keyword
Statement Doc Keyword
"then"
else_ :: Doc Keyword
else_ = Keyword -> Doc Keyword -> Doc Keyword
forall ann. ann -> Doc ann -> Doc ann
annotate Keyword
Statement Doc Keyword
"else"

manifest :: Operator -> Adoc
manifest :: Operator -> Doc Keyword
manifest = Keyword -> Doc Keyword -> Doc Keyword
forall ann. ann -> Doc ann -> Doc ann
annotate Keyword
Manifest (Doc Keyword -> Doc Keyword)
-> (Operator -> Doc Keyword) -> Operator -> Doc Keyword
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Operator -> Doc Keyword
opName

delayed :: Operator -> Adoc
delayed :: Operator -> Doc Keyword
delayed = Keyword -> Doc Keyword -> Doc Keyword
forall ann. ann -> Doc ann -> Doc ann
annotate Keyword
Delayed (Doc Keyword -> Doc Keyword)
-> (Operator -> Doc Keyword) -> Operator -> Doc Keyword
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Operator -> Doc Keyword
opName

ansiKeyword :: Keyword -> AnsiStyle
ansiKeyword :: Keyword -> AnsiStyle
ansiKeyword Keyword
Statement   = Color -> AnsiStyle
colorDull Color
Yellow
ansiKeyword Keyword
Conditional = Color -> AnsiStyle
colorDull Color
Yellow
ansiKeyword Keyword
Manifest    = Color -> AnsiStyle
color Color
Blue
ansiKeyword Keyword
Delayed     = Color -> AnsiStyle
color Color
Green

-- Configuration for the pretty-printing functions
data PrettyConfig acc
  = PrettyConfig { forall (acc :: * -> * -> *).
PrettyConfig acc
-> forall aenv arrs. PreOpenAcc acc aenv arrs -> String -> Operator
confOperator :: forall aenv arrs.
                                   PreOpenAcc acc aenv arrs
                                -> String
                                -> Operator }

configPlain :: PrettyConfig acc
configPlain :: forall (acc :: * -> * -> *). PrettyConfig acc
configPlain = PrettyConfig { confOperator :: forall aenv arrs. PreOpenAcc acc aenv arrs -> String -> Operator
confOperator = (String -> Operator)
-> PreOpenAcc acc aenv arrs -> String -> Operator
forall a b. a -> b -> a
const String -> Operator
forall a. IsString a => String -> a
fromString }

configWithHash :: PrettyConfig Delayed.DelayedOpenAcc
configWithHash :: PrettyConfig DelayedOpenAcc
configWithHash =
  PrettyConfig
    { confOperator :: forall aenv arrs.
PreOpenAcc DelayedOpenAcc aenv arrs -> String -> Operator
confOperator = \PreOpenAcc DelayedOpenAcc aenv arrs
pacc String
name ->
        let hashval :: Hash
hashval = HashOptions
-> EncodeAcc DelayedOpenAcc
-> PreOpenAcc DelayedOpenAcc aenv arrs
-> Hash
forall (acc :: * -> * -> *) aenv a.
HasArraysR acc =>
HashOptions -> EncodeAcc acc -> PreOpenAcc acc aenv a -> Hash
Hash.hashPreOpenAccWith
                          (HashOptions
Hash.defaultHashOptions { perfect :: Bool
Hash.perfect = Bool
False })
                          HashOptions -> DelayedOpenAcc aenv a -> Builder
EncodeAcc DelayedOpenAcc
Delayed.encodeDelayedOpenAcc
                          PreOpenAcc DelayedOpenAcc aenv arrs
pacc
        in String -> Operator
forall a. IsString a => String -> a
fromString (String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Hash -> String
forall a. Show a => a -> String
show Hash
hashval) }


-- Array computations
-- ------------------

prettyPreOpenAfun
    :: forall acc aenv f.
       PrettyConfig acc
    -> PrettyAcc acc
    -> Val aenv
    -> PreOpenAfun acc aenv f
    -> Adoc
prettyPreOpenAfun :: forall (acc :: * -> * -> *) aenv f.
PrettyConfig acc
-> PrettyAcc acc
-> Val aenv
-> PreOpenAfun acc aenv f
-> Doc Keyword
prettyPreOpenAfun PrettyConfig acc
config PrettyAcc acc
prettyAcc Val aenv
aenv0 = Doc Keyword -> Val aenv -> PreOpenAfun acc aenv f -> Doc Keyword
forall aenv' f'.
Doc Keyword -> Val aenv' -> PreOpenAfun acc aenv' f' -> Doc Keyword
next (Char -> Doc Keyword
forall ann. Char -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Char
'\\') Val aenv
aenv0
  where
    next :: Adoc -> Val aenv' -> PreOpenAfun acc aenv' f' -> Adoc
    next :: forall aenv' f'.
Doc Keyword -> Val aenv' -> PreOpenAfun acc aenv' f' -> Doc Keyword
next Doc Keyword
vs Val aenv'
aenv (Abody acc aenv' f'
body)   =
      Precedence -> Doc Keyword -> Doc Keyword
forall ann. Precedence -> Doc ann -> Doc ann
hang Precedence
shiftwidth ([Doc Keyword] -> Doc Keyword
forall ann. [Doc ann] -> Doc ann
sep [Doc Keyword
vs Doc Keyword -> Doc Keyword -> Doc Keyword
forall a. Semigroup a => a -> a -> a
<> Doc Keyword
"->", PrettyConfig acc
-> Context -> Val aenv' -> acc aenv' f' -> Doc Keyword
PrettyAcc acc
prettyAcc PrettyConfig acc
config Context
context0 Val aenv'
aenv acc aenv' f'
body])
    next Doc Keyword
vs Val aenv'
aenv (Alam ALeftHandSide a aenv' aenv'
lhs PreOpenAfun acc aenv' t1
lam) =
      let (Val aenv'
aenv', Doc Keyword
lhs') = Bool
-> Val aenv'
-> ALeftHandSide a aenv' aenv'
-> (Val aenv', Doc Keyword)
forall env (s :: * -> *) arrs env'.
Bool
-> Val env
-> LeftHandSide s arrs env env'
-> (Val env', Doc Keyword)
prettyALhs Bool
True Val aenv'
aenv ALeftHandSide a aenv' aenv'
lhs
      in  Doc Keyword -> Val aenv' -> PreOpenAfun acc aenv' t1 -> Doc Keyword
forall aenv' f'.
Doc Keyword -> Val aenv' -> PreOpenAfun acc aenv' f' -> Doc Keyword
next (Doc Keyword
vs Doc Keyword -> Doc Keyword -> Doc Keyword
forall a. Semigroup a => a -> a -> a
<> Doc Keyword
lhs' Doc Keyword -> Doc Keyword -> Doc Keyword
forall a. Semigroup a => a -> a -> a
<> Doc Keyword
forall ann. Doc ann
space) Val aenv'
aenv' PreOpenAfun acc aenv' t1
lam

prettyPreOpenAcc
    :: forall acc aenv arrs.
       PrettyConfig acc
    -> Context
    -> PrettyAcc acc
    -> ExtractAcc acc
    -> Val aenv
    -> PreOpenAcc acc aenv arrs
    -> Adoc
prettyPreOpenAcc :: forall (acc :: * -> * -> *) aenv arrs.
PrettyConfig acc
-> Context
-> PrettyAcc acc
-> ExtractAcc acc
-> Val aenv
-> PreOpenAcc acc aenv arrs
-> Doc Keyword
prettyPreOpenAcc PrettyConfig acc
config Context
ctx PrettyAcc acc
prettyAcc ExtractAcc acc
extractAcc Val aenv
aenv PreOpenAcc acc aenv arrs
pacc =
  case PreOpenAcc acc aenv arrs
pacc of
    Avar (Var ArrayR (Array sh e)
_ Idx aenv (Array sh e)
idx)  -> Idx aenv (Array sh e) -> Val aenv -> Doc Keyword
forall env t. Idx env t -> Val env -> Doc Keyword
prj Idx aenv (Array sh e)
idx Val aenv
aenv
    Alet{}            -> PrettyConfig acc
-> Context
-> PrettyAcc acc
-> ExtractAcc acc
-> Val aenv
-> PreOpenAcc acc aenv arrs
-> Doc Keyword
forall (acc :: * -> * -> *) aenv arrs.
PrettyConfig acc
-> Context
-> PrettyAcc acc
-> ExtractAcc acc
-> Val aenv
-> PreOpenAcc acc aenv arrs
-> Doc Keyword
prettyAlet PrettyConfig acc
config Context
ctx PrettyConfig acc
-> Context -> Val aenv -> acc aenv a -> Doc Keyword
PrettyAcc acc
prettyAcc acc aenv a -> PreOpenAcc acc aenv a
ExtractAcc acc
extractAcc Val aenv
aenv PreOpenAcc acc aenv arrs
pacc
    Apair{}           -> PrettyConfig acc
-> Context
-> PrettyAcc acc
-> ExtractAcc acc
-> Val aenv
-> PreOpenAcc acc aenv arrs
-> Doc Keyword
forall (acc :: * -> * -> *) aenv arrs.
PrettyConfig acc
-> Context
-> PrettyAcc acc
-> ExtractAcc acc
-> Val aenv
-> PreOpenAcc acc aenv arrs
-> Doc Keyword
prettyAtuple PrettyConfig acc
config Context
ctx PrettyConfig acc
-> Context -> Val aenv -> acc aenv a -> Doc Keyword
PrettyAcc acc
prettyAcc acc aenv a -> PreOpenAcc acc aenv a
ExtractAcc acc
extractAcc Val aenv
aenv PreOpenAcc acc aenv arrs
pacc
    PreOpenAcc acc aenv arrs
Anil              -> Doc Keyword
"()"
    Apply ArraysR arrs
_ PreOpenAfun acc aenv (arrs1 -> arrs)
f acc aenv arrs1
a       -> Doc Keyword
apply
      where
        op :: Operator
op    = Doc Keyword -> Fixity -> Associativity -> Precedence -> Operator
Operator Doc Keyword
">->" Fixity
Infix Associativity
L Precedence
1
        apply :: Doc Keyword
apply = [Doc Keyword] -> Doc Keyword
forall ann. [Doc ann] -> Doc ann
sep [ PreOpenAfun acc aenv (arrs1 -> arrs) -> Doc Keyword
forall f. PreOpenAfun acc aenv f -> Doc Keyword
ppAF PreOpenAfun acc aenv (arrs1 -> arrs)
f, Doc Keyword -> Doc Keyword
forall ann. Doc ann -> Doc ann
group ([Doc Keyword] -> Doc Keyword
forall ann. [Doc ann] -> Doc ann
sep [Operator -> Doc Keyword
opName Operator
op, acc aenv arrs1 -> Doc Keyword
forall a. acc aenv a -> Doc Keyword
ppA acc aenv arrs1
a]) ]

    Acond Exp aenv PrimBool
p acc aenv arrs
t acc aenv arrs
e       -> Doc Keyword -> Doc Keyword -> Doc Keyword
forall ann. Doc ann -> Doc ann -> Doc ann
flatAlt Doc Keyword
multi Doc Keyword
single
      where
        p' :: Doc Keyword
p' = Exp aenv PrimBool -> Doc Keyword
forall t. Exp aenv t -> Doc Keyword
ppE Exp aenv PrimBool
p
        t' :: Doc Keyword
t' = acc aenv arrs -> Doc Keyword
forall a. acc aenv a -> Doc Keyword
ppA acc aenv arrs
t
        e' :: Doc Keyword
e' = acc aenv arrs -> Doc Keyword
forall a. acc aenv a -> Doc Keyword
ppA acc aenv arrs
e
        --
        single :: Doc Keyword
single = Bool -> Doc Keyword -> Doc Keyword
forall ann. Bool -> Doc ann -> Doc ann
parensIf (Context -> Operator -> Bool
needsParens Context
ctx (Doc Keyword -> Fixity -> Associativity -> Precedence -> Operator
Operator Doc Keyword
"?|:" Fixity
Infix Associativity
N Precedence
0))
               (Doc Keyword -> Doc Keyword) -> Doc Keyword -> Doc Keyword
forall a b. (a -> b) -> a -> b
$ [Doc Keyword] -> Doc Keyword
forall ann. [Doc ann] -> Doc ann
sep [ Doc Keyword
p', Doc Keyword
"?|", Doc Keyword
t', Char -> Doc Keyword
forall ann. Char -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Char
':', Doc Keyword
e' ]
        multi :: Doc Keyword
multi  = Precedence -> Doc Keyword -> Doc Keyword
forall ann. Precedence -> Doc ann -> Doc ann
hang Precedence
3
               (Doc Keyword -> Doc Keyword) -> Doc Keyword -> Doc Keyword
forall a b. (a -> b) -> a -> b
$ [Doc Keyword] -> Doc Keyword
forall ann. [Doc ann] -> Doc ann
vsep [ Doc Keyword
if_ Doc Keyword -> Doc Keyword -> Doc Keyword
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc Keyword
p'
                      , Precedence -> Doc Keyword -> Doc Keyword
forall ann. Precedence -> Doc ann -> Doc ann
hang Precedence
shiftwidth ([Doc Keyword] -> Doc Keyword
forall ann. [Doc ann] -> Doc ann
sep [ Doc Keyword
then_, Doc Keyword
t' ])
                      , Precedence -> Doc Keyword -> Doc Keyword
forall ann. Precedence -> Doc ann -> Doc ann
hang Precedence
shiftwidth ([Doc Keyword] -> Doc Keyword
forall ann. [Doc ann] -> Doc ann
sep [ Doc Keyword
else_, Doc Keyword
e' ]) ]


    Atrace (Message arrs1 -> String
_ Maybe (CodeQ (arrs1 -> String))
_ Text
msg) acc aenv arrs1
as acc aenv arrs
bs  -> String -> Operator
ppN String
"atrace"      Operator -> [Doc Keyword] -> Doc Keyword
.$ [ String -> Doc Keyword
forall a. IsString a => String -> a
fromString (Text -> String
forall a. Show a => a -> String
show Text
msg), acc aenv arrs1 -> Doc Keyword
forall a. acc aenv a -> Doc Keyword
ppA acc aenv arrs1
as, acc aenv arrs -> Doc Keyword
forall a. acc aenv a -> Doc Keyword
ppA acc aenv arrs
bs ]
    Aforeign ArraysR arrs
_ asm (as -> arrs)
ff PreAfun acc (as -> arrs)
_ acc aenv as
a               -> String -> Operator
ppN String
"aforeign"    Operator -> [Doc Keyword] -> Doc Keyword
.$ [ String -> Doc Keyword
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (asm (as -> arrs) -> String
forall args. asm args -> String
forall (asm :: * -> *) args. Foreign asm => asm args -> String
strForeign asm (as -> arrs)
ff), acc aenv as -> Doc Keyword
forall a. acc aenv a -> Doc Keyword
ppA acc aenv as
a ]
    Awhile PreOpenAfun acc aenv (arrs -> Scalar PrimBool)
p PreOpenAfun acc aenv (arrs -> arrs)
f acc aenv arrs
a                    -> String -> Operator
ppN String
"awhile"      Operator -> [Doc Keyword] -> Doc Keyword
.$ [ PreOpenAfun acc aenv (arrs -> Scalar PrimBool) -> Doc Keyword
forall f. PreOpenAfun acc aenv f -> Doc Keyword
ppAF PreOpenAfun acc aenv (arrs -> Scalar PrimBool)
p, PreOpenAfun acc aenv (arrs -> arrs) -> Doc Keyword
forall f. PreOpenAfun acc aenv f -> Doc Keyword
ppAF PreOpenAfun acc aenv (arrs -> arrs)
f, acc aenv arrs -> Doc Keyword
forall a. acc aenv a -> Doc Keyword
ppA acc aenv arrs
a ]
    Use ArrayR (Array sh e)
repr Array sh e
arr                    -> String -> Operator
ppN String
"use"         Operator -> [Doc Keyword] -> Doc Keyword
.$ [ ArrayR (Array sh e) -> Array sh e -> Doc Keyword
forall sh e. ArrayR (Array sh e) -> Array sh e -> Doc Keyword
prettyArray ArrayR (Array sh e)
repr Array sh e
arr ]
    Unit TypeR e
_ Exp aenv e
e                        -> String -> Operator
ppN String
"unit"        Operator -> [Doc Keyword] -> Doc Keyword
.$ [ Exp aenv e -> Doc Keyword
forall t. Exp aenv t -> Doc Keyword
ppE Exp aenv e
e ]
    Reshape ShapeR sh
_ Exp aenv sh
sh acc aenv (Array sh' e)
a                  -> String -> Operator
ppN String
"reshape"     Operator -> [Doc Keyword] -> Doc Keyword
.$ [ Exp aenv sh -> Doc Keyword
forall t. Exp aenv t -> Doc Keyword
ppE Exp aenv sh
sh, acc aenv (Array sh' e) -> Doc Keyword
forall a. acc aenv a -> Doc Keyword
ppA acc aenv (Array sh' e)
a ]
    Generate ArrayR (Array sh e)
_ Exp aenv sh
sh Fun aenv (sh -> e)
f                 -> String -> Operator
ppN String
"generate"    Operator -> [Doc Keyword] -> Doc Keyword
.$ [ Exp aenv sh -> Doc Keyword
forall t. Exp aenv t -> Doc Keyword
ppE Exp aenv sh
sh, Fun aenv (sh -> e) -> Doc Keyword
forall t. Fun aenv t -> Doc Keyword
ppF Fun aenv (sh -> e)
f ]
    Transform ArrayR (Array sh' b)
_ Exp aenv sh'
sh Fun aenv (sh' -> sh)
p Fun aenv (a1 -> b)
f acc aenv (Array sh a1)
a            -> String -> Operator
ppN String
"transform"   Operator -> [Doc Keyword] -> Doc Keyword
.$ [ Exp aenv sh' -> Doc Keyword
forall t. Exp aenv t -> Doc Keyword
ppE Exp aenv sh'
sh, Fun aenv (sh' -> sh) -> Doc Keyword
forall t. Fun aenv t -> Doc Keyword
ppF Fun aenv (sh' -> sh)
p, Fun aenv (a1 -> b) -> Doc Keyword
forall t. Fun aenv t -> Doc Keyword
ppF Fun aenv (a1 -> b)
f, acc aenv (Array sh a1) -> Doc Keyword
forall a. acc aenv a -> Doc Keyword
ppA acc aenv (Array sh a1)
a ]
    Replicate SliceIndex slix sl co sh
_ Exp aenv slix
ix acc aenv (Array sl e)
a                -> String -> Operator
ppN String
"replicate"   Operator -> [Doc Keyword] -> Doc Keyword
.$ [ Exp aenv slix -> Doc Keyword
forall t. Exp aenv t -> Doc Keyword
ppE Exp aenv slix
ix, acc aenv (Array sl e) -> Doc Keyword
forall a. acc aenv a -> Doc Keyword
ppA acc aenv (Array sl e)
a ]
    Slice SliceIndex slix sl co sh
_ acc aenv (Array sh e)
a Exp aenv slix
ix                    -> String -> Operator
ppN String
"slice"       Operator -> [Doc Keyword] -> Doc Keyword
.$ [ Exp aenv slix -> Doc Keyword
forall t. Exp aenv t -> Doc Keyword
ppE Exp aenv slix
ix, acc aenv (Array sh e) -> Doc Keyword
forall a. acc aenv a -> Doc Keyword
ppA acc aenv (Array sh e)
a ]
    Map TypeR e'
_ Fun aenv (e -> e')
f acc aenv (Array sh e)
a                       -> String -> Operator
ppN String
"map"         Operator -> [Doc Keyword] -> Doc Keyword
.$ [ Fun aenv (e -> e') -> Doc Keyword
forall t. Fun aenv t -> Doc Keyword
ppF Fun aenv (e -> e')
f,  acc aenv (Array sh e) -> Doc Keyword
forall a. acc aenv a -> Doc Keyword
ppA acc aenv (Array sh e)
a ]
    ZipWith TypeR e3
_ Fun aenv (e1 -> e2 -> e3)
f acc aenv (Array sh e1)
a acc aenv (Array sh e2)
b                 -> String -> Operator
ppN String
"zipWith"     Operator -> [Doc Keyword] -> Doc Keyword
.$ [ Fun aenv (e1 -> e2 -> e3) -> Doc Keyword
forall t. Fun aenv t -> Doc Keyword
ppF Fun aenv (e1 -> e2 -> e3)
f,  acc aenv (Array sh e1) -> Doc Keyword
forall a. acc aenv a -> Doc Keyword
ppA acc aenv (Array sh e1)
a, acc aenv (Array sh e2) -> Doc Keyword
forall a. acc aenv a -> Doc Keyword
ppA acc aenv (Array sh e2)
b ]
    Fold Fun aenv (e -> e -> e)
f (Just Exp aenv e
z) acc aenv (Array (sh, Precedence) e)
a               -> String -> Operator
ppN String
"fold"        Operator -> [Doc Keyword] -> Doc Keyword
.$ [ Fun aenv (e -> e -> e) -> Doc Keyword
forall t. Fun aenv t -> Doc Keyword
ppF Fun aenv (e -> e -> e)
f,  Exp aenv e -> Doc Keyword
forall t. Exp aenv t -> Doc Keyword
ppE Exp aenv e
z, acc aenv (Array (sh, Precedence) e) -> Doc Keyword
forall a. acc aenv a -> Doc Keyword
ppA acc aenv (Array (sh, Precedence) e)
a ]
    Fold Fun aenv (e -> e -> e)
f Maybe (Exp aenv e)
Nothing  acc aenv (Array (sh, Precedence) e)
a               -> String -> Operator
ppN String
"fold1"       Operator -> [Doc Keyword] -> Doc Keyword
.$ [ Fun aenv (e -> e -> e) -> Doc Keyword
forall t. Fun aenv t -> Doc Keyword
ppF Fun aenv (e -> e -> e)
f,  acc aenv (Array (sh, Precedence) e) -> Doc Keyword
forall a. acc aenv a -> Doc Keyword
ppA acc aenv (Array (sh, Precedence) e)
a ]
    FoldSeg IntegralType i
_ Fun aenv (e -> e -> e)
f (Just Exp aenv e
z) acc aenv (Array (sh, Precedence) e)
a acc aenv (Segments i)
s        -> String -> Operator
ppN String
"foldSeg"     Operator -> [Doc Keyword] -> Doc Keyword
.$ [ Fun aenv (e -> e -> e) -> Doc Keyword
forall t. Fun aenv t -> Doc Keyword
ppF Fun aenv (e -> e -> e)
f,  Exp aenv e -> Doc Keyword
forall t. Exp aenv t -> Doc Keyword
ppE Exp aenv e
z, acc aenv (Array (sh, Precedence) e) -> Doc Keyword
forall a. acc aenv a -> Doc Keyword
ppA acc aenv (Array (sh, Precedence) e)
a, acc aenv (Segments i) -> Doc Keyword
forall a. acc aenv a -> Doc Keyword
ppA acc aenv (Segments i)
s ]
    FoldSeg IntegralType i
_ Fun aenv (e -> e -> e)
f Maybe (Exp aenv e)
Nothing  acc aenv (Array (sh, Precedence) e)
a acc aenv (Segments i)
s        -> String -> Operator
ppN String
"fold1Seg"    Operator -> [Doc Keyword] -> Doc Keyword
.$ [ Fun aenv (e -> e -> e) -> Doc Keyword
forall t. Fun aenv t -> Doc Keyword
ppF Fun aenv (e -> e -> e)
f,  acc aenv (Array (sh, Precedence) e) -> Doc Keyword
forall a. acc aenv a -> Doc Keyword
ppA acc aenv (Array (sh, Precedence) e)
a, acc aenv (Segments i) -> Doc Keyword
forall a. acc aenv a -> Doc Keyword
ppA acc aenv (Segments i)
s ]
    Scan Direction
d Fun aenv (e -> e -> e)
f (Just Exp aenv e
z) acc aenv (Array (sh, Precedence) e)
a             -> String -> Direction -> String -> Operator
ppD String
"scan" Direction
d String
""   Operator -> [Doc Keyword] -> Doc Keyword
.$ [ Fun aenv (e -> e -> e) -> Doc Keyword
forall t. Fun aenv t -> Doc Keyword
ppF Fun aenv (e -> e -> e)
f,  Exp aenv e -> Doc Keyword
forall t. Exp aenv t -> Doc Keyword
ppE Exp aenv e
z, acc aenv (Array (sh, Precedence) e) -> Doc Keyword
forall a. acc aenv a -> Doc Keyword
ppA acc aenv (Array (sh, Precedence) e)
a ]
    Scan Direction
d Fun aenv (e -> e -> e)
f Maybe (Exp aenv e)
Nothing  acc aenv (Array (sh, Precedence) e)
a             -> String -> Direction -> String -> Operator
ppD String
"scan" Direction
d String
"1"  Operator -> [Doc Keyword] -> Doc Keyword
.$ [ Fun aenv (e -> e -> e) -> Doc Keyword
forall t. Fun aenv t -> Doc Keyword
ppF Fun aenv (e -> e -> e)
f,  acc aenv (Array (sh, Precedence) e) -> Doc Keyword
forall a. acc aenv a -> Doc Keyword
ppA acc aenv (Array (sh, Precedence) e)
a ]
    Scan' Direction
d Fun aenv (e -> e -> e)
f Exp aenv e
z acc aenv (Array (sh, Precedence) e)
a                   -> String -> Direction -> String -> Operator
ppD String
"scan" Direction
d String
"'"  Operator -> [Doc Keyword] -> Doc Keyword
.$ [ Fun aenv (e -> e -> e) -> Doc Keyword
forall t. Fun aenv t -> Doc Keyword
ppF Fun aenv (e -> e -> e)
f,  Exp aenv e -> Doc Keyword
forall t. Exp aenv t -> Doc Keyword
ppE Exp aenv e
z, acc aenv (Array (sh, Precedence) e) -> Doc Keyword
forall a. acc aenv a -> Doc Keyword
ppA acc aenv (Array (sh, Precedence) e)
a ]
    Permute Fun aenv (e -> e -> e)
f acc aenv (Array sh' e)
d Fun aenv (sh -> PrimMaybe sh')
p acc aenv (Array sh e)
s                 -> String -> Operator
ppN String
"permute"     Operator -> [Doc Keyword] -> Doc Keyword
.$ [ Fun aenv (e -> e -> e) -> Doc Keyword
forall t. Fun aenv t -> Doc Keyword
ppF Fun aenv (e -> e -> e)
f,  acc aenv (Array sh' e) -> Doc Keyword
forall a. acc aenv a -> Doc Keyword
ppA acc aenv (Array sh' e)
d, Fun aenv (sh -> PrimMaybe sh') -> Doc Keyword
forall t. Fun aenv t -> Doc Keyword
ppF Fun aenv (sh -> PrimMaybe sh')
p, acc aenv (Array sh e) -> Doc Keyword
forall a. acc aenv a -> Doc Keyword
ppA acc aenv (Array sh e)
s ]
    Backpermute ShapeR sh'
_ Exp aenv sh'
sh Fun aenv (sh' -> sh)
f acc aenv (Array sh e)
a            -> String -> Operator
ppN String
"backpermute" Operator -> [Doc Keyword] -> Doc Keyword
.$ [ Exp aenv sh' -> Doc Keyword
forall t. Exp aenv t -> Doc Keyword
ppE Exp aenv sh'
sh, Fun aenv (sh' -> sh) -> Doc Keyword
forall t. Fun aenv t -> Doc Keyword
ppF Fun aenv (sh' -> sh)
f, acc aenv (Array sh e) -> Doc Keyword
forall a. acc aenv a -> Doc Keyword
ppA acc aenv (Array sh e)
a ]
    Stencil StencilR sh e stencil
s TypeR e'
_ Fun aenv (stencil -> e')
f Boundary aenv (Array sh e)
b acc aenv (Array sh e)
a               -> String -> Operator
ppN String
"stencil"     Operator -> [Doc Keyword] -> Doc Keyword
.$ [ Fun aenv (stencil -> e') -> Doc Keyword
forall t. Fun aenv t -> Doc Keyword
ppF Fun aenv (stencil -> e')
f,  TypeR e -> Boundary aenv (Array sh e) -> Doc Keyword
forall sh e. TypeR e -> Boundary aenv (Array sh e) -> Doc Keyword
ppB (StencilR sh e stencil -> TypeR e
forall sh e pat. StencilR sh e pat -> TypeR e
stencilEltR StencilR sh e stencil
s) Boundary aenv (Array sh e)
b, acc aenv (Array sh e) -> Doc Keyword
forall a. acc aenv a -> Doc Keyword
ppA acc aenv (Array sh e)
a ]
    Stencil2 StencilR sh a1 stencil1
s1 StencilR sh b stencil2
s2 TypeR c
_ Fun aenv (stencil1 -> stencil2 -> c)
f Boundary aenv (Array sh a1)
b1 acc aenv (Array sh a1)
a1 Boundary aenv (Array sh b)
b2 acc aenv (Array sh b)
a2  -> String -> Operator
ppN String
"stencil2"    Operator -> [Doc Keyword] -> Doc Keyword
.$ [ Fun aenv (stencil1 -> stencil2 -> c) -> Doc Keyword
forall t. Fun aenv t -> Doc Keyword
ppF Fun aenv (stencil1 -> stencil2 -> c)
f,  TypeR a1 -> Boundary aenv (Array sh a1) -> Doc Keyword
forall sh e. TypeR e -> Boundary aenv (Array sh e) -> Doc Keyword
ppB (StencilR sh a1 stencil1 -> TypeR a1
forall sh e pat. StencilR sh e pat -> TypeR e
stencilEltR StencilR sh a1 stencil1
s1) Boundary aenv (Array sh a1)
b1, acc aenv (Array sh a1) -> Doc Keyword
forall a. acc aenv a -> Doc Keyword
ppA acc aenv (Array sh a1)
a1, TypeR b -> Boundary aenv (Array sh b) -> Doc Keyword
forall sh e. TypeR e -> Boundary aenv (Array sh e) -> Doc Keyword
ppB (StencilR sh b stencil2 -> TypeR b
forall sh e pat. StencilR sh e pat -> TypeR e
stencilEltR StencilR sh b stencil2
s2) Boundary aenv (Array sh b)
b2, acc aenv (Array sh b) -> Doc Keyword
forall a. acc aenv a -> Doc Keyword
ppA acc aenv (Array sh b)
a2 ]
  where
    infixr 0 .$
    Operator
f .$ :: Operator -> [Doc Keyword] -> Doc Keyword
.$ [Doc Keyword]
xs
      = Bool -> Doc Keyword -> Doc Keyword
forall ann. Bool -> Doc ann -> Doc ann
parensIf (Context -> Operator -> Bool
needsParens Context
ctx Operator
f)
      (Doc Keyword -> Doc Keyword) -> Doc Keyword -> Doc Keyword
forall a b. (a -> b) -> a -> b
$ Precedence -> Doc Keyword -> Doc Keyword
forall ann. Precedence -> Doc ann -> Doc ann
hang Precedence
shiftwidth ([Doc Keyword] -> Doc Keyword
forall ann. [Doc ann] -> Doc ann
sep (Operator -> Doc Keyword
manifest Operator
f Doc Keyword -> [Doc Keyword] -> [Doc Keyword]
forall a. a -> [a] -> [a]
: [Doc Keyword]
xs))

    ppN :: String -> Operator
    ppN :: String -> Operator
ppN = PrettyConfig acc
-> forall aenv arrs. PreOpenAcc acc aenv arrs -> String -> Operator
forall (acc :: * -> * -> *).
PrettyConfig acc
-> forall aenv arrs. PreOpenAcc acc aenv arrs -> String -> Operator
confOperator PrettyConfig acc
config PreOpenAcc acc aenv arrs
pacc

    ppA :: acc aenv a -> Adoc
    ppA :: forall a. acc aenv a -> Doc Keyword
ppA = PrettyConfig acc
-> Context -> Val aenv -> acc aenv a -> Doc Keyword
PrettyAcc acc
prettyAcc PrettyConfig acc
config Context
app Val aenv
aenv

    ppAF :: PreOpenAfun acc aenv f -> Adoc
    ppAF :: forall f. PreOpenAfun acc aenv f -> Doc Keyword
ppAF = Doc Keyword -> Doc Keyword
forall ann. Doc ann -> Doc ann
parens (Doc Keyword -> Doc Keyword)
-> (PreOpenAfun acc aenv f -> Doc Keyword)
-> PreOpenAfun acc aenv f
-> Doc Keyword
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrettyConfig acc
-> PrettyAcc acc
-> Val aenv
-> PreOpenAfun acc aenv f
-> Doc Keyword
forall (acc :: * -> * -> *) aenv f.
PrettyConfig acc
-> PrettyAcc acc
-> Val aenv
-> PreOpenAfun acc aenv f
-> Doc Keyword
prettyPreOpenAfun PrettyConfig acc
config PrettyConfig acc
-> Context -> Val aenv -> acc aenv a -> Doc Keyword
PrettyAcc acc
prettyAcc Val aenv
aenv

    ppE :: Exp aenv t -> Adoc
    ppE :: forall t. Exp aenv t -> Doc Keyword
ppE = Context -> Val () -> Val aenv -> OpenExp () aenv t -> Doc Keyword
forall env aenv t.
Context -> Val env -> Val aenv -> OpenExp env aenv t -> Doc Keyword
prettyOpenExp Context
app Val ()
Empty Val aenv
aenv

    ppF :: Fun aenv t -> Adoc
    ppF :: forall t. Fun aenv t -> Doc Keyword
ppF = Doc Keyword -> Doc Keyword
forall ann. Doc ann -> Doc ann
parens (Doc Keyword -> Doc Keyword)
-> (Fun aenv t -> Doc Keyword) -> Fun aenv t -> Doc Keyword
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Val () -> Val aenv -> Fun aenv t -> Doc Keyword
forall env aenv f.
Val env -> Val aenv -> OpenFun env aenv f -> Doc Keyword
prettyOpenFun Val ()
Empty Val aenv
aenv

    ppB :: forall sh e.
           TypeR e
        -> Boundary aenv (Array sh e)
        -> Adoc
    ppB :: forall sh e. TypeR e -> Boundary aenv (Array sh e) -> Doc Keyword
ppB TypeR e
_  Boundary aenv (Array sh e)
Clamp        = Doc Keyword
"clamp"
    ppB TypeR e
_  Boundary aenv (Array sh e)
Mirror       = Doc Keyword
"mirror"
    ppB TypeR e
_  Boundary aenv (Array sh e)
Wrap         = Doc Keyword
"wrap"
    ppB TypeR e
tp (Constant e
e) = TypeR e -> e -> Doc Keyword
forall e. TypeR e -> e -> Doc Keyword
prettyConst TypeR e
tp e
e
e
    ppB TypeR e
_  (Function Fun aenv (sh -> e)
f) = Fun aenv (sh -> e) -> Doc Keyword
forall t. Fun aenv t -> Doc Keyword
ppF Fun aenv (sh -> e)
f

    ppD :: String -> AST.Direction -> String -> Operator
    ppD :: String -> Direction -> String -> Operator
ppD String
f Direction
AST.LeftToRight String
k = String -> Operator
ppN (String
f String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"l" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
k)
    ppD String
f Direction
AST.RightToLeft String
k = String -> Operator
ppN (String
f String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"r" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
k)


prettyAlet
    :: forall acc aenv arrs.
       PrettyConfig acc
    -> Context
    -> PrettyAcc acc
    -> ExtractAcc acc
    -> Val aenv
    -> PreOpenAcc acc aenv arrs
    -> Adoc
prettyAlet :: forall (acc :: * -> * -> *) aenv arrs.
PrettyConfig acc
-> Context
-> PrettyAcc acc
-> ExtractAcc acc
-> Val aenv
-> PreOpenAcc acc aenv arrs
-> Doc Keyword
prettyAlet PrettyConfig acc
config Context
ctx PrettyAcc acc
prettyAcc ExtractAcc acc
extractAcc Val aenv
aenv0
  = Bool -> Doc Keyword -> Doc Keyword
forall ann. Bool -> Doc ann -> Doc ann
parensIf (Context -> Precedence
ctxPrecedence Context
ctx Precedence -> Precedence -> Bool
forall a. Ord a => a -> a -> Bool
> Precedence
0)
  (Doc Keyword -> Doc Keyword)
-> (PreOpenAcc acc aenv arrs -> Doc Keyword)
-> PreOpenAcc acc aenv arrs
-> Doc Keyword
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Keyword -> Doc Keyword
forall ann. Doc ann -> Doc ann
align (Doc Keyword -> Doc Keyword)
-> (PreOpenAcc acc aenv arrs -> Doc Keyword)
-> PreOpenAcc acc aenv arrs
-> Doc Keyword
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Doc Keyword], Doc Keyword) -> Doc Keyword
wrap (([Doc Keyword], Doc Keyword) -> Doc Keyword)
-> (PreOpenAcc acc aenv arrs -> ([Doc Keyword], Doc Keyword))
-> PreOpenAcc acc aenv arrs
-> Doc Keyword
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Val aenv
-> PreOpenAcc acc aenv arrs -> ([Doc Keyword], Doc Keyword)
forall aenv' a.
Val aenv' -> PreOpenAcc acc aenv' a -> ([Doc Keyword], Doc Keyword)
collect Val aenv
aenv0
  where
    collect :: Val aenv' -> PreOpenAcc acc aenv' a -> ([Adoc], Adoc)
    collect :: forall aenv' a.
Val aenv' -> PreOpenAcc acc aenv' a -> ([Doc Keyword], Doc Keyword)
collect Val aenv'
aenv =
      \case
        Alet ALeftHandSide bndArrs aenv' aenv'
lhs acc aenv' bndArrs
a1 acc aenv' a
a2 ->
          let (Val aenv'
aenv', Doc Keyword
v)      = Bool
-> Val aenv'
-> ALeftHandSide bndArrs aenv' aenv'
-> (Val aenv', Doc Keyword)
forall env (s :: * -> *) arrs env'.
Bool
-> Val env
-> LeftHandSide s arrs env env'
-> (Val env', Doc Keyword)
prettyALhs Bool
False Val aenv'
aenv ALeftHandSide bndArrs aenv' aenv'
lhs
              a1' :: Doc Keyword
a1'             = Val aenv' -> acc aenv' bndArrs -> Doc Keyword
forall aenv' a. Val aenv' -> acc aenv' a -> Doc Keyword
ppA Val aenv'
aenv acc aenv' bndArrs
a1
              bnd :: Doc Keyword
bnd | acc aenv' bndArrs -> Bool
forall aenv' a. acc aenv' a -> Bool
isAlet acc aenv' bndArrs
a1 = Precedence -> Doc Keyword -> Doc Keyword
forall ann. Precedence -> Doc ann -> Doc ann
nest Precedence
shiftwidth ([Doc Keyword] -> Doc Keyword
forall ann. [Doc ann] -> Doc ann
vsep [Doc Keyword
v Doc Keyword -> Doc Keyword -> Doc Keyword
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc Keyword
forall ann. Doc ann
equals, Doc Keyword
a1'])
                  | Bool
otherwise = Doc Keyword
v Doc Keyword -> Doc Keyword -> Doc Keyword
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc Keyword -> Doc Keyword
forall ann. Doc ann -> Doc ann
align (Doc Keyword
forall ann. Doc ann
equals Doc Keyword -> Doc Keyword -> Doc Keyword
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc Keyword
a1')
              ([Doc Keyword]
bnds, Doc Keyword
body)    = Val aenv' -> PreOpenAcc acc aenv' a -> ([Doc Keyword], Doc Keyword)
forall aenv' a.
Val aenv' -> PreOpenAcc acc aenv' a -> ([Doc Keyword], Doc Keyword)
collect Val aenv'
aenv' (acc aenv' a -> PreOpenAcc acc aenv' a
ExtractAcc acc
extractAcc acc aenv' a
a2)
          in
          (Doc Keyword
bndDoc Keyword -> [Doc Keyword] -> [Doc Keyword]
forall a. a -> [a] -> [a]
:[Doc Keyword]
bnds, Doc Keyword
body)
        --
        PreOpenAcc acc aenv' a
next       -> ([], PrettyConfig acc
-> Context
-> PrettyAcc acc
-> ExtractAcc acc
-> Val aenv'
-> PreOpenAcc acc aenv' a
-> Doc Keyword
forall (acc :: * -> * -> *) aenv arrs.
PrettyConfig acc
-> Context
-> PrettyAcc acc
-> ExtractAcc acc
-> Val aenv
-> PreOpenAcc acc aenv arrs
-> Doc Keyword
prettyPreOpenAcc PrettyConfig acc
config Context
context0 PrettyConfig acc
-> Context -> Val aenv -> acc aenv a -> Doc Keyword
PrettyAcc acc
prettyAcc acc aenv a -> PreOpenAcc acc aenv a
ExtractAcc acc
extractAcc Val aenv'
aenv PreOpenAcc acc aenv' a
next)

    isAlet :: acc aenv' a -> Bool
    isAlet :: forall aenv' a. acc aenv' a -> Bool
isAlet (acc aenv' a -> PreOpenAcc acc aenv' a
ExtractAcc acc
extractAcc -> Alet{}) = Bool
True
    isAlet acc aenv' a
_                      = Bool
False

    ppA :: Val aenv' -> acc aenv' a -> Adoc
    ppA :: forall aenv' a. Val aenv' -> acc aenv' a -> Doc Keyword
ppA = PrettyConfig acc
-> Context -> Val aenv' -> acc aenv' a -> Doc Keyword
PrettyAcc acc
prettyAcc PrettyConfig acc
config Context
context0

    wrap :: ([Adoc], Adoc) -> Adoc
    wrap :: ([Doc Keyword], Doc Keyword) -> Doc Keyword
wrap ([],   Doc Keyword
body) = Doc Keyword
body  -- shouldn't happen!
    wrap ([Doc Keyword
b],  Doc Keyword
body)
      = [Doc Keyword] -> Doc Keyword
forall ann. [Doc ann] -> Doc ann
sep [ Precedence -> Doc Keyword -> Doc Keyword
forall ann. Precedence -> Doc ann -> Doc ann
nest Precedence
shiftwidth ([Doc Keyword] -> Doc Keyword
forall ann. [Doc ann] -> Doc ann
sep [Doc Keyword
let_, Doc Keyword
b]), Doc Keyword
in_, Doc Keyword
body ]
    wrap ([Doc Keyword]
bnds, Doc Keyword
body)
      = [Doc Keyword] -> Doc Keyword
forall ann. [Doc ann] -> Doc ann
vsep [ Precedence -> Doc Keyword -> Doc Keyword
forall ann. Precedence -> Doc ann -> Doc ann
nest Precedence
shiftwidth ([Doc Keyword] -> Doc Keyword
forall ann. [Doc ann] -> Doc ann
vsep (Doc Keyword
let_Doc Keyword -> [Doc Keyword] -> [Doc Keyword]
forall a. a -> [a] -> [a]
:[Doc Keyword]
bnds))
             , Doc Keyword
in_
             , Doc Keyword
body
             ]

prettyAtuple
    :: forall acc aenv arrs.
       PrettyConfig acc
    -> Context
    -> PrettyAcc acc
    -> ExtractAcc acc
    -> Val aenv
    -> PreOpenAcc acc aenv arrs
    -> Adoc
prettyAtuple :: forall (acc :: * -> * -> *) aenv arrs.
PrettyConfig acc
-> Context
-> PrettyAcc acc
-> ExtractAcc acc
-> Val aenv
-> PreOpenAcc acc aenv arrs
-> Doc Keyword
prettyAtuple PrettyConfig acc
config Context
ctx PrettyAcc acc
prettyAcc ExtractAcc acc
extractAcc Val aenv
aenv0 PreOpenAcc acc aenv arrs
acc = case PreOpenAcc acc aenv arrs -> Maybe [Doc Keyword]
forall arrs'. PreOpenAcc acc aenv arrs' -> Maybe [Doc Keyword]
collect PreOpenAcc acc aenv arrs
acc of
    Maybe [Doc Keyword]
Nothing  -> Doc Keyword -> Doc Keyword
forall ann. Doc ann -> Doc ann
align (Doc Keyword -> Doc Keyword) -> Doc Keyword -> Doc Keyword
forall a b. (a -> b) -> a -> b
$ PreOpenAcc acc aenv arrs -> Doc Keyword
forall arrs'. PreOpenAcc acc aenv arrs' -> Doc Keyword
ppPair PreOpenAcc acc aenv arrs
acc
    Just [Doc Keyword]
tup ->
      case [Doc Keyword]
tup of
        []  -> Doc Keyword
"()"
        [Doc Keyword]
_   -> Doc Keyword -> Doc Keyword
forall ann. Doc ann -> Doc ann
align (Doc Keyword -> Doc Keyword) -> Doc Keyword -> Doc Keyword
forall a b. (a -> b) -> a -> b
$ Bool -> Doc Keyword -> Doc Keyword
forall ann. Bool -> Doc ann -> Doc ann
parensIf (Context -> Precedence
ctxPrecedence Context
ctx Precedence -> Precedence -> Bool
forall a. Ord a => a -> a -> Bool
> Precedence
0) (Doc Keyword
"T" Doc Keyword -> Doc Keyword -> Doc Keyword
forall a. Semigroup a => a -> a -> a
<> Precedence -> Doc Keyword
forall ann. Precedence -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ([Doc Keyword] -> Precedence
forall a. [a] -> Precedence
forall (t :: * -> *) a. Foldable t => t a -> Precedence
length [Doc Keyword]
tup) Doc Keyword -> Doc Keyword -> Doc Keyword
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc Keyword -> Doc Keyword
forall ann. Doc ann -> Doc ann
align ([Doc Keyword] -> Doc Keyword
forall ann. [Doc ann] -> Doc ann
sep [Doc Keyword]
tup))
  where
    ppPair :: PreOpenAcc acc aenv arrs' -> Adoc
    ppPair :: forall arrs'. PreOpenAcc acc aenv arrs' -> Doc Keyword
ppPair (Apair acc aenv as
a1 acc aenv bs
a2) =
      Doc Keyword
"(" Doc Keyword -> Doc Keyword -> Doc Keyword
forall a. Semigroup a => a -> a -> a
<> PreOpenAcc acc aenv as -> Doc Keyword
forall arrs'. PreOpenAcc acc aenv arrs' -> Doc Keyword
ppPair (acc aenv as -> PreOpenAcc acc aenv as
ExtractAcc acc
extractAcc acc aenv as
a1) Doc Keyword -> Doc Keyword -> Doc Keyword
forall a. Semigroup a => a -> a -> a
<> Doc Keyword
"," Doc Keyword -> Doc Keyword -> Doc Keyword
forall ann. Doc ann -> Doc ann -> Doc ann
<+> PrettyConfig acc
-> Context -> Val aenv -> acc aenv bs -> Doc Keyword
PrettyAcc acc
prettyAcc PrettyConfig acc
config Context
context0 Val aenv
aenv0 acc aenv bs
a2 Doc Keyword -> Doc Keyword -> Doc Keyword
forall a. Semigroup a => a -> a -> a
<> Doc Keyword
")"
    ppPair PreOpenAcc acc aenv arrs'
a             = PrettyConfig acc
-> Context
-> PrettyAcc acc
-> ExtractAcc acc
-> Val aenv
-> PreOpenAcc acc aenv arrs'
-> Doc Keyword
forall (acc :: * -> * -> *) aenv arrs.
PrettyConfig acc
-> Context
-> PrettyAcc acc
-> ExtractAcc acc
-> Val aenv
-> PreOpenAcc acc aenv arrs
-> Doc Keyword
prettyPreOpenAcc PrettyConfig acc
config Context
context0 PrettyConfig acc
-> Context -> Val aenv -> acc aenv a -> Doc Keyword
PrettyAcc acc
prettyAcc acc aenv a -> PreOpenAcc acc aenv a
ExtractAcc acc
extractAcc Val aenv
aenv0 PreOpenAcc acc aenv arrs'
a

    collect :: PreOpenAcc acc aenv arrs' -> Maybe [Adoc]
    collect :: forall arrs'. PreOpenAcc acc aenv arrs' -> Maybe [Doc Keyword]
collect PreOpenAcc acc aenv arrs'
Anil          = [Doc Keyword] -> Maybe [Doc Keyword]
forall a. a -> Maybe a
Just []
    collect (Apair acc aenv as
a1 acc aenv bs
a2)
      | Just [Doc Keyword]
tup <- PreOpenAcc acc aenv as -> Maybe [Doc Keyword]
forall arrs'. PreOpenAcc acc aenv arrs' -> Maybe [Doc Keyword]
collect (PreOpenAcc acc aenv as -> Maybe [Doc Keyword])
-> PreOpenAcc acc aenv as -> Maybe [Doc Keyword]
forall a b. (a -> b) -> a -> b
$ acc aenv as -> PreOpenAcc acc aenv as
ExtractAcc acc
extractAcc acc aenv as
a1
                          = [Doc Keyword] -> Maybe [Doc Keyword]
forall a. a -> Maybe a
Just ([Doc Keyword] -> Maybe [Doc Keyword])
-> [Doc Keyword] -> Maybe [Doc Keyword]
forall a b. (a -> b) -> a -> b
$ [Doc Keyword]
tup [Doc Keyword] -> [Doc Keyword] -> [Doc Keyword]
forall a. [a] -> [a] -> [a]
++ [PrettyConfig acc
-> Context -> Val aenv -> acc aenv bs -> Doc Keyword
PrettyAcc acc
prettyAcc PrettyConfig acc
config Context
app Val aenv
aenv0 acc aenv bs
a2]
    collect PreOpenAcc acc aenv arrs'
_             = Maybe [Doc Keyword]
forall a. Maybe a
Nothing

-- TODO: Should we also print the types of the declared variables? And the types of wildcards?
prettyALhs :: Bool -> Val env -> LeftHandSide s arrs env env' -> (Val env', Adoc)
prettyALhs :: forall env (s :: * -> *) arrs env'.
Bool
-> Val env
-> LeftHandSide s arrs env env'
-> (Val env', Doc Keyword)
prettyALhs Bool
requiresParens = Bool
-> Char
-> Val env
-> LeftHandSide s arrs env env'
-> (Val env', Doc Keyword)
forall (s :: * -> *) env env' arrs.
Bool
-> Char
-> Val env
-> LeftHandSide s arrs env env'
-> (Val env', Doc Keyword)
prettyLhs Bool
requiresParens Char
'a'

prettyELhs :: Bool -> Val env -> LeftHandSide s arrs env env' -> (Val env', Adoc)
prettyELhs :: forall env (s :: * -> *) arrs env'.
Bool
-> Val env
-> LeftHandSide s arrs env env'
-> (Val env', Doc Keyword)
prettyELhs Bool
requiresParens = Bool
-> Char
-> Val env
-> LeftHandSide s arrs env env'
-> (Val env', Doc Keyword)
forall (s :: * -> *) env env' arrs.
Bool
-> Char
-> Val env
-> LeftHandSide s arrs env env'
-> (Val env', Doc Keyword)
prettyLhs Bool
requiresParens Char
'x'

prettyLhs :: forall s env env' arrs. Bool -> Char -> Val env -> LeftHandSide s arrs env env' -> (Val env', Adoc)
prettyLhs :: forall (s :: * -> *) env env' arrs.
Bool
-> Char
-> Val env
-> LeftHandSide s arrs env env'
-> (Val env', Doc Keyword)
prettyLhs Bool
requiresParens Char
x Val env
env0 LeftHandSide s arrs env env'
lhs = case LeftHandSide s arrs env env' -> Maybe (Val env', [Doc Keyword])
forall arrs' env''.
LeftHandSide s arrs' env env'' -> Maybe (Val env'', [Doc Keyword])
collect LeftHandSide s arrs env env'
lhs of
  Maybe (Val env', [Doc Keyword])
Nothing          -> LeftHandSide s arrs env env' -> (Val env', Doc Keyword)
forall arrs' env''.
LeftHandSide s arrs' env env'' -> (Val env'', Doc Keyword)
ppPair LeftHandSide s arrs env env'
lhs
  Just (Val env'
env1, [Doc Keyword]
tup) ->
    case [Doc Keyword]
tup of
      []  -> (Val env'
env1, Doc Keyword
"()")
      [Doc Keyword]
_   -> (Val env'
env1, Bool -> Doc Keyword -> Doc Keyword
forall ann. Bool -> Doc ann -> Doc ann
parensIf Bool
requiresParens (Char -> Doc Keyword
forall ann. Char -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Char
'T' Doc Keyword -> Doc Keyword -> Doc Keyword
forall a. Semigroup a => a -> a -> a
<> Precedence -> Doc Keyword
forall ann. Precedence -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ([Doc Keyword] -> Precedence
forall a. [a] -> Precedence
forall (t :: * -> *) a. Foldable t => t a -> Precedence
length [Doc Keyword]
tup) Doc Keyword -> Doc Keyword -> Doc Keyword
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc Keyword -> Doc Keyword
forall ann. Doc ann -> Doc ann
align ([Doc Keyword] -> Doc Keyword
forall ann. [Doc ann] -> Doc ann
sep [Doc Keyword]
tup)))
  where
    ppPair :: LeftHandSide s arrs' env env'' -> (Val env'', Adoc)
    ppPair :: forall arrs' env''.
LeftHandSide s arrs' env env'' -> (Val env'', Doc Keyword)
ppPair LeftHandSide s arrs' env env''
LeftHandSideUnit       = (Val env
Val env''
env0, Doc Keyword
"()")
    ppPair LeftHandSideWildcard{} = (Val env
Val env''
env0, Doc Keyword
"_")
    ppPair LeftHandSideSingle{}   = (Val env
env0 Val env -> Doc Keyword -> Val (env, arrs')
forall env t. Val env -> Doc Keyword -> Val (env, t)
`Push` Doc Keyword
v, Doc Keyword
v)
      where
        v :: Doc Keyword
v = Char -> Doc Keyword
forall ann. Char -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Char
x Doc Keyword -> Doc Keyword -> Doc Keyword
forall a. Semigroup a => a -> a -> a
<> Precedence -> Doc Keyword
forall ann. Precedence -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Val env -> Precedence
forall env. Val env -> Precedence
sizeEnv Val env
env0)
    ppPair (LeftHandSidePair LeftHandSide s v1 env env'1
a LeftHandSide s v2 env'1 env''
b)          = (Val env''
env2, [Doc Keyword] -> Doc Keyword
forall ann. [Doc ann] -> Doc ann
tupled [Doc Keyword
doc1, Doc Keyword
doc2])
      where
        (Val env'1
env1, Doc Keyword
doc1) = LeftHandSide s v1 env env'1 -> (Val env'1, Doc Keyword)
forall arrs' env''.
LeftHandSide s arrs' env env'' -> (Val env'', Doc Keyword)
ppPair LeftHandSide s v1 env env'1
a
        (Val env''
env2, Doc Keyword
doc2) = Bool
-> Char
-> Val env'1
-> LeftHandSide s v2 env'1 env''
-> (Val env'', Doc Keyword)
forall (s :: * -> *) env env' arrs.
Bool
-> Char
-> Val env
-> LeftHandSide s arrs env env'
-> (Val env', Doc Keyword)
prettyLhs Bool
False Char
x Val env'1
env1 LeftHandSide s v2 env'1 env''
b

    collect :: LeftHandSide s arrs' env env'' -> Maybe (Val env'', [Adoc])
    collect :: forall arrs' env''.
LeftHandSide s arrs' env env'' -> Maybe (Val env'', [Doc Keyword])
collect (LeftHandSidePair LeftHandSide s v1 env env'1
l1 LeftHandSide s v2 env'1 env''
l2)
      | Just (Val env'1
env1, [Doc Keyword]
tup ) <- LeftHandSide s v1 env env'1 -> Maybe (Val env'1, [Doc Keyword])
forall arrs' env''.
LeftHandSide s arrs' env env'' -> Maybe (Val env'', [Doc Keyword])
collect LeftHandSide s v1 env env'1
l1
      ,      (Val env''
env2, Doc Keyword
doc2) <- Bool
-> Char
-> Val env'1
-> LeftHandSide s v2 env'1 env''
-> (Val env'', Doc Keyword)
forall (s :: * -> *) env env' arrs.
Bool
-> Char
-> Val env
-> LeftHandSide s arrs env env'
-> (Val env', Doc Keyword)
prettyLhs Bool
True Char
x Val env'1
env1 LeftHandSide s v2 env'1 env''
l2 = (Val env'', [Doc Keyword]) -> Maybe (Val env'', [Doc Keyword])
forall a. a -> Maybe a
Just (Val env''
env2, [Doc Keyword]
tup [Doc Keyword] -> [Doc Keyword] -> [Doc Keyword]
forall a. [a] -> [a] -> [a]
++ [Doc Keyword
doc2])
    collect (LeftHandSideWildcard TupR s arrs'
TupRunit) = (Val env'', [Doc Keyword]) -> Maybe (Val env'', [Doc Keyword])
forall a. a -> Maybe a
Just (Val env
Val env''
env0, [])
    collect LeftHandSide s arrs' env env''
_ = Maybe (Val env'', [Doc Keyword])
forall a. Maybe a
Nothing

prettyArray :: ArrayR (Array sh e) -> Array sh e -> Adoc
prettyArray :: forall sh e. ArrayR (Array sh e) -> Array sh e -> Doc Keyword
prettyArray aR :: ArrayR (Array sh e)
aR@(ArrayR ShapeR sh
_ TypeR e
eR) = Doc Keyword -> Doc Keyword
forall ann. Doc ann -> Doc ann
parens (Doc Keyword -> Doc Keyword)
-> (Array sh e -> Doc Keyword) -> Array sh e -> Doc Keyword
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc Keyword
forall a. IsString a => String -> a
fromString (String -> Doc Keyword)
-> (Array sh e -> String) -> Array sh e -> Doc Keyword
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e -> ShowS) -> ArrayR (Array sh e) -> Array sh e -> String
forall e sh.
(e -> ShowS) -> ArrayR (Array sh e) -> Array sh e -> String
showArray (TypeR e -> e -> ShowS
forall e. TypeR e -> e -> ShowS
showsElt TypeR e
TypeR e
eR) ArrayR (Array sh e)
aR


-- Scalar expressions
-- ------------------

prettyFun :: Val aenv -> Fun aenv f -> Adoc
prettyFun :: forall aenv f. Val aenv -> Fun aenv f -> Doc Keyword
prettyFun = Val () -> Val aenv -> OpenFun () aenv f -> Doc Keyword
forall env aenv f.
Val env -> Val aenv -> OpenFun env aenv f -> Doc Keyword
prettyOpenFun Val ()
Empty

prettyExp :: Val aenv -> Exp aenv t -> Adoc
prettyExp :: forall aenv t. Val aenv -> Exp aenv t -> Doc Keyword
prettyExp = Context -> Val () -> Val aenv -> OpenExp () aenv t -> Doc Keyword
forall env aenv t.
Context -> Val env -> Val aenv -> OpenExp env aenv t -> Doc Keyword
prettyOpenExp Context
context0 Val ()
Empty

prettyOpenFun
    :: forall env aenv f.
       Val env
    -> Val aenv
    -> OpenFun env aenv f
    -> Adoc
prettyOpenFun :: forall env aenv f.
Val env -> Val aenv -> OpenFun env aenv f -> Doc Keyword
prettyOpenFun Val env
env0 Val aenv
aenv = Doc Keyword -> Val env -> OpenFun env aenv f -> Doc Keyword
forall env' f'.
Doc Keyword -> Val env' -> OpenFun env' aenv f' -> Doc Keyword
next (Char -> Doc Keyword
forall ann. Char -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Char
'\\') Val env
env0
  where
    next :: Adoc -> Val env' -> OpenFun env' aenv f' -> Adoc
    next :: forall env' f'.
Doc Keyword -> Val env' -> OpenFun env' aenv f' -> Doc Keyword
next Doc Keyword
vs Val env'
env (Body OpenExp env' aenv f'
body)
      --   PrimApp f x                             <- body
      -- , op                                      <- primOperator f
      -- , isInfix op
      -- , Tuple (NilTup `SnocTup` a `SnocTup` b)  <- x
      -- , Var (SuccIdx ZeroIdx)                   <- a
      -- , Var ZeroIdx                             <- b
      -- = opName op -- surrounding context will add parens
      --
      = Precedence -> Doc Keyword -> Doc Keyword
forall ann. Precedence -> Doc ann -> Doc ann
hang Precedence
shiftwidth ([Doc Keyword] -> Doc Keyword
forall ann. [Doc ann] -> Doc ann
sep [ Doc Keyword
vs Doc Keyword -> Doc Keyword -> Doc Keyword
forall a. Semigroup a => a -> a -> a
<> Doc Keyword
"->"
                             , Context
-> Val env' -> Val aenv -> OpenExp env' aenv f' -> Doc Keyword
forall env aenv t.
Context -> Val env -> Val aenv -> OpenExp env aenv t -> Doc Keyword
prettyOpenExp Context
context0 Val env'
env Val aenv
aenv OpenExp env' aenv f'
body])
    next Doc Keyword
vs Val env'
env (Lam ELeftHandSide a env' env'
lhs OpenFun env' aenv t1
lam) =
      let (Val env'
env', Doc Keyword
lhs') = Bool
-> Val env' -> ELeftHandSide a env' env' -> (Val env', Doc Keyword)
forall env (s :: * -> *) arrs env'.
Bool
-> Val env
-> LeftHandSide s arrs env env'
-> (Val env', Doc Keyword)
prettyELhs Bool
True Val env'
env ELeftHandSide a env' env'
lhs
      in  Doc Keyword -> Val env' -> OpenFun env' aenv t1 -> Doc Keyword
forall env' f'.
Doc Keyword -> Val env' -> OpenFun env' aenv f' -> Doc Keyword
next (Doc Keyword
vs Doc Keyword -> Doc Keyword -> Doc Keyword
forall a. Semigroup a => a -> a -> a
<> Doc Keyword
lhs' Doc Keyword -> Doc Keyword -> Doc Keyword
forall a. Semigroup a => a -> a -> a
<> Doc Keyword
forall ann. Doc ann
space) Val env'
env' OpenFun env' aenv t1
lam

prettyOpenExp
    :: forall env aenv t.
       Context
    -> Val env
    -> Val aenv
    -> OpenExp env aenv t
    -> Adoc
prettyOpenExp :: forall env aenv t.
Context -> Val env -> Val aenv -> OpenExp env aenv t -> Doc Keyword
prettyOpenExp Context
ctx Val env
env Val aenv
aenv OpenExp env aenv t
exp =
  case OpenExp env aenv t
exp of
    Evar (Var ScalarType t
_ Idx env t
idx)      -> Idx env t -> Val env -> Doc Keyword
forall env t. Idx env t -> Val env -> Doc Keyword
prj Idx env t
idx Val env
env
    Let{}                 -> Context -> Val env -> Val aenv -> OpenExp env aenv t -> Doc Keyword
forall env aenv t.
Context -> Val env -> Val aenv -> OpenExp env aenv t -> Doc Keyword
prettyLet Context
ctx Val env
env Val aenv
aenv OpenExp env aenv t
exp
    PrimApp PrimFun (a -> t)
f OpenExp env aenv a
x
      | OpenExp env aenv t1
a `Pair` OpenExp env aenv t2
b <- OpenExp env aenv a
x   -> Operator
-> (Context -> Doc Keyword)
-> (Context -> Doc Keyword)
-> Doc Keyword
ppF2 Operator
op  (OpenExp env aenv t1 -> Context -> Doc Keyword
forall e. OpenExp env aenv e -> Context -> Doc Keyword
ppE OpenExp env aenv t1
a) (OpenExp env aenv t2 -> Context -> Doc Keyword
forall e. OpenExp env aenv e -> Context -> Doc Keyword
ppE OpenExp env aenv t2
b)
      | Bool
otherwise         -> Operator -> (Context -> Doc Keyword) -> Doc Keyword
ppF1 Operator
op' (OpenExp env aenv a -> Context -> Doc Keyword
forall e. OpenExp env aenv e -> Context -> Doc Keyword
ppE OpenExp env aenv a
x)
      where
        op :: Operator
op  = PrimFun (a -> t) -> Operator
forall a. PrimFun a -> Operator
primOperator PrimFun (a -> t)
f
        op' :: Operator
op' = Operator -> Bool
isInfix Operator
op Bool -> (Operator, Operator) -> Operator
forall a. Bool -> (a, a) -> a
? (Doc Keyword -> Fixity -> Associativity -> Precedence -> Operator
Operator (Doc Keyword -> Doc Keyword
forall ann. Doc ann -> Doc ann
parens (Operator -> Doc Keyword
opName Operator
op)) Fixity
App Associativity
L Precedence
10, Operator
op)
    --
    PrimConst PrimConst t
c           -> PrimConst t -> Doc Keyword
forall a. PrimConst a -> Doc Keyword
prettyPrimConst PrimConst t
c
    Const ScalarType t
tp t
c            -> TypeR t -> t -> Doc Keyword
forall e. TypeR e -> e -> Doc Keyword
prettyConst (ScalarType t -> TypeR t
forall (s :: * -> *) a. s a -> TupR s a
TupRsingle ScalarType t
tp) t
c
    Pair{}                -> Context -> Val env -> Val aenv -> OpenExp env aenv t -> Doc Keyword
forall env aenv t.
Context -> Val env -> Val aenv -> OpenExp env aenv t -> Doc Keyword
prettyTuple Context
ctx Val env
env Val aenv
aenv OpenExp env aenv t
exp
    OpenExp env aenv t
Nil                   -> Doc Keyword
"()"
    VecPack   VecR n s tup
_ OpenExp env aenv tup
e         -> Operator -> (Context -> Doc Keyword) -> Doc Keyword
ppF1 Operator
"pack"   (OpenExp env aenv tup -> Context -> Doc Keyword
forall e. OpenExp env aenv e -> Context -> Doc Keyword
ppE OpenExp env aenv tup
e)
    VecUnpack VecR n s t
_ OpenExp env aenv (Vec n s)
e         -> Operator -> (Context -> Doc Keyword) -> Doc Keyword
ppF1 Operator
"unpack" (OpenExp env aenv (Vec n s) -> Context -> Doc Keyword
forall e. OpenExp env aenv e -> Context -> Doc Keyword
ppE OpenExp env aenv (Vec n s)
e)
    Case OpenExp env aenv PrimBool
x [(PrimBool, OpenExp env aenv t)]
xs Maybe (OpenExp env aenv t)
d           -> Val env
-> Val aenv
-> OpenExp env aenv PrimBool
-> [(PrimBool, OpenExp env aenv t)]
-> Maybe (OpenExp env aenv t)
-> Doc Keyword
forall env aenv a b.
Val env
-> Val aenv
-> OpenExp env aenv a
-> [(PrimBool, OpenExp env aenv b)]
-> Maybe (OpenExp env aenv b)
-> Doc Keyword
prettyCase Val env
env Val aenv
aenv OpenExp env aenv PrimBool
x [(PrimBool, OpenExp env aenv t)]
xs Maybe (OpenExp env aenv t)
d
    Cond OpenExp env aenv PrimBool
p OpenExp env aenv t
t OpenExp env aenv t
e            -> Doc Keyword -> Doc Keyword -> Doc Keyword
forall ann. Doc ann -> Doc ann -> Doc ann
flatAlt Doc Keyword
multi Doc Keyword
single
      where
        p' :: Doc Keyword
p' = OpenExp env aenv PrimBool -> Context -> Doc Keyword
forall e. OpenExp env aenv e -> Context -> Doc Keyword
ppE OpenExp env aenv PrimBool
p Context
context0
        t' :: Doc Keyword
t' = OpenExp env aenv t -> Context -> Doc Keyword
forall e. OpenExp env aenv e -> Context -> Doc Keyword
ppE OpenExp env aenv t
t Context
context0
        e' :: Doc Keyword
e' = OpenExp env aenv t -> Context -> Doc Keyword
forall e. OpenExp env aenv e -> Context -> Doc Keyword
ppE OpenExp env aenv t
e Context
context0
        --
        single :: Doc Keyword
single = Bool -> Doc Keyword -> Doc Keyword
forall ann. Bool -> Doc ann -> Doc ann
parensIf (Context -> Operator -> Bool
needsParens Context
ctx (Doc Keyword -> Fixity -> Associativity -> Precedence -> Operator
Operator Doc Keyword
"?:" Fixity
Infix Associativity
N Precedence
0))
               (Doc Keyword -> Doc Keyword) -> Doc Keyword -> Doc Keyword
forall a b. (a -> b) -> a -> b
$ [Doc Keyword] -> Doc Keyword
forall ann. [Doc ann] -> Doc ann
sep [ Doc Keyword
p', Char -> Doc Keyword
forall ann. Char -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Char
'?', Doc Keyword
t', Char -> Doc Keyword
forall ann. Char -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Char
':', Doc Keyword
e' ]
        multi :: Doc Keyword
multi  = Precedence -> Doc Keyword -> Doc Keyword
forall ann. Precedence -> Doc ann -> Doc ann
hang Precedence
3
               (Doc Keyword -> Doc Keyword) -> Doc Keyword -> Doc Keyword
forall a b. (a -> b) -> a -> b
$ [Doc Keyword] -> Doc Keyword
forall ann. [Doc ann] -> Doc ann
vsep [ Doc Keyword
if_ Doc Keyword -> Doc Keyword -> Doc Keyword
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc Keyword
p'
                      , Precedence -> Doc Keyword -> Doc Keyword
forall ann. Precedence -> Doc ann -> Doc ann
hang Precedence
shiftwidth ([Doc Keyword] -> Doc Keyword
forall ann. [Doc ann] -> Doc ann
sep [ Doc Keyword
then_, Doc Keyword
t' ])
                      , Precedence -> Doc Keyword -> Doc Keyword
forall ann. Precedence -> Doc ann -> Doc ann
hang Precedence
shiftwidth ([Doc Keyword] -> Doc Keyword
forall ann. [Doc ann] -> Doc ann
sep [ Doc Keyword
else_, Doc Keyword
e' ]) ]
    --
    IndexSlice SliceIndex slix t co sh
_ OpenExp env aenv slix
slix OpenExp env aenv sh
sh  -> Operator
-> (Context -> Doc Keyword)
-> (Context -> Doc Keyword)
-> Doc Keyword
ppF2 Operator
"indexSlice"  (OpenExp env aenv slix -> Context -> Doc Keyword
forall e. OpenExp env aenv e -> Context -> Doc Keyword
ppE OpenExp env aenv slix
slix) (OpenExp env aenv sh -> Context -> Doc Keyword
forall e. OpenExp env aenv e -> Context -> Doc Keyword
ppE OpenExp env aenv sh
sh)
    IndexFull SliceIndex slix sl co t
_ OpenExp env aenv slix
slix OpenExp env aenv sl
sl   -> Operator
-> (Context -> Doc Keyword)
-> (Context -> Doc Keyword)
-> Doc Keyword
ppF2 Operator
"indexFull"   (OpenExp env aenv slix -> Context -> Doc Keyword
forall e. OpenExp env aenv e -> Context -> Doc Keyword
ppE OpenExp env aenv slix
slix) (OpenExp env aenv sl -> Context -> Doc Keyword
forall e. OpenExp env aenv e -> Context -> Doc Keyword
ppE OpenExp env aenv sl
sl)
    ToIndex ShapeR sh
_ OpenExp env aenv sh
sh OpenExp env aenv sh
ix       -> Operator
-> (Context -> Doc Keyword)
-> (Context -> Doc Keyword)
-> Doc Keyword
ppF2 Operator
"toIndex"     (OpenExp env aenv sh -> Context -> Doc Keyword
forall e. OpenExp env aenv e -> Context -> Doc Keyword
ppE OpenExp env aenv sh
sh) (OpenExp env aenv sh -> Context -> Doc Keyword
forall e. OpenExp env aenv e -> Context -> Doc Keyword
ppE OpenExp env aenv sh
ix)
    FromIndex ShapeR t
_ OpenExp env aenv t
sh OpenExp env aenv Precedence
ix     -> Operator
-> (Context -> Doc Keyword)
-> (Context -> Doc Keyword)
-> Doc Keyword
ppF2 Operator
"fromIndex"   (OpenExp env aenv t -> Context -> Doc Keyword
forall e. OpenExp env aenv e -> Context -> Doc Keyword
ppE OpenExp env aenv t
sh) (OpenExp env aenv Precedence -> Context -> Doc Keyword
forall e. OpenExp env aenv e -> Context -> Doc Keyword
ppE OpenExp env aenv Precedence
ix)
    While OpenFun env aenv (t -> PrimBool)
p OpenFun env aenv (t -> t)
f OpenExp env aenv t
x           -> Operator
-> (Context -> Doc Keyword)
-> (Context -> Doc Keyword)
-> (Context -> Doc Keyword)
-> Doc Keyword
ppF3 Operator
"while"       (OpenFun env aenv (t -> PrimBool) -> Context -> Doc Keyword
forall f. OpenFun env aenv f -> Context -> Doc Keyword
ppF OpenFun env aenv (t -> PrimBool)
p) (OpenFun env aenv (t -> t) -> Context -> Doc Keyword
forall f. OpenFun env aenv f -> Context -> Doc Keyword
ppF OpenFun env aenv (t -> t)
f) (OpenExp env aenv t -> Context -> Doc Keyword
forall e. OpenExp env aenv e -> Context -> Doc Keyword
ppE OpenExp env aenv t
x)
    Foreign TypeR t
_ asm (x -> t)
ff Fun () (x -> t)
_ OpenExp env aenv x
e      -> Operator
-> (Context -> Doc Keyword)
-> (Context -> Doc Keyword)
-> Doc Keyword
ppF2 Operator
"foreign"     (\Context
_ -> String -> Doc Keyword
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (asm (x -> t) -> String
forall args. asm args -> String
forall (asm :: * -> *) args. Foreign asm => asm args -> String
strForeign asm (x -> t)
ff)) (OpenExp env aenv x -> Context -> Doc Keyword
forall e. OpenExp env aenv e -> Context -> Doc Keyword
ppE OpenExp env aenv x
e)
    Shape ArrayVar aenv (Array t e)
arr             -> Operator -> (Context -> Doc Keyword) -> Doc Keyword
ppF1 Operator
"shape"       (ArrayVar aenv (Array t e) -> Context -> Doc Keyword
forall a. ArrayVar aenv a -> Context -> Doc Keyword
ppA ArrayVar aenv (Array t e)
arr)
    ShapeSize ShapeR dim
_ OpenExp env aenv dim
sh        -> Operator -> (Context -> Doc Keyword) -> Doc Keyword
ppF1 Operator
"shapeSize"   (OpenExp env aenv dim -> Context -> Doc Keyword
forall e. OpenExp env aenv e -> Context -> Doc Keyword
ppE OpenExp env aenv dim
sh)
    Index ArrayVar aenv (Array dim t)
arr OpenExp env aenv dim
ix          -> Operator
-> (Context -> Doc Keyword)
-> (Context -> Doc Keyword)
-> Doc Keyword
ppF2 (Doc Keyword -> Fixity -> Associativity -> Precedence -> Operator
Operator (Char -> Doc Keyword
forall ann. Char -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Char
'!') Fixity
Infix Associativity
L Precedence
9) (ArrayVar aenv (Array dim t) -> Context -> Doc Keyword
forall a. ArrayVar aenv a -> Context -> Doc Keyword
ppA ArrayVar aenv (Array dim t)
arr) (OpenExp env aenv dim -> Context -> Doc Keyword
forall e. OpenExp env aenv e -> Context -> Doc Keyword
ppE OpenExp env aenv dim
ix)
    LinearIndex ArrayVar aenv (Array dim t)
arr OpenExp env aenv Precedence
ix    -> Operator
-> (Context -> Doc Keyword)
-> (Context -> Doc Keyword)
-> Doc Keyword
ppF2 (Doc Keyword -> Fixity -> Associativity -> Precedence -> Operator
Operator Doc Keyword
"!!"         Fixity
Infix Associativity
L Precedence
9) (ArrayVar aenv (Array dim t) -> Context -> Doc Keyword
forall a. ArrayVar aenv a -> Context -> Doc Keyword
ppA ArrayVar aenv (Array dim t)
arr) (OpenExp env aenv Precedence -> Context -> Doc Keyword
forall e. OpenExp env aenv e -> Context -> Doc Keyword
ppE OpenExp env aenv Precedence
ix)
    Coerce ScalarType a
_ ScalarType t
tp OpenExp env aenv a
x         -> Operator -> (Context -> Doc Keyword) -> Doc Keyword
ppF1 (Doc Keyword -> Fixity -> Associativity -> Precedence -> Operator
Operator (ScalarType t -> Doc Keyword -> Doc Keyword
withTypeRep ScalarType t
tp Doc Keyword
"coerce") Fixity
App Associativity
L Precedence
10) (OpenExp env aenv a -> Context -> Doc Keyword
forall e. OpenExp env aenv e -> Context -> Doc Keyword
ppE OpenExp env aenv a
x)
    Undef ScalarType t
tp              -> ScalarType t -> Doc Keyword -> Doc Keyword
withTypeRep ScalarType t
tp Doc Keyword
"undef"

  where
    ppE :: OpenExp env aenv e -> Context -> Adoc
    ppE :: forall e. OpenExp env aenv e -> Context -> Doc Keyword
ppE OpenExp env aenv e
e Context
c = Context -> Val env -> Val aenv -> OpenExp env aenv e -> Doc Keyword
forall env aenv t.
Context -> Val env -> Val aenv -> OpenExp env aenv t -> Doc Keyword
prettyOpenExp Context
c Val env
env Val aenv
aenv OpenExp env aenv e
e

    ppA :: ArrayVar aenv a -> Context -> Adoc
    ppA :: forall a. ArrayVar aenv a -> Context -> Doc Keyword
ppA ArrayVar aenv a
acc Context
_ = Val aenv -> ArrayVar aenv a -> Doc Keyword
forall aenv a. Val aenv -> ArrayVar aenv a -> Doc Keyword
prettyArrayVar Val aenv
aenv ArrayVar aenv a
acc

    ppF :: OpenFun env aenv f -> Context -> Adoc
    ppF :: forall f. OpenFun env aenv f -> Context -> Doc Keyword
ppF OpenFun env aenv f
f Context
_ = Doc Keyword -> Doc Keyword
forall ann. Doc ann -> Doc ann
parens (Doc Keyword -> Doc Keyword) -> Doc Keyword -> Doc Keyword
forall a b. (a -> b) -> a -> b
$ Val env -> Val aenv -> OpenFun env aenv f -> Doc Keyword
forall env aenv f.
Val env -> Val aenv -> OpenFun env aenv f -> Doc Keyword
prettyOpenFun Val env
env Val aenv
aenv OpenFun env aenv f
f

    ppF1 :: Operator -> (Context -> Adoc) -> Adoc
    ppF1 :: Operator -> (Context -> Doc Keyword) -> Doc Keyword
ppF1 Operator
op Context -> Doc Keyword
x
      = Bool -> Doc Keyword -> Doc Keyword
forall ann. Bool -> Doc ann -> Doc ann
parensIf (Context -> Operator -> Bool
needsParens Context
ctx Operator
op)
      (Doc Keyword -> Doc Keyword) -> Doc Keyword -> Doc Keyword
forall a b. (a -> b) -> a -> b
$ [Doc Keyword] -> Doc Keyword
combine [ Operator -> Doc Keyword
opName Operator
op, Context -> Doc Keyword
x Context
ctx' ]
      where
        ctx' :: Context
ctx'    = Operator -> Bool
isPrefix Operator
op Bool -> (Context, Context) -> Context
forall a. Bool -> (a, a) -> a
? (Operator -> Associativity -> Context
arg Operator
op Associativity
R, Context
app)
        combine :: [Doc Keyword] -> Doc Keyword
combine = Operator -> Bool
isPrefix Operator
op Bool
-> ([Doc Keyword] -> Doc Keyword, [Doc Keyword] -> Doc Keyword)
-> [Doc Keyword]
-> Doc Keyword
forall a. Bool -> (a, a) -> a
? ([Doc Keyword] -> Doc Keyword
forall ann. [Doc ann] -> Doc ann
cat, Precedence -> Doc Keyword -> Doc Keyword
forall ann. Precedence -> Doc ann -> Doc ann
hang Precedence
2 (Doc Keyword -> Doc Keyword)
-> ([Doc Keyword] -> Doc Keyword) -> [Doc Keyword] -> Doc Keyword
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc Keyword] -> Doc Keyword
forall ann. [Doc ann] -> Doc ann
sep)

    ppF2 :: Operator -> (Context -> Adoc) -> (Context -> Adoc) -> Adoc
    ppF2 :: Operator
-> (Context -> Doc Keyword)
-> (Context -> Doc Keyword)
-> Doc Keyword
ppF2 Operator
op Context -> Doc Keyword
x Context -> Doc Keyword
y
      = Bool -> Doc Keyword -> Doc Keyword
forall ann. Bool -> Doc ann -> Doc ann
parensIf (Context -> Operator -> Bool
needsParens Context
ctx Operator
op)
      (Doc Keyword -> Doc Keyword) -> Doc Keyword -> Doc Keyword
forall a b. (a -> b) -> a -> b
$ if Operator -> Bool
isInfix Operator
op
          then [Doc Keyword] -> Doc Keyword
forall ann. [Doc ann] -> Doc ann
sep [ Context -> Doc Keyword
x (Operator -> Associativity -> Context
arg Operator
op Associativity
L), Doc Keyword -> Doc Keyword
forall ann. Doc ann -> Doc ann
group ([Doc Keyword] -> Doc Keyword
forall ann. [Doc ann] -> Doc ann
sep [Operator -> Doc Keyword
opName Operator
op, Context -> Doc Keyword
y (Operator -> Associativity -> Context
arg Operator
op Associativity
R)]) ]
          else Precedence -> Doc Keyword -> Doc Keyword
forall ann. Precedence -> Doc ann -> Doc ann
hang Precedence
2 (Doc Keyword -> Doc Keyword) -> Doc Keyword -> Doc Keyword
forall a b. (a -> b) -> a -> b
$ [Doc Keyword] -> Doc Keyword
forall ann. [Doc ann] -> Doc ann
sep [ Operator -> Doc Keyword
opName Operator
op, Context -> Doc Keyword
x Context
app, Context -> Doc Keyword
y Context
app ]

    ppF3 :: Operator -> (Context -> Adoc) -> (Context -> Adoc) -> (Context -> Adoc) -> Adoc
    ppF3 :: Operator
-> (Context -> Doc Keyword)
-> (Context -> Doc Keyword)
-> (Context -> Doc Keyword)
-> Doc Keyword
ppF3 Operator
op Context -> Doc Keyword
x Context -> Doc Keyword
y Context -> Doc Keyword
z
      = Bool -> Doc Keyword -> Doc Keyword
forall ann. Bool -> Doc ann -> Doc ann
parensIf (Context -> Operator -> Bool
needsParens Context
ctx Operator
op)
      (Doc Keyword -> Doc Keyword) -> Doc Keyword -> Doc Keyword
forall a b. (a -> b) -> a -> b
$ Precedence -> Doc Keyword -> Doc Keyword
forall ann. Precedence -> Doc ann -> Doc ann
hang Precedence
2
      (Doc Keyword -> Doc Keyword) -> Doc Keyword -> Doc Keyword
forall a b. (a -> b) -> a -> b
$ [Doc Keyword] -> Doc Keyword
forall ann. [Doc ann] -> Doc ann
sep [ Operator -> Doc Keyword
opName Operator
op, Context -> Doc Keyword
x Context
app, Context -> Doc Keyword
y Context
app, Context -> Doc Keyword
z Context
app ]

    withTypeRep :: ScalarType t -> Adoc -> Adoc
    withTypeRep :: ScalarType t -> Doc Keyword -> Doc Keyword
withTypeRep ScalarType t
t Doc Keyword
op = Doc Keyword
op Doc Keyword -> Doc Keyword -> Doc Keyword
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc Keyword
"@" Doc Keyword -> Doc Keyword -> Doc Keyword
forall a. Semigroup a => a -> a -> a
<> String -> Doc Keyword
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (ScalarType t -> String
forall a. Show a => a -> String
show ScalarType t
t)

prettyArrayVar
    :: forall aenv a.
       Val aenv
    -> ArrayVar aenv a
    -> Adoc
prettyArrayVar :: forall aenv a. Val aenv -> ArrayVar aenv a -> Doc Keyword
prettyArrayVar Val aenv
aenv (Var ArrayR a
_ Idx aenv a
idx) = Idx aenv a -> Val aenv -> Doc Keyword
forall env t. Idx env t -> Val env -> Doc Keyword
prj Idx aenv a
idx Val aenv
aenv

prettyLet
    :: forall env aenv t.
       Context
    -> Val env
    -> Val aenv
    -> OpenExp env aenv t
    -> Adoc
prettyLet :: forall env aenv t.
Context -> Val env -> Val aenv -> OpenExp env aenv t -> Doc Keyword
prettyLet Context
ctx Val env
env0 Val aenv
aenv
  = Bool -> Doc Keyword -> Doc Keyword
forall ann. Bool -> Doc ann -> Doc ann
parensIf (Context -> Precedence
ctxPrecedence Context
ctx Precedence -> Precedence -> Bool
forall a. Ord a => a -> a -> Bool
> Precedence
0)
  (Doc Keyword -> Doc Keyword)
-> (OpenExp env aenv t -> Doc Keyword)
-> OpenExp env aenv t
-> Doc Keyword
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Keyword -> Doc Keyword
forall ann. Doc ann -> Doc ann
align (Doc Keyword -> Doc Keyword)
-> (OpenExp env aenv t -> Doc Keyword)
-> OpenExp env aenv t
-> Doc Keyword
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Doc Keyword], Doc Keyword) -> Doc Keyword
wrap (([Doc Keyword], Doc Keyword) -> Doc Keyword)
-> (OpenExp env aenv t -> ([Doc Keyword], Doc Keyword))
-> OpenExp env aenv t
-> Doc Keyword
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Val env -> OpenExp env aenv t -> ([Doc Keyword], Doc Keyword)
forall env' e.
Val env' -> OpenExp env' aenv e -> ([Doc Keyword], Doc Keyword)
collect Val env
env0
  where
    collect :: Val env' -> OpenExp env' aenv e -> ([Adoc], Adoc)
    collect :: forall env' e.
Val env' -> OpenExp env' aenv e -> ([Doc Keyword], Doc Keyword)
collect Val env'
env =
      \case
        Let ELeftHandSide bnd_t env' env'
lhs OpenExp env' aenv bnd_t
e1 OpenExp env' aenv e
e2 ->
          let (Val env'
env', Doc Keyword
v)       = Bool
-> Val env'
-> ELeftHandSide bnd_t env' env'
-> (Val env', Doc Keyword)
forall env (s :: * -> *) arrs env'.
Bool
-> Val env
-> LeftHandSide s arrs env env'
-> (Val env', Doc Keyword)
prettyELhs Bool
False Val env'
env ELeftHandSide bnd_t env' env'
lhs
              e1' :: Doc Keyword
e1'             = Val env' -> OpenExp env' aenv bnd_t -> Doc Keyword
forall env' t'. Val env' -> OpenExp env' aenv t' -> Doc Keyword
ppE Val env'
env OpenExp env' aenv bnd_t
e1
              bnd :: Doc Keyword
bnd | OpenExp env' aenv bnd_t -> Bool
forall env' t'. OpenExp env' aenv t' -> Bool
isLet OpenExp env' aenv bnd_t
e1  = Precedence -> Doc Keyword -> Doc Keyword
forall ann. Precedence -> Doc ann -> Doc ann
nest Precedence
shiftwidth ([Doc Keyword] -> Doc Keyword
forall ann. [Doc ann] -> Doc ann
vsep [Doc Keyword
v Doc Keyword -> Doc Keyword -> Doc Keyword
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc Keyword
forall ann. Doc ann
equals, Doc Keyword
e1'])
                  | Bool
otherwise = Doc Keyword
v Doc Keyword -> Doc Keyword -> Doc Keyword
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc Keyword -> Doc Keyword
forall ann. Doc ann -> Doc ann
align (Doc Keyword
forall ann. Doc ann
equals Doc Keyword -> Doc Keyword -> Doc Keyword
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc Keyword
e1')
              ([Doc Keyword]
bnds, Doc Keyword
body)    = Val env' -> OpenExp env' aenv e -> ([Doc Keyword], Doc Keyword)
forall env' e.
Val env' -> OpenExp env' aenv e -> ([Doc Keyword], Doc Keyword)
collect Val env'
env' OpenExp env' aenv e
e2
          in
          (Doc Keyword
bndDoc Keyword -> [Doc Keyword] -> [Doc Keyword]
forall a. a -> [a] -> [a]
:[Doc Keyword]
bnds, Doc Keyword
body)
        --
        OpenExp env' aenv e
next     -> ([], Val env' -> OpenExp env' aenv e -> Doc Keyword
forall env' t'. Val env' -> OpenExp env' aenv t' -> Doc Keyword
ppE Val env'
env OpenExp env' aenv e
next)

    isLet :: OpenExp env' aenv t' -> Bool
    isLet :: forall env' t'. OpenExp env' aenv t' -> Bool
isLet Let{} = Bool
True
    isLet OpenExp env' aenv t'
_     = Bool
False

    ppE :: Val env' -> OpenExp env' aenv t' -> Adoc
    ppE :: forall env' t'. Val env' -> OpenExp env' aenv t' -> Doc Keyword
ppE Val env'
env = Context
-> Val env' -> Val aenv -> OpenExp env' aenv t' -> Doc Keyword
forall env aenv t.
Context -> Val env -> Val aenv -> OpenExp env aenv t -> Doc Keyword
prettyOpenExp Context
context0 Val env'
env Val aenv
aenv

    wrap :: ([Adoc], Adoc) -> Adoc
    wrap :: ([Doc Keyword], Doc Keyword) -> Doc Keyword
wrap ([],   Doc Keyword
body) = Doc Keyword
body  -- shouldn't happen!
    wrap ([Doc Keyword
b],  Doc Keyword
body)
      = [Doc Keyword] -> Doc Keyword
forall ann. [Doc ann] -> Doc ann
sep [ Precedence -> Doc Keyword -> Doc Keyword
forall ann. Precedence -> Doc ann -> Doc ann
nest Precedence
shiftwidth ([Doc Keyword] -> Doc Keyword
forall ann. [Doc ann] -> Doc ann
sep [Doc Keyword
let_, Doc Keyword
b]), Doc Keyword
in_, Doc Keyword
body ]
    wrap ([Doc Keyword]
bnds, Doc Keyword
body)
      = [Doc Keyword] -> Doc Keyword
forall ann. [Doc ann] -> Doc ann
vsep [ Precedence -> Doc Keyword -> Doc Keyword
forall ann. Precedence -> Doc ann -> Doc ann
nest Precedence
shiftwidth ([Doc Keyword] -> Doc Keyword
forall ann. [Doc ann] -> Doc ann
vsep [Doc Keyword
let_, Doc Keyword -> [Doc Keyword] -> Doc Keyword
sepBy (Doc Keyword -> Doc Keyword -> Doc Keyword
forall ann. Doc ann -> Doc ann -> Doc ann
flatAlt Doc Keyword
"" Doc Keyword
" ; ") [Doc Keyword]
bnds])
             , Doc Keyword
in_
             , Doc Keyword
body
             ]

    sepBy :: Adoc -> [Adoc] -> Adoc
    sepBy :: Doc Keyword -> [Doc Keyword] -> Doc Keyword
sepBy = Doc Keyword
-> Doc Keyword -> Doc Keyword -> [Doc Keyword] -> Doc Keyword
forall ann. Doc ann -> Doc ann -> Doc ann -> [Doc ann] -> Doc ann
encloseSep Doc Keyword
forall a. Monoid a => a
mempty Doc Keyword
forall a. Monoid a => a
mempty

prettyTuple
    :: forall env aenv t.
       Context
    -> Val env
    -> Val aenv
    -> OpenExp env aenv t
    -> Adoc
prettyTuple :: forall env aenv t.
Context -> Val env -> Val aenv -> OpenExp env aenv t -> Doc Keyword
prettyTuple Context
ctx Val env
env Val aenv
aenv OpenExp env aenv t
exp = case OpenExp env aenv t -> Maybe [Doc Keyword]
forall t'. OpenExp env aenv t' -> Maybe [Doc Keyword]
collect OpenExp env aenv t
exp of
    Maybe [Doc Keyword]
Nothing  -> Doc Keyword -> Doc Keyword
forall ann. Doc ann -> Doc ann
align (Doc Keyword -> Doc Keyword) -> Doc Keyword -> Doc Keyword
forall a b. (a -> b) -> a -> b
$ OpenExp env aenv t -> Doc Keyword
forall t'. OpenExp env aenv t' -> Doc Keyword
ppPair OpenExp env aenv t
exp
    Just [Doc Keyword]
tup ->
      case [Doc Keyword]
tup of
        []  -> Doc Keyword
"()"
        [Doc Keyword]
_   -> Doc Keyword -> Doc Keyword
forall ann. Doc ann -> Doc ann
align (Doc Keyword -> Doc Keyword) -> Doc Keyword -> Doc Keyword
forall a b. (a -> b) -> a -> b
$ Bool -> Doc Keyword -> Doc Keyword
forall ann. Bool -> Doc ann -> Doc ann
parensIf (Context -> Precedence
ctxPrecedence Context
ctx Precedence -> Precedence -> Bool
forall a. Ord a => a -> a -> Bool
> Precedence
0) (Doc Keyword
"T" Doc Keyword -> Doc Keyword -> Doc Keyword
forall a. Semigroup a => a -> a -> a
<> Precedence -> Doc Keyword
forall ann. Precedence -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ([Doc Keyword] -> Precedence
forall a. [a] -> Precedence
forall (t :: * -> *) a. Foldable t => t a -> Precedence
length [Doc Keyword]
tup) Doc Keyword -> Doc Keyword -> Doc Keyword
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc Keyword -> Doc Keyword
forall ann. Doc ann -> Doc ann
align ([Doc Keyword] -> Doc Keyword
forall ann. [Doc ann] -> Doc ann
sep [Doc Keyword]
tup))
  where
    ppPair :: OpenExp env aenv t' -> Adoc
    ppPair :: forall t'. OpenExp env aenv t' -> Doc Keyword
ppPair (Pair OpenExp env aenv t1
e1 OpenExp env aenv t2
e2) = Doc Keyword
"(" Doc Keyword -> Doc Keyword -> Doc Keyword
forall a. Semigroup a => a -> a -> a
<> OpenExp env aenv t1 -> Doc Keyword
forall t'. OpenExp env aenv t' -> Doc Keyword
ppPair OpenExp env aenv t1
e1 Doc Keyword -> Doc Keyword -> Doc Keyword
forall a. Semigroup a => a -> a -> a
<> Doc Keyword
"," Doc Keyword -> Doc Keyword -> Doc Keyword
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Context
-> Val env -> Val aenv -> OpenExp env aenv t2 -> Doc Keyword
forall env aenv t.
Context -> Val env -> Val aenv -> OpenExp env aenv t -> Doc Keyword
prettyOpenExp Context
context0 Val env
env Val aenv
aenv OpenExp env aenv t2
e2 Doc Keyword -> Doc Keyword -> Doc Keyword
forall a. Semigroup a => a -> a -> a
<> Doc Keyword
")"
    ppPair OpenExp env aenv t'
e            = Context
-> Val env -> Val aenv -> OpenExp env aenv t' -> Doc Keyword
forall env aenv t.
Context -> Val env -> Val aenv -> OpenExp env aenv t -> Doc Keyword
prettyOpenExp Context
context0 Val env
env Val aenv
aenv OpenExp env aenv t'
e

    collect :: OpenExp env aenv t' -> Maybe [Adoc]
    collect :: forall t'. OpenExp env aenv t' -> Maybe [Doc Keyword]
collect OpenExp env aenv t'
Nil                = [Doc Keyword] -> Maybe [Doc Keyword]
forall a. a -> Maybe a
Just []
    collect (Pair OpenExp env aenv t1
e1 OpenExp env aenv t2
e2)
      | Just [Doc Keyword]
tup <- OpenExp env aenv t1 -> Maybe [Doc Keyword]
forall t'. OpenExp env aenv t' -> Maybe [Doc Keyword]
collect OpenExp env aenv t1
e1 = [Doc Keyword] -> Maybe [Doc Keyword]
forall a. a -> Maybe a
Just ([Doc Keyword] -> Maybe [Doc Keyword])
-> [Doc Keyword] -> Maybe [Doc Keyword]
forall a b. (a -> b) -> a -> b
$ [Doc Keyword]
tup [Doc Keyword] -> [Doc Keyword] -> [Doc Keyword]
forall a. [a] -> [a] -> [a]
++ [Context
-> Val env -> Val aenv -> OpenExp env aenv t2 -> Doc Keyword
forall env aenv t.
Context -> Val env -> Val aenv -> OpenExp env aenv t -> Doc Keyword
prettyOpenExp Context
app Val env
env Val aenv
aenv OpenExp env aenv t2
e2]
    collect OpenExp env aenv t'
_                  = Maybe [Doc Keyword]
forall a. Maybe a
Nothing

prettyCase
    :: Val env
    -> Val aenv
    -> OpenExp env aenv a
    -> [(TAG, OpenExp env aenv b)]
    -> Maybe (OpenExp env aenv b)
    -> Adoc
prettyCase :: forall env aenv a b.
Val env
-> Val aenv
-> OpenExp env aenv a
-> [(PrimBool, OpenExp env aenv b)]
-> Maybe (OpenExp env aenv b)
-> Doc Keyword
prettyCase Val env
env Val aenv
aenv OpenExp env aenv a
x [(PrimBool, OpenExp env aenv b)]
xs Maybe (OpenExp env aenv b)
def
  = Precedence -> Doc Keyword -> Doc Keyword
forall ann. Precedence -> Doc ann -> Doc ann
hang Precedence
shiftwidth
  (Doc Keyword -> Doc Keyword) -> Doc Keyword -> Doc Keyword
forall a b. (a -> b) -> a -> b
$ [Doc Keyword] -> Doc Keyword
forall ann. [Doc ann] -> Doc ann
vsep [ Doc Keyword
case_ Doc Keyword -> Doc Keyword -> Doc Keyword
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc Keyword
x' Doc Keyword -> Doc Keyword -> Doc Keyword
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc Keyword
of_
         , Doc Keyword -> Doc Keyword -> Doc Keyword
forall ann. Doc ann -> Doc ann -> Doc ann
flatAlt ([Doc Keyword] -> Doc Keyword
forall ann. [Doc ann] -> Doc ann
vcat [Doc Keyword]
xs') (Doc Keyword
-> Doc Keyword -> Doc Keyword -> [Doc Keyword] -> Doc Keyword
forall ann. Doc ann -> Doc ann -> Doc ann -> [Doc ann] -> Doc ann
encloseSep Doc Keyword
"{ " Doc Keyword
" }" Doc Keyword
"; " [Doc Keyword]
xs')
         ]
  where
    x' :: Doc Keyword
x'  = Context -> Val env -> Val aenv -> OpenExp env aenv a -> Doc Keyword
forall env aenv t.
Context -> Val env -> Val aenv -> OpenExp env aenv t -> Doc Keyword
prettyOpenExp Context
context0 Val env
env Val aenv
aenv OpenExp env aenv a
x
    xs' :: [Doc Keyword]
xs' = ((PrimBool, OpenExp env aenv b) -> Doc Keyword)
-> [(PrimBool, OpenExp env aenv b)] -> [Doc Keyword]
forall a b. (a -> b) -> [a] -> [b]
map (\(PrimBool
t,OpenExp env aenv b
e) -> PrimBool -> Doc Keyword
forall ann. PrimBool -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty PrimBool
t Doc Keyword -> Doc Keyword -> Doc Keyword
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc Keyword
"->" Doc Keyword -> Doc Keyword -> Doc Keyword
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Context -> Val env -> Val aenv -> OpenExp env aenv b -> Doc Keyword
forall env aenv t.
Context -> Val env -> Val aenv -> OpenExp env aenv t -> Doc Keyword
prettyOpenExp Context
context0 Val env
env Val aenv
aenv OpenExp env aenv b
e) [(PrimBool, OpenExp env aenv b)]
xs
       [Doc Keyword] -> [Doc Keyword] -> [Doc Keyword]
forall a. [a] -> [a] -> [a]
++ case Maybe (OpenExp env aenv b)
def of
            Maybe (OpenExp env aenv b)
Nothing -> []
            Just OpenExp env aenv b
d  -> [Doc Keyword
"_" Doc Keyword -> Doc Keyword -> Doc Keyword
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc Keyword
"->" Doc Keyword -> Doc Keyword -> Doc Keyword
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Context -> Val env -> Val aenv -> OpenExp env aenv b -> Doc Keyword
forall env aenv t.
Context -> Val env -> Val aenv -> OpenExp env aenv t -> Doc Keyword
prettyOpenExp Context
context0 Val env
env Val aenv
aenv OpenExp env aenv b
d]

{-

prettyAtuple
    :: forall acc aenv arrs.
       PrettyAcc acc
    -> ExtractAcc acc
    -> Val aenv
    -> PreOpenAcc acc aenv arrs
    -> Adoc
prettyAtuple prettyAcc extractAcc aenv0 acc = case collect acc of
  Just tup -> align $ "T" <> pretty (length tup) <+> sep tup
  Nothing  -> align $ ppPair acc
  where
    ppPair :: PreOpenAcc acc aenv arrs' -> Adoc
    ppPair (Apair a1 a2) = "(" <> ppPair (extractAcc a1) <> "," <+> prettyAcc context0 aenv0 a2 <> ")"
    ppPair a             = prettyPreOpenAcc context0 prettyAcc extractAcc aenv0 a

    collect :: PreOpenAcc acc aenv arrs' -> Maybe [Adoc]
    collect Anil          = Just []
    collect (Apair a1 a2)
      | Just tup <- collect $ extractAcc a1
                          = Just $ tup ++ [prettyAcc app aenv0 a2]
    collect _             = Nothing
-}

prettyConst :: TypeR e -> e -> Adoc
prettyConst :: forall e. TypeR e -> e -> Doc Keyword
prettyConst TypeR e
tp e
x =
  let y :: String
y = TypeR e -> e -> String
forall e. TypeR e -> e -> String
showElt TypeR e
tp e
x
  in  Bool -> Doc Keyword -> Doc Keyword
forall ann. Bool -> Doc ann -> Doc ann
parensIf ((Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
isSpace String
y) (String -> Doc Keyword
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
y)

prettyPrimConst :: PrimConst a -> Adoc
prettyPrimConst :: forall a. PrimConst a -> Doc Keyword
prettyPrimConst PrimMinBound{} = Doc Keyword
"minBound"
prettyPrimConst PrimMaxBound{} = Doc Keyword
"maxBound"
prettyPrimConst PrimPi{}       = Doc Keyword
"pi"


-- Primitive operators
-- -------------------
--
-- The core of the pretty printer is how to correctly handle precedence,
-- associativity, and fixity of the primitive scalar operators.
--

data Direction = L | N | R
  deriving Associativity -> Associativity -> Bool
(Associativity -> Associativity -> Bool)
-> (Associativity -> Associativity -> Bool) -> Eq Associativity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Associativity -> Associativity -> Bool
== :: Associativity -> Associativity -> Bool
$c/= :: Associativity -> Associativity -> Bool
/= :: Associativity -> Associativity -> Bool
Eq

data Fixity = App | Infix | Prefix
  deriving Fixity -> Fixity -> Bool
(Fixity -> Fixity -> Bool)
-> (Fixity -> Fixity -> Bool) -> Eq Fixity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Fixity -> Fixity -> Bool
== :: Fixity -> Fixity -> Bool
$c/= :: Fixity -> Fixity -> Bool
/= :: Fixity -> Fixity -> Bool
Eq

type Precedence    = Int
type Associativity = Direction

data Context = Context
  { Context -> Associativity
ctxAssociativity  :: Associativity
  , Context -> Associativity
ctxPosition       :: Direction
  , Context -> Precedence
ctxPrecedence     :: Precedence
  }

data Operator = Operator
  { Operator -> Doc Keyword
opName            :: Adoc
  , Operator -> Fixity
opFixity          :: Fixity
  , Operator -> Associativity
opAssociativity   :: Associativity
  , Operator -> Precedence
opPrecedence      :: Precedence
  }

instance IsString Operator where
  fromString :: String -> Operator
fromString String
s = Doc Keyword -> Fixity -> Associativity -> Precedence -> Operator
Operator (String -> Doc Keyword
forall a. IsString a => String -> a
fromString String
s) Fixity
App Associativity
L Precedence
10

needsParens :: Context -> Operator -> Bool
needsParens :: Context -> Operator -> Bool
needsParens Context{Precedence
Associativity
ctxPrecedence :: Context -> Precedence
ctxAssociativity :: Context -> Associativity
ctxPosition :: Context -> Associativity
ctxAssociativity :: Associativity
ctxPosition :: Associativity
ctxPrecedence :: Precedence
..} Operator{Precedence
Doc Keyword
Fixity
Associativity
opName :: Operator -> Doc Keyword
opFixity :: Operator -> Fixity
opAssociativity :: Operator -> Associativity
opPrecedence :: Operator -> Precedence
opName :: Doc Keyword
opFixity :: Fixity
opAssociativity :: Associativity
opPrecedence :: Precedence
..}
  | Precedence
ctxPrecedence     Precedence -> Precedence -> Bool
forall a. Ord a => a -> a -> Bool
< Precedence
opPrecedence    = Bool
False
  | Precedence
ctxPrecedence     Precedence -> Precedence -> Bool
forall a. Ord a => a -> a -> Bool
> Precedence
opPrecedence    = Bool
True
  | Associativity
ctxAssociativity Associativity -> Associativity -> Bool
forall a. Eq a => a -> a -> Bool
/= Associativity
opAssociativity = Bool
True
  | Bool
otherwise                           = Associativity
ctxPosition Associativity -> Associativity -> Bool
forall a. Eq a => a -> a -> Bool
/= Associativity
opAssociativity

context0 :: Context
context0 :: Context
context0 = Associativity -> Associativity -> Precedence -> Context
Context Associativity
N Associativity
N Precedence
0

app :: Context
app :: Context
app = Associativity -> Associativity -> Precedence -> Context
Context Associativity
L Associativity
N Precedence
10

arg :: Operator -> Direction -> Context
arg :: Operator -> Associativity -> Context
arg Operator{Precedence
Doc Keyword
Fixity
Associativity
opName :: Operator -> Doc Keyword
opFixity :: Operator -> Fixity
opAssociativity :: Operator -> Associativity
opPrecedence :: Operator -> Precedence
opName :: Doc Keyword
opFixity :: Fixity
opAssociativity :: Associativity
opPrecedence :: Precedence
..} Associativity
side = Associativity -> Associativity -> Precedence -> Context
Context Associativity
opAssociativity Associativity
side Precedence
opPrecedence

isPrefix :: Operator -> Bool
isPrefix :: Operator -> Bool
isPrefix Operator{Precedence
Doc Keyword
Fixity
Associativity
opName :: Operator -> Doc Keyword
opFixity :: Operator -> Fixity
opAssociativity :: Operator -> Associativity
opPrecedence :: Operator -> Precedence
opName :: Doc Keyword
opFixity :: Fixity
opAssociativity :: Associativity
opPrecedence :: Precedence
..} = Fixity
opFixity Fixity -> Fixity -> Bool
forall a. Eq a => a -> a -> Bool
== Fixity
Prefix

isInfix :: Operator -> Bool
isInfix :: Operator -> Bool
isInfix Operator{Precedence
Doc Keyword
Fixity
Associativity
opName :: Operator -> Doc Keyword
opFixity :: Operator -> Fixity
opAssociativity :: Operator -> Associativity
opPrecedence :: Operator -> Precedence
opName :: Doc Keyword
opFixity :: Fixity
opAssociativity :: Associativity
opPrecedence :: Precedence
..}  = Fixity
opFixity Fixity -> Fixity -> Bool
forall a. Eq a => a -> a -> Bool
== Fixity
Infix

primOperator :: PrimFun a -> Operator
primOperator :: forall a. PrimFun a -> Operator
primOperator PrimAdd{}                = Doc Keyword -> Fixity -> Associativity -> Precedence -> Operator
Operator (Char -> Doc Keyword
forall ann. Char -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Char
'+')         Fixity
Infix  Associativity
L Precedence
6
primOperator PrimSub{}                = Doc Keyword -> Fixity -> Associativity -> Precedence -> Operator
Operator (Char -> Doc Keyword
forall ann. Char -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Char
'-')         Fixity
Infix  Associativity
L Precedence
6
primOperator PrimMul{}                = Doc Keyword -> Fixity -> Associativity -> Precedence -> Operator
Operator (Char -> Doc Keyword
forall ann. Char -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Char
'*')         Fixity
Infix  Associativity
L Precedence
7
primOperator PrimNeg{}                = Doc Keyword -> Fixity -> Associativity -> Precedence -> Operator
Operator (Char -> Doc Keyword
forall ann. Char -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Char
'-')         Fixity
Prefix Associativity
L Precedence
6  -- Haskell's only prefix operator
primOperator PrimAbs{}                = Doc Keyword -> Fixity -> Associativity -> Precedence -> Operator
Operator Doc Keyword
"abs"                Fixity
App    Associativity
L Precedence
10
primOperator PrimSig{}                = Doc Keyword -> Fixity -> Associativity -> Precedence -> Operator
Operator Doc Keyword
"signum"             Fixity
App    Associativity
L Precedence
10
primOperator PrimQuot{}               = Doc Keyword -> Fixity -> Associativity -> Precedence -> Operator
Operator Doc Keyword
"quot"               Fixity
App    Associativity
L Precedence
10
primOperator PrimRem{}                = Doc Keyword -> Fixity -> Associativity -> Precedence -> Operator
Operator Doc Keyword
"rem"                Fixity
App    Associativity
L Precedence
10
primOperator PrimQuotRem{}            = Doc Keyword -> Fixity -> Associativity -> Precedence -> Operator
Operator Doc Keyword
"quotRem"            Fixity
App    Associativity
L Precedence
10
primOperator PrimIDiv{}               = Doc Keyword -> Fixity -> Associativity -> Precedence -> Operator
Operator Doc Keyword
"div"                Fixity
App    Associativity
L Precedence
10
primOperator PrimMod{}                = Doc Keyword -> Fixity -> Associativity -> Precedence -> Operator
Operator Doc Keyword
"mod"                Fixity
App    Associativity
L Precedence
10
primOperator PrimDivMod{}             = Doc Keyword -> Fixity -> Associativity -> Precedence -> Operator
Operator Doc Keyword
"divMod"             Fixity
App    Associativity
L Precedence
10
primOperator PrimBAnd{}               = Doc Keyword -> Fixity -> Associativity -> Precedence -> Operator
Operator Doc Keyword
".&."                Fixity
Infix  Associativity
L Precedence
7
primOperator PrimBOr{}                = Doc Keyword -> Fixity -> Associativity -> Precedence -> Operator
Operator Doc Keyword
".|."                Fixity
Infix  Associativity
L Precedence
5
primOperator PrimBXor{}               = Doc Keyword -> Fixity -> Associativity -> Precedence -> Operator
Operator Doc Keyword
"xor"                Fixity
App    Associativity
L Precedence
10
primOperator PrimBNot{}               = Doc Keyword -> Fixity -> Associativity -> Precedence -> Operator
Operator Doc Keyword
"complement"         Fixity
App    Associativity
L Precedence
10
primOperator PrimBShiftL{}            = Doc Keyword -> Fixity -> Associativity -> Precedence -> Operator
Operator Doc Keyword
"shiftL"             Fixity
App    Associativity
L Precedence
10
primOperator PrimBShiftR{}            = Doc Keyword -> Fixity -> Associativity -> Precedence -> Operator
Operator Doc Keyword
"shiftR"             Fixity
App    Associativity
L Precedence
10
primOperator PrimBRotateL{}           = Doc Keyword -> Fixity -> Associativity -> Precedence -> Operator
Operator Doc Keyword
"rotateL"            Fixity
App    Associativity
L Precedence
10
primOperator PrimBRotateR{}           = Doc Keyword -> Fixity -> Associativity -> Precedence -> Operator
Operator Doc Keyword
"rotateR"            Fixity
App    Associativity
L Precedence
10
primOperator PrimPopCount{}           = Doc Keyword -> Fixity -> Associativity -> Precedence -> Operator
Operator Doc Keyword
"popCount"           Fixity
App    Associativity
L Precedence
10
primOperator PrimCountLeadingZeros{}  = Doc Keyword -> Fixity -> Associativity -> Precedence -> Operator
Operator Doc Keyword
"countLeadingZeros"  Fixity
App    Associativity
L Precedence
10
primOperator PrimCountTrailingZeros{} = Doc Keyword -> Fixity -> Associativity -> Precedence -> Operator
Operator Doc Keyword
"countTrailingZeros" Fixity
App    Associativity
L Precedence
10
primOperator PrimFDiv{}               = Doc Keyword -> Fixity -> Associativity -> Precedence -> Operator
Operator (Char -> Doc Keyword
forall ann. Char -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Char
'/')         Fixity
Infix  Associativity
L Precedence
7
primOperator PrimRecip{}              = Doc Keyword -> Fixity -> Associativity -> Precedence -> Operator
Operator Doc Keyword
"recip"              Fixity
App    Associativity
L Precedence
10
primOperator PrimSin{}                = Doc Keyword -> Fixity -> Associativity -> Precedence -> Operator
Operator Doc Keyword
"sin"                Fixity
App    Associativity
L Precedence
10
primOperator PrimCos{}                = Doc Keyword -> Fixity -> Associativity -> Precedence -> Operator
Operator Doc Keyword
"cos"                Fixity
App    Associativity
L Precedence
10
primOperator PrimTan{}                = Doc Keyword -> Fixity -> Associativity -> Precedence -> Operator
Operator Doc Keyword
"tan"                Fixity
App    Associativity
L Precedence
10
primOperator PrimAsin{}               = Doc Keyword -> Fixity -> Associativity -> Precedence -> Operator
Operator Doc Keyword
"asin"               Fixity
App    Associativity
L Precedence
10
primOperator PrimAcos{}               = Doc Keyword -> Fixity -> Associativity -> Precedence -> Operator
Operator Doc Keyword
"acos"               Fixity
App    Associativity
L Precedence
10
primOperator PrimAtan{}               = Doc Keyword -> Fixity -> Associativity -> Precedence -> Operator
Operator Doc Keyword
"atan"               Fixity
App    Associativity
L Precedence
10
primOperator PrimSinh{}               = Doc Keyword -> Fixity -> Associativity -> Precedence -> Operator
Operator Doc Keyword
"sinh"               Fixity
App    Associativity
L Precedence
10
primOperator PrimCosh{}               = Doc Keyword -> Fixity -> Associativity -> Precedence -> Operator
Operator Doc Keyword
"cosh"               Fixity
App    Associativity
L Precedence
10
primOperator PrimTanh{}               = Doc Keyword -> Fixity -> Associativity -> Precedence -> Operator
Operator Doc Keyword
"tanh"               Fixity
App    Associativity
L Precedence
10
primOperator PrimAsinh{}              = Doc Keyword -> Fixity -> Associativity -> Precedence -> Operator
Operator Doc Keyword
"asinh"              Fixity
App    Associativity
L Precedence
10
primOperator PrimAcosh{}              = Doc Keyword -> Fixity -> Associativity -> Precedence -> Operator
Operator Doc Keyword
"acosh"              Fixity
App    Associativity
L Precedence
10
primOperator PrimAtanh{}              = Doc Keyword -> Fixity -> Associativity -> Precedence -> Operator
Operator Doc Keyword
"atanh"              Fixity
App    Associativity
L Precedence
10
primOperator PrimExpFloating{}        = Doc Keyword -> Fixity -> Associativity -> Precedence -> Operator
Operator Doc Keyword
"exp"                Fixity
App    Associativity
L Precedence
10
primOperator PrimSqrt{}               = Doc Keyword -> Fixity -> Associativity -> Precedence -> Operator
Operator Doc Keyword
"sqrt"               Fixity
App    Associativity
L Precedence
10
primOperator PrimLog{}                = Doc Keyword -> Fixity -> Associativity -> Precedence -> Operator
Operator Doc Keyword
"log"                Fixity
App    Associativity
L Precedence
10
primOperator PrimFPow{}               = Doc Keyword -> Fixity -> Associativity -> Precedence -> Operator
Operator Doc Keyword
"**"                 Fixity
Infix  Associativity
R Precedence
8
primOperator PrimLogBase{}            = Doc Keyword -> Fixity -> Associativity -> Precedence -> Operator
Operator Doc Keyword
"logBase"            Fixity
App    Associativity
L Precedence
10
primOperator PrimTruncate{}           = Doc Keyword -> Fixity -> Associativity -> Precedence -> Operator
Operator Doc Keyword
"truncate"           Fixity
App    Associativity
L Precedence
10
primOperator PrimRound{}              = Doc Keyword -> Fixity -> Associativity -> Precedence -> Operator
Operator Doc Keyword
"round"              Fixity
App    Associativity
L Precedence
10
primOperator PrimFloor{}              = Doc Keyword -> Fixity -> Associativity -> Precedence -> Operator
Operator Doc Keyword
"floor"              Fixity
App    Associativity
L Precedence
10
primOperator PrimCeiling{}            = Doc Keyword -> Fixity -> Associativity -> Precedence -> Operator
Operator Doc Keyword
"ceiling"            Fixity
App    Associativity
L Precedence
10
primOperator PrimAtan2{}              = Doc Keyword -> Fixity -> Associativity -> Precedence -> Operator
Operator Doc Keyword
"atan2"              Fixity
App    Associativity
L Precedence
10
primOperator PrimIsNaN{}              = Doc Keyword -> Fixity -> Associativity -> Precedence -> Operator
Operator Doc Keyword
"isNaN"              Fixity
App    Associativity
L Precedence
10
primOperator PrimIsInfinite{}         = Doc Keyword -> Fixity -> Associativity -> Precedence -> Operator
Operator Doc Keyword
"isInfinite"         Fixity
App    Associativity
L Precedence
10
primOperator PrimLt{}                 = Doc Keyword -> Fixity -> Associativity -> Precedence -> Operator
Operator Doc Keyword
"<"                  Fixity
Infix  Associativity
N Precedence
4
primOperator PrimGt{}                 = Doc Keyword -> Fixity -> Associativity -> Precedence -> Operator
Operator Doc Keyword
">"                  Fixity
Infix  Associativity
N Precedence
4
primOperator PrimLtEq{}               = Doc Keyword -> Fixity -> Associativity -> Precedence -> Operator
Operator Doc Keyword
"<="                 Fixity
Infix  Associativity
N Precedence
4
primOperator PrimGtEq{}               = Doc Keyword -> Fixity -> Associativity -> Precedence -> Operator
Operator Doc Keyword
">="                 Fixity
Infix  Associativity
N Precedence
4
primOperator PrimEq{}                 = Doc Keyword -> Fixity -> Associativity -> Precedence -> Operator
Operator Doc Keyword
"=="                 Fixity
Infix  Associativity
N Precedence
4
primOperator PrimNEq{}                = Doc Keyword -> Fixity -> Associativity -> Precedence -> Operator
Operator Doc Keyword
"/="                 Fixity
Infix  Associativity
N Precedence
4
primOperator PrimMax{}                = Doc Keyword -> Fixity -> Associativity -> Precedence -> Operator
Operator Doc Keyword
"max"                Fixity
App    Associativity
L Precedence
10
primOperator PrimMin{}                = Doc Keyword -> Fixity -> Associativity -> Precedence -> Operator
Operator Doc Keyword
"min"                Fixity
App    Associativity
L Precedence
10
primOperator PrimFun a
PrimLAnd                 = Doc Keyword -> Fixity -> Associativity -> Precedence -> Operator
Operator Doc Keyword
"&&"                 Fixity
Infix  Associativity
R Precedence
3
primOperator PrimFun a
PrimLOr                  = Doc Keyword -> Fixity -> Associativity -> Precedence -> Operator
Operator Doc Keyword
"||"                 Fixity
Infix  Associativity
R Precedence
2
primOperator PrimFun a
PrimLNot                 = Doc Keyword -> Fixity -> Associativity -> Precedence -> Operator
Operator Doc Keyword
"not"                Fixity
App    Associativity
L Precedence
10
primOperator PrimFromIntegral{}       = Doc Keyword -> Fixity -> Associativity -> Precedence -> Operator
Operator Doc Keyword
"fromIntegral"       Fixity
App    Associativity
L Precedence
10
primOperator PrimToFloating{}         = Doc Keyword -> Fixity -> Associativity -> Precedence -> Operator
Operator Doc Keyword
"toFloating"         Fixity
App    Associativity
L Precedence
10


-- Environments
-- ------------

data Val env where
  Empty ::                    Val ()
  Push  :: Val env -> Adoc -> Val (env, t)

class PrettyEnv env where
  prettyEnv :: Adoc -> Val env

instance PrettyEnv () where
  prettyEnv :: Doc Keyword -> Val ()
prettyEnv Doc Keyword
_ = Val ()
Empty

instance PrettyEnv env => PrettyEnv (env, t) where
  prettyEnv :: Doc Keyword -> Val (env, t)
prettyEnv Doc Keyword
v =
    let env :: Val env
env = Doc Keyword -> Val env
forall env. PrettyEnv env => Doc Keyword -> Val env
prettyEnv Doc Keyword
v :: Val env
        x :: Doc Keyword
x   = Doc Keyword
v Doc Keyword -> Doc Keyword -> Doc Keyword
forall a. Semigroup a => a -> a -> a
<> Precedence -> Doc Keyword
forall ann. Precedence -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Val env -> Precedence
forall env. Val env -> Precedence
sizeEnv Val env
env)
    in
    Val env
env Val env -> Doc Keyword -> Val (env, t)
forall env t. Val env -> Doc Keyword -> Val (env, t)
`Push` Doc Keyword
x

sizeEnv :: Val env -> Int
sizeEnv :: forall env. Val env -> Precedence
sizeEnv Val env
Empty        = Precedence
0
sizeEnv (Push Val env
env Doc Keyword
_) = Precedence
1 Precedence -> Precedence -> Precedence
forall a. Num a => a -> a -> a
+ Val env -> Precedence
forall env. Val env -> Precedence
sizeEnv Val env
env

prj :: Idx env t -> Val env -> Adoc
prj :: forall env t. Idx env t -> Val env -> Doc Keyword
prj Idx env t
ZeroIdx      (Push Val env
_ Doc Keyword
v)   = Doc Keyword
v
prj (SuccIdx Idx env t
ix) (Push Val env
env Doc Keyword
_) = Idx env t -> Val env -> Doc Keyword
forall env t. Idx env t -> Val env -> Doc Keyword
prj Idx env t
ix Val env
Val env
env


-- Utilities
-- ---------

shiftwidth :: Int
shiftwidth :: Precedence
shiftwidth = Precedence
2

infix 0 ?
(?) :: Bool -> (a, a) -> a
Bool
True  ? :: forall a. Bool -> (a, a) -> a
? (a
t,a
_) = a
t
Bool
False ? (a
_,a
f) = a
f

parensIf :: Bool -> Doc ann -> Doc ann
parensIf :: forall ann. Bool -> Doc ann -> Doc ann
parensIf Bool
True  = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
group (Doc ann -> Doc ann) -> (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (Doc ann -> Doc ann) -> (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align
parensIf Bool
False = Doc ann -> Doc ann
forall a. a -> a
id