{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances  #-}
{-# OPTIONS_GHC -Wno-orphans        #-}

{- |
Module      : Language.Egison.PrettyPrint
Licence     : MIT

This module contains pretty printing for Egison syntax
-}

module Language.Egison.Pretty
    ( prettyTopExprs
    , prettyStr
    , showTSV
    ) where

import           Data.Foldable                           (toList)
import           Data.List                               (intercalate)
import           Data.Text.Prettyprint.Doc
import           Data.Text.Prettyprint.Doc.Render.String (renderString)
import           Text.Show.Unicode                       (ushow)

import           Language.Egison.AST
import           Language.Egison.Data
import           Language.Egison.IExpr

--
-- Pretty printing for Non-S syntax
--

prettyTopExprs :: [TopExpr] -> Doc [TopExpr]
prettyTopExprs :: [TopExpr] -> Doc [TopExpr]
prettyTopExprs [TopExpr]
exprs = [Doc [TopExpr]] -> Doc [TopExpr]
forall ann. [Doc ann] -> Doc ann
vsep ([Doc [TopExpr]] -> Doc [TopExpr])
-> [Doc [TopExpr]] -> Doc [TopExpr]
forall a b. (a -> b) -> a -> b
$ Doc [TopExpr] -> [Doc [TopExpr]] -> [Doc [TopExpr]]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc [TopExpr]
forall ann. Doc ann
line ((TopExpr -> Doc [TopExpr]) -> [TopExpr] -> [Doc [TopExpr]]
forall a b. (a -> b) -> [a] -> [b]
map TopExpr -> Doc [TopExpr]
forall a ann. Pretty a => a -> Doc ann
pretty [TopExpr]
exprs)

instance Pretty TopExpr where
  pretty :: TopExpr -> Doc ann
pretty (Define VarWithIndices
x (LambdaExpr [Arg ArgPattern]
args Expr
body)) =
    [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep ([Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"def" Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: VarWithIndices -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty VarWithIndices
x Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: (Arg ArgPattern -> Doc ann) -> [Arg ArgPattern] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Arg ArgPattern -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' [Arg ArgPattern]
args) Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> [Doc ann] -> Doc ann
forall ann. Doc ann -> [Doc ann] -> Doc ann
indentBlock ([Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
":=") [Expr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Expr
body]
  pretty (Define VarWithIndices
x Expr
expr) =
    [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"def" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> VarWithIndices -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty VarWithIndices
x Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> [Doc ann] -> Doc ann
forall ann. Doc ann -> [Doc ann] -> Doc ann
indentBlock ([Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
":=") [Expr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Expr
expr]
  pretty (Test Expr
expr) = Expr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Expr
expr
  pretty (LoadFile [Char]
file) = [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"loadFile" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ([Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
file)
  pretty (Load [Char]
lib) = [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"load" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ([Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
lib)
  pretty TopExpr
_ = [Char] -> Doc ann
forall a. HasCallStack => [Char] -> a
error [Char]
"Unsupported topexpr"

instance Pretty ConstantExpr where
  pretty :: ConstantExpr -> Doc ann
pretty (CharExpr Char
x)    = Char -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow Char
x
  pretty (StringExpr Text
x)  = [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Text -> [Char]
forall a. Show a => a -> [Char]
ushow Text
x)
  pretty (BoolExpr Bool
x)    = Bool -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Bool
x
  pretty (IntegerExpr Integer
x) = Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Integer
x
  pretty (FloatExpr Double
x)   = Double -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Double
x
  pretty ConstantExpr
SomethingExpr   = [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"something"
  pretty ConstantExpr
UndefinedExpr   = [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"undefined"

instance Pretty Expr where
  pretty :: Expr -> Doc ann
pretty (ConstantExpr ConstantExpr
c) = ConstantExpr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ConstantExpr
c
  -- Use |viaShow| to correctly handle escaped characters
  pretty (VarExpr [Char]
x)     = [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
x
  pretty Expr
FreshVarExpr    = [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"#"
  pretty (IndexedExpr Bool
True Expr
e [IndexExpr Expr]
indices) = Expr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' Expr
e Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
cat ((IndexExpr Expr -> Doc ann) -> [IndexExpr Expr] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map IndexExpr Expr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [IndexExpr Expr]
indices)
  pretty (IndexedExpr Bool
False Expr
e [IndexExpr Expr]
indices) = Expr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' Expr
e Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"..." Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
cat ((IndexExpr Expr -> Doc ann) -> [IndexExpr Expr] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map IndexExpr Expr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [IndexExpr Expr]
indices)
  pretty (SubrefsExpr Bool
b Expr
e1 Expr
e2) =
    [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
applyLike [[Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"subrefs" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> (if Bool
b then [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"!" else Doc ann
forall ann. Doc ann
emptyDoc),
               Expr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' Expr
e1, Expr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' Expr
e2]
  pretty (SuprefsExpr Bool
b Expr
e1 Expr
e2) =
    [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
applyLike [[Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"suprefs" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> (if Bool
b then [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"!" else Doc ann
forall ann. Doc ann
emptyDoc),
               Expr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' Expr
e1, Expr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' Expr
e2]
  pretty (UserrefsExpr Bool
b Expr
e1 Expr
e2) =
    [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
applyLike [[Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"userRefs" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> (if Bool
b then [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"!" else Doc ann
forall ann. Doc ann
emptyDoc),
               Expr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' Expr
e1, Expr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' Expr
e2]

  pretty (TupleExpr [Expr]
xs) = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
tupled ((Expr -> Doc ann) -> [Expr] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Expr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Expr]
xs)
  pretty (CollectionExpr [Expr]
xs)
    | [Expr] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Expr]
xs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
20 = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
list ((Expr -> Doc ann) -> [Expr] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Expr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Expr]
xs)
    | Bool
otherwise      =
      [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"[" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
fillSepAtom (Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
comma ((Expr -> Doc ann) -> [Expr] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Expr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Expr]
xs))) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"]"
  pretty (HashExpr [(Expr, Expr)]
xs)   = [Char] -> [Char] -> [Doc ann] -> Doc ann
forall ann. [Char] -> [Char] -> [Doc ann] -> Doc ann
listoid [Char]
"{|" [Char]
"|}" (((Expr, Expr) -> Doc ann) -> [(Expr, Expr)] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map (\(Expr
x, Expr
y) -> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
tupled [Expr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Expr
x, Expr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Expr
y]) [(Expr, Expr)]
xs)
  pretty (VectorExpr [Expr]
xs) = [Char] -> [Char] -> [Doc ann] -> Doc ann
forall ann. [Char] -> [Char] -> [Doc ann] -> Doc ann
listoid [Char]
"[|" [Char]
"|]" ((Expr -> Doc ann) -> [Expr] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Expr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Expr]
xs)

  pretty (LambdaExpr [Arg ArgPattern]
xs Expr
e) =
    Doc ann -> [Doc ann] -> Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> [Doc ann] -> Doc ann -> Doc ann -> Doc ann
lambdaLike ([Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"\\") ((Arg ArgPattern -> Doc ann) -> [Arg ArgPattern] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Arg ArgPattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Arg ArgPattern]
xs) ([Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"->") (Expr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Expr
e)
  pretty (MemoizedLambdaExpr [[Char]]
xs Expr
e)  =
    Doc ann -> [Doc ann] -> Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> [Doc ann] -> Doc ann -> Doc ann -> Doc ann
lambdaLike ([Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"memoizedLambda ") (([Char] -> Doc ann) -> [[Char]] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [[Char]]
xs) ([Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"->") (Expr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Expr
e)
  pretty (CambdaExpr [Char]
x Expr
e) =
    Doc ann -> [Doc ann] -> Doc ann
forall ann. Doc ann -> [Doc ann] -> Doc ann
indentBlock ([Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"cambda" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
x Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"->") [Expr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Expr
e]
  pretty (PatternFunctionExpr [[Char]]
xs Pattern
p) =
    Doc ann -> [Doc ann] -> Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> [Doc ann] -> Doc ann -> Doc ann -> Doc ann
lambdaLike ([Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"\\") (([Char] -> Doc ann) -> [[Char]] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [[Char]]
xs) ([Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"=>") (Pattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Pattern
p)

  pretty (IfExpr Expr
x Expr
y Expr
z) =
    Doc ann -> [Doc ann] -> Doc ann
forall ann. Doc ann -> [Doc ann] -> Doc ann
indentBlock ([Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"if" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Expr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Expr
x)
      [[Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"then" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Expr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Expr
y, [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"else" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Expr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Expr
z]
  pretty (LetRecExpr [BindingExpr]
bindings Expr
body) =
    Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
hang Int
1 ([Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"let" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep ((BindingExpr -> Doc ann) -> [BindingExpr] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map BindingExpr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [BindingExpr]
bindings)) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
hardline Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"in" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align (Expr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Expr
body))
  pretty (WithSymbolsExpr [[Char]]
xs Expr
e) =
    Doc ann -> [Doc ann] -> Doc ann
forall ann. Doc ann -> [Doc ann] -> Doc ann
indentBlock ([Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"withSymbols" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
list (([Char] -> Doc ann) -> [[Char]] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [[Char]]
xs)) [Expr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Expr
e]

  pretty (MatchExpr PMMode
BFSMode Expr
tgt Expr
matcher [MatchClause]
clauses) =
    Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
nest Int
2 ([Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"match"       Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Expr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Expr
tgt Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Expr -> [MatchClause] -> Doc ann
forall ann. Expr -> [MatchClause] -> Doc ann
prettyMatch Expr
matcher [MatchClause]
clauses)
  pretty (MatchExpr PMMode
DFSMode Expr
tgt Expr
matcher [MatchClause]
clauses) =
    Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
nest Int
2 ([Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"matchDFS"    Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Expr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Expr
tgt Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Expr -> [MatchClause] -> Doc ann
forall ann. Expr -> [MatchClause] -> Doc ann
prettyMatch Expr
matcher [MatchClause]
clauses)
  pretty (MatchAllExpr PMMode
BFSMode Expr
tgt Expr
matcher [MatchClause]
clauses) =
    Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
nest Int
2 ([Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"matchAll"    Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Expr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Expr
tgt Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Expr -> [MatchClause] -> Doc ann
forall ann. Expr -> [MatchClause] -> Doc ann
prettyMatch Expr
matcher [MatchClause]
clauses)
  pretty (MatchAllExpr PMMode
DFSMode Expr
tgt Expr
matcher [MatchClause]
clauses) =
    Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
nest Int
2 ([Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"matchAllDFS" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Expr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Expr
tgt Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Expr -> [MatchClause] -> Doc ann
forall ann. Expr -> [MatchClause] -> Doc ann
prettyMatch Expr
matcher [MatchClause]
clauses)
  pretty (MatchLambdaExpr Expr
matcher [MatchClause]
clauses) =
    Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
nest Int
2 ([Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"\\match"     Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Expr -> [MatchClause] -> Doc ann
forall ann. Expr -> [MatchClause] -> Doc ann
prettyMatch Expr
matcher [MatchClause]
clauses)
  pretty (MatchAllLambdaExpr Expr
matcher [MatchClause]
clauses) =
    Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
nest Int
2 ([Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"\\matchAll"  Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Expr -> [MatchClause] -> Doc ann
forall ann. Expr -> [MatchClause] -> Doc ann
prettyMatch Expr
matcher [MatchClause]
clauses)

  pretty (MatcherExpr [PatternDef]
patDefs) =
    Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
nest Int
2 ([Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"matcher" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
hardline Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep ((PatternDef -> Doc ann) -> [PatternDef] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map PatternDef -> Doc ann
forall a a a a ann.
(Pretty a, Pretty a, Pretty a, Pretty a) =>
(a, a, [(a, a)]) -> Doc ann
prettyPatDef [PatternDef]
patDefs)))
      where
        prettyPatDef :: (a, a, [(a, a)]) -> Doc ann
prettyPatDef (a
pppat, a
expr, [(a, a)]
body) =
          Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
nest Int
2 (Doc ann
forall ann. Doc ann
pipe Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
pppat Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"as" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+>
            Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
group (a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
expr) Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"with" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
hardline Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<>
              Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep (((a, a) -> Doc ann) -> [(a, a)] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map (a, a) -> Doc ann
forall a a ann. (Pretty a, Pretty a) => (a, a) -> Doc ann
prettyPatBody [(a, a)]
body)))
        prettyPatBody :: (a, a) -> Doc ann
prettyPatBody (a
pdpat, a
expr) =
          Doc ann -> [Doc ann] -> Doc ann
forall ann. Doc ann -> [Doc ann] -> Doc ann
indentBlock (Doc ann
forall ann. Doc ann
pipe Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align (a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
pdpat) Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"->") [a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
expr]

  pretty (AlgebraicDataMatcherExpr [([Char], [Expr])]
patDefs) =
    Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
nest Int
2 ([Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"algebraicDataMatcher" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
hardline Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep ((([Char], [Expr]) -> Doc ann) -> [([Char], [Expr])] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map ([Char], [Expr]) -> Doc ann
forall a a ann. (Pretty a, Pretty a) => (a, [a]) -> Doc ann
prettyPatDef [([Char], [Expr])]
patDefs)))
      where
        prettyPatDef :: (a, [a]) -> Doc ann
prettyPatDef (a
name, [a]
exprs) = Doc ann
forall ann. Doc ann
pipe Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
name Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: (a -> Doc ann) -> [a] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [a]
exprs)

  pretty (QuoteExpr Expr
e) = Doc ann
forall ann. Doc ann
squote Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Expr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' Expr
e
  pretty (QuoteSymbolExpr Expr
e) = Char -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Char
'`' Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Expr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' Expr
e

  pretty (PrefixExpr [Char]
op x :: Expr
x@(ConstantExpr (IntegerExpr Integer
_))) = [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
op Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Expr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Expr
x
  pretty (PrefixExpr [Char]
op Expr
x)
    | Expr -> Bool
forall a. Complex a => a -> Bool
isAtomOrApp Expr
x = [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
op Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Expr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Expr
x
    | Bool
otherwise     = [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
op Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (Expr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Expr
x)
  -- (x1 op' x2) op y
  pretty (InfixExpr Op
op x :: Expr
x@(InfixExpr Op
op' Expr
_ Expr
_) Expr
y) =
    if Op -> Int
priority Op
op Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Op -> Int
priority Op
op' Bool -> Bool -> Bool
|| Op -> Int
priority Op
op Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Op -> Int
priority Op
op' Bool -> Bool -> Bool
&& Op -> Assoc
assoc Op
op Assoc -> Assoc -> Bool
forall a. Eq a => a -> a -> Bool
== Assoc
InfixR
       then Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (Expr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Expr
x) Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Op -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Op
op Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
infixRight (Expr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty'' Expr
y)
       else Expr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Expr
x          Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Op -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Op
op Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
infixRight (Expr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty'' Expr
y)
  -- x op (y1 op' y2)
  pretty (InfixExpr Op
op Expr
x y :: Expr
y@(InfixExpr Op
op' Expr
_ Expr
_)) =
    if Op -> Int
priority Op
op Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Op -> Int
priority Op
op' Bool -> Bool -> Bool
|| Op -> Int
priority Op
op Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Op -> Int
priority Op
op' Bool -> Bool -> Bool
&& Op -> Assoc
assoc Op
op Assoc -> Assoc -> Bool
forall a. Eq a => a -> a -> Bool
== Assoc
InfixL
       then Expr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty'' Expr
x Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Op -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Op
op Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
infixRight (Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (Expr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Expr
y))
       else Expr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty'' Expr
x Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Op -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Op
op Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
infixRight (Expr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Expr
y)
  pretty (InfixExpr Op
op Expr
x Expr
y) =
    Expr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty'' Expr
x Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Op -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Op
op Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
infixRight (Expr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty'' Expr
y)
  pretty (SectionExpr Op
op Maybe Expr
Nothing Maybe Expr
Nothing) = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (Op -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Op
op)
  pretty (SectionExpr Op
op (Just Expr
x) Maybe Expr
Nothing) = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (Expr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Expr
x Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Op -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Op
op)
  pretty (SectionExpr Op
op Maybe Expr
Nothing (Just Expr
x)) = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (Op -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Op
op Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Expr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Expr
x)

  pretty (DoExpr [] Expr
y) = [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"do" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Expr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Expr
y
  pretty (DoExpr [BindingExpr]
xs (ApplyExpr (VarExpr [Char]
"return") [])) =
    [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"do" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsepHard ((BindingExpr -> Doc ann) -> [BindingExpr] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map BindingExpr -> Doc ann
forall ann. BindingExpr -> Doc ann
prettyDoBinds [BindingExpr]
xs))
  pretty (DoExpr [BindingExpr]
xs Expr
y) = [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"do" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsepHard ((BindingExpr -> Doc ann) -> [BindingExpr] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map BindingExpr -> Doc ann
forall ann. BindingExpr -> Doc ann
prettyDoBinds [BindingExpr]
xs [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. [a] -> [a] -> [a]
++ [Expr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Expr
y]))

  pretty (SeqExpr Expr
e1 Expr
e2) = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
applyLike [[Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"seq", Expr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' Expr
e1, Expr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' Expr
e2]
  pretty (ApplyExpr Expr
x [Expr]
ys) = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
applyLike ((Expr -> Doc ann) -> [Expr] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Expr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' (Expr
x Expr -> [Expr] -> [Expr]
forall a. a -> [a] -> [a]
: [Expr]
ys))
  pretty (CApplyExpr Expr
e1 Expr
e2) = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
applyLike [[Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"capply", Expr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' Expr
e1, Expr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' Expr
e2]
  pretty (AnonParamFuncExpr Integer
n Expr
e) = Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Integer
n Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Char -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Char
'#' Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Expr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' Expr
e
  pretty (AnonParamExpr Integer
n) = Char -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Char
'%' Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Integer
n

  pretty (GenerateTensorExpr Expr
gen Expr
shape) =
    [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
applyLike [[Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"generateTensor", Expr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' Expr
gen, Expr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' Expr
shape]
  pretty (TensorExpr Expr
e1 Expr
e2) =
    [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
applyLike [[Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"tensor", Expr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' Expr
e1, Expr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' Expr
e2]
  pretty (TensorContractExpr Expr
e1) =
    [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
applyLike [[Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"contract", Expr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' Expr
e1]
  pretty (TensorMapExpr Expr
e1 Expr
e2) =
    [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
applyLike [[Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"tensorMap", Expr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' Expr
e1, Expr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' Expr
e2]
  pretty (TensorMap2Expr Expr
e1 Expr
e2 Expr
e3) =
    [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
applyLike [[Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"tensorMap2", Expr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' Expr
e1, Expr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' Expr
e2, Expr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' Expr
e3]
  pretty (TransposeExpr Expr
e1 Expr
e2) =
    [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
applyLike [[Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"transpose", Expr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' Expr
e1, Expr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' Expr
e2]
  pretty (FlipIndicesExpr Expr
_) = [Char] -> Doc ann
forall a. HasCallStack => [Char] -> a
error [Char]
"unreachable"

  pretty (FunctionExpr [[Char]]
xs) = [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"function" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
tupled (([Char] -> Doc ann) -> [[Char]] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [[Char]]
xs)

  pretty Expr
p = [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Expr -> [Char]
forall a. Show a => a -> [Char]
show Expr
p)

instance (Pretty a, Complex a) => Pretty (Arg a) where
  pretty :: Arg a -> Doc ann
pretty (ScalarArg a
x)         = [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"$" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> a -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' a
x
  pretty (InvertedScalarArg a
x) = [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"*$" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> a -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' a
x
  pretty (TensorArg a
x)         = a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
x

instance Pretty ArgPattern where
  pretty :: ArgPattern -> Doc ann
pretty ArgPattern
APWildCard              = [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"_"
  pretty (APPatVar VarWithIndices
x)            = VarWithIndices -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty VarWithIndices
x
  pretty (APInductivePat [Char]
x [Arg ArgPattern]
args) = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
applyLike ([Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
x Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: (Arg ArgPattern -> Doc ann) -> [Arg ArgPattern] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Arg ArgPattern -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' [Arg ArgPattern]
args)
  pretty (APTuplePat [Arg ArgPattern]
args)       = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
tupled ((Arg ArgPattern -> Doc ann) -> [Arg ArgPattern] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Arg ArgPattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Arg ArgPattern]
args)
  pretty ArgPattern
APEmptyPat              = [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"[]"
  pretty (APConsPat Arg ArgPattern
arg1 ArgPattern
arg2)   = Arg ArgPattern -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty'' Arg ArgPattern
arg1 Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"::" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ArgPattern -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty'' ArgPattern
arg2
  pretty (APSnocPat ArgPattern
arg1 Arg ArgPattern
arg2)   = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
applyLike [[Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"snoc", ArgPattern -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' ArgPattern
arg1, Arg ArgPattern -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' Arg ArgPattern
arg2]

instance Pretty VarWithIndices where
  pretty :: VarWithIndices -> Doc ann
pretty (VarWithIndices [Char]
xs [VarIndex]
is) = [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
xs Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hcat ((VarIndex -> Doc ann) -> [VarIndex] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map VarIndex -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [VarIndex]
is)

instance Pretty VarIndex where
  pretty :: VarIndex -> Doc ann
pretty (VSubscript [Char]
x)        = [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Char
'_' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
x)
  pretty (VSuperscript [Char]
x)      = [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Char
'~' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
x)
  pretty (VSymmScripts [VarIndex]
xs)     = Char -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Char
'{' Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hcat ((VarIndex -> Doc ann) -> [VarIndex] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map VarIndex -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [VarIndex]
xs) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Char -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Char
'}'
  pretty (VAntiSymmScripts [VarIndex]
xs) = Char -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Char
'[' Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hcat ((VarIndex -> Doc ann) -> [VarIndex] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map VarIndex -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [VarIndex]
xs) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Char -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Char
']'

instance Pretty BindingExpr where
  pretty :: BindingExpr -> Doc ann
pretty (Bind (PDPatVar [Char]
f) (LambdaExpr [Arg ArgPattern]
args Expr
body)) =
    [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep ([Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
f Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: (Arg ArgPattern -> Doc ann) -> [Arg ArgPattern] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Arg ArgPattern -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' [Arg ArgPattern]
args) Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> [Doc ann] -> Doc ann
forall ann. Doc ann -> [Doc ann] -> Doc ann
indentBlock ([Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
":=") [Expr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Expr
body]
  pretty (Bind PDPatternBase [Char]
pat Expr
expr) = PDPatternBase [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty PDPatternBase [Char]
pat Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
":=" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align (Expr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Expr
expr)
  pretty (BindWithIndices VarWithIndices
var Expr
expr) = VarWithIndices -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty VarWithIndices
var Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
":=" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align (Expr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Expr
expr)

instance {-# OVERLAPPING #-} Pretty MatchClause where
  pretty :: MatchClause -> Doc ann
pretty (Pattern
pat, Expr
expr) =
    Doc ann
forall ann. Doc ann
pipe Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align (Pattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Pattern
pat) Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> [Doc ann] -> Doc ann
forall ann. Doc ann -> [Doc ann] -> Doc ann
indentBlock ([Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"->") [Expr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Expr
expr]

instance {-# OVERLAPPING #-} Pretty (IndexExpr String) where -- for 'VarWithIndices'
  pretty :: IndexExpr [Char] -> Doc ann
pretty (Superscript [Char]
s)  = [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ([Char]
"~" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
s)
  pretty (Subscript [Char]
s)    = [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ([Char]
"_" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
s)
  pretty (SupSubscript [Char]
s) = [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ([Char]
"~_" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
s)
  pretty (Userscript [Char]
i)   = [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ([Char]
"|" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
i)
  pretty IndexExpr [Char]
_                = Doc ann
forall a. HasCallStack => a
undefined

instance (Pretty a, Complex a) => Pretty (IndexExpr a) where
  pretty :: IndexExpr a -> Doc ann
pretty (Subscript a
i)          = Char -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Char
'_' Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> a -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' a
i
  pretty (Superscript a
i)        = Char -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Char
'~' Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> a -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' a
i
  pretty (SupSubscript a
i)       = [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"~_" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> a -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' a
i
  pretty (MultiSubscript a
i a
j)   = Char -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Char
'_' Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> a -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' a
i Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"..._" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> a -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' a
j
  pretty (MultiSuperscript a
i a
j) = Char -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Char
'~' Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> a -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' a
i Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"...~" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> a -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' a
j
  pretty (Userscript a
i)         = Char -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Char
'|' Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> a -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' a
i

instance Pretty Pattern where
  pretty :: Pattern -> Doc ann
pretty Pattern
WildCard     = [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"_"
  pretty (PatVar [Char]
x)   = [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"$" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
x
  pretty (ValuePat Expr
v) = [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"#" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Expr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' Expr
v
  pretty (PredPat Expr
v)  = [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"?" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Expr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' Expr
v
  pretty (IndexedPat Pattern
p [Expr]
indices) =
    Pattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Pattern
p Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hcat ((Expr -> Doc ann) -> [Expr] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map (\Expr
i -> Char -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Char
'_' Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Expr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' Expr
i) [Expr]
indices)
  pretty (LetPat [BindingExpr]
binds Pattern
pat) =
    [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"let" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep ((BindingExpr -> Doc ann) -> [BindingExpr] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map BindingExpr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [BindingExpr]
binds)) Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"in" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Pattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Pattern
pat
  -- (p11 op' p12) op p2
  pretty (InfixPat Op
op p1 :: Pattern
p1@(InfixPat Op
op' Pattern
_ Pattern
_) Pattern
p2) =
    if Op -> Int
priority Op
op Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Op -> Int
priority Op
op' Bool -> Bool -> Bool
|| Op -> Int
priority Op
op Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Op -> Int
priority Op
op' Bool -> Bool -> Bool
&& Op -> Assoc
assoc Op
op Assoc -> Assoc -> Bool
forall a. Eq a => a -> a -> Bool
== Assoc
InfixR
       then Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (Pattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Pattern
p1) Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Op -> [Char]
repr Op
op) Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Pattern -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty'' Pattern
p2
       else Pattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Pattern
p1          Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Op -> [Char]
repr Op
op) Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Pattern -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty'' Pattern
p2
  -- p1 op (p21 op' p22)
  pretty (InfixPat Op
op Pattern
p1 p2 :: Pattern
p2@(InfixPat Op
op' Pattern
_ Pattern
_)) =
    if Op -> Int
priority Op
op Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Op -> Int
priority Op
op' Bool -> Bool -> Bool
|| Op -> Int
priority Op
op Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Op -> Int
priority Op
op' Bool -> Bool -> Bool
&& Op -> Assoc
assoc Op
op Assoc -> Assoc -> Bool
forall a. Eq a => a -> a -> Bool
== Assoc
InfixL
       then Pattern -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty'' Pattern
p1 Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Op -> [Char]
repr Op
op) Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (Pattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Pattern
p2)
       else Pattern -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty'' Pattern
p1 Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Op -> [Char]
repr Op
op) Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Pattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Pattern
p2
  pretty (InfixPat Op
op Pattern
p1 Pattern
p2) = Pattern -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty'' Pattern
p1 Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Op -> [Char]
repr Op
op) Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Pattern -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty'' Pattern
p2
  pretty (NotPat Pattern
pat) = [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"!" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Pattern -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' Pattern
pat
  pretty (TuplePat [Pattern]
pats) = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
tupled ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ (Pattern -> Doc ann) -> [Pattern] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Pattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Pattern]
pats
  pretty (InductivePat [Char]
"nil" []) = [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"[]"
  pretty (InductivePat [Char]
"::" [Pattern
p, InductivePat [Char]
"nil" []]) = [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"[" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Pattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Pattern
p Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"]"
  pretty (InductivePat [Char]
ctor [Pattern]
xs) = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep ([Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
ctor Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: (Pattern -> Doc ann) -> [Pattern] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Pattern -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' [Pattern]
xs)
  pretty (LoopPat [Char]
i LoopRange
range Pattern
p1 Pattern
p2) =
    Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
hang Int
2 ([Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"loop" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Char -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Char
'$' Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
i Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> LoopRange -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty LoopRange
range Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<>
      Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
flatAlt (Doc ann
forall ann. Doc ann
hardline Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
group (Pattern -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' Pattern
p1) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
hardline Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
group (Pattern -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' Pattern
p2))
              (Doc ann
forall ann. Doc ann
space Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Pattern -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' Pattern
p1 Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Pattern -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' Pattern
p2))
  pretty Pattern
ContPat = [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"..."
  pretty (PApplyPat Expr
fn [Pattern]
ps) = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
applyLike (Expr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' Expr
fn Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: (Pattern -> Doc ann) -> [Pattern] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Pattern -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' [Pattern]
ps)
  pretty (VarPat [Char]
x) = [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Char
'~' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
x)
  pretty Pattern
SeqNilPat = [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"{}"
  pretty (SeqConsPat Pattern
p1 Pattern
p2) = [Char] -> [Char] -> [Doc ann] -> Doc ann
forall ann. [Char] -> [Char] -> [Doc ann] -> Doc ann
listoid [Char]
"{" [Char]
"}" (Pattern -> Pattern -> [Doc ann]
forall ann. Pattern -> Pattern -> [Doc ann]
f Pattern
p1 Pattern
p2)
    where
      f :: Pattern -> Pattern -> [Doc ann]
f Pattern
p1 Pattern
SeqNilPat          = [Pattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Pattern
p1]
      f Pattern
p1 (SeqConsPat Pattern
p2 Pattern
p3) = Pattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Pattern
p1 Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: Pattern -> Pattern -> [Doc ann]
f Pattern
p2 Pattern
p3
      f Pattern
p1 Pattern
p2                 = [Pattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Pattern
p1, Pattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Pattern
p2]
  pretty Pattern
LaterPatVar = [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"@"
  pretty (DApplyPat Pattern
p [Pattern]
ps) = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
applyLike ((Pattern -> Doc ann) -> [Pattern] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Pattern -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' (Pattern
p Pattern -> [Pattern] -> [Pattern]
forall a. a -> [a] -> [a]
: [Pattern]
ps))
  pretty Pattern
e            = [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Pattern -> [Char]
forall a. Show a => a -> [Char]
show Pattern
e)

instance {-# OVERLAPPING #-} Pretty LoopRange where
  pretty :: LoopRange -> Doc ann
pretty (LoopRange Expr
from (ApplyExpr (VarExpr [Char]
"from")
                                    [InfixExpr Op{ repr :: Op -> [Char]
repr = [Char]
"-'" } Expr
_ (ConstantExpr (IntegerExpr Integer
1))]) Pattern
pat) =
    [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
tupled [Expr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Expr
from, Pattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Pattern
pat]
  pretty (LoopRange Expr
from Expr
to Pattern
pat) = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
tupled [Expr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Expr
from, Expr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Expr
to, Pattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Pattern
pat]

instance Pretty PrimitivePatPattern where
  pretty :: PrimitivePatPattern -> Doc ann
pretty PrimitivePatPattern
PPWildCard                = [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"_"
  pretty PrimitivePatPattern
PPPatVar                  = [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"$"
  pretty (PPValuePat [Char]
x)            = [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Char
'#' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Char
'$' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
x)
  pretty (PPInductivePat [Char]
x [PrimitivePatPattern]
pppats) = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep ([Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
x Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: (PrimitivePatPattern -> Doc ann)
-> [PrimitivePatPattern] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map PrimitivePatPattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [PrimitivePatPattern]
pppats)
  pretty (PPTuplePat [PrimitivePatPattern]
pppats)       = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
tupled ((PrimitivePatPattern -> Doc ann)
-> [PrimitivePatPattern] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map PrimitivePatPattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [PrimitivePatPattern]
pppats)

instance Pretty PrimitiveDataPattern where
  pretty :: PDPatternBase [Char] -> Doc ann
pretty PDPatternBase [Char]
PDWildCard                = [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"_"
  pretty (PDPatVar [Char]
x)              = [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
x
  pretty (PDInductivePat [Char]
x [PDPatternBase [Char]]
pdpats) = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
applyLike ([Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
x Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: (PDPatternBase [Char] -> Doc ann)
-> [PDPatternBase [Char]] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map PDPatternBase [Char] -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' [PDPatternBase [Char]]
pdpats)
  pretty (PDTuplePat [PDPatternBase [Char]]
pdpats)       = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
tupled ((PDPatternBase [Char] -> Doc ann)
-> [PDPatternBase [Char]] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map PDPatternBase [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [PDPatternBase [Char]]
pdpats)
  pretty PDPatternBase [Char]
PDEmptyPat                = [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"[]"
  pretty (PDConsPat PDPatternBase [Char]
pdp1 PDPatternBase [Char]
pdp2)     = PDPatternBase [Char] -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty'' PDPatternBase [Char]
pdp1 Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"::" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> PDPatternBase [Char] -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty'' PDPatternBase [Char]
pdp2
  pretty (PDSnocPat PDPatternBase [Char]
pdp1 PDPatternBase [Char]
pdp2)     = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
applyLike [[Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"snoc", PDPatternBase [Char] -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' PDPatternBase [Char]
pdp1, PDPatternBase [Char] -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' PDPatternBase [Char]
pdp2]
  pretty (PDConstantPat ConstantExpr
expr)      = ConstantExpr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ConstantExpr
expr

instance Pretty Op where
  pretty :: Op -> Doc ann
pretty Op
op | Op -> Bool
isWedge Op
op = [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ([Char]
"!" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Op -> [Char]
repr Op
op)
            | Bool
otherwise  = [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Op -> [Char]
repr Op
op)

instance Pretty IExpr where
  pretty :: IExpr -> Doc ann
pretty = IExpr -> Doc ann
forall a. HasCallStack => a
undefined

instance Complex IExpr where
  isAtom :: IExpr -> Bool
isAtom = IExpr -> Bool
forall a. HasCallStack => a
undefined
  isAtomOrApp :: IExpr -> Bool
isAtomOrApp = IExpr -> Bool
forall a. HasCallStack => a
undefined
  isInfix :: IExpr -> Bool
isInfix = IExpr -> Bool
forall a. HasCallStack => a
undefined

class Complex a where
  isAtom :: a -> Bool
  isAtomOrApp :: a -> Bool
  isInfix :: a -> Bool

instance Complex Expr where
  isAtom :: Expr -> Bool
isAtom (ConstantExpr (IntegerExpr Integer
i)) | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0  = Bool
False
  isAtom PrefixExpr{}             = Bool
False
  isAtom InfixExpr{}              = Bool
False
  isAtom (ApplyExpr Expr
_ [])         = Bool
True
  isAtom ApplyExpr{}              = Bool
False
  isAtom CApplyExpr{}             = Bool
False
  isAtom LambdaExpr{}             = Bool
False
  isAtom MemoizedLambdaExpr{}     = Bool
False
  isAtom CambdaExpr{}             = Bool
False
  isAtom PatternFunctionExpr{}    = Bool
False
  isAtom IfExpr{}                 = Bool
False
  isAtom LetRecExpr{}             = Bool
False
  isAtom SubrefsExpr{}            = Bool
False
  isAtom SuprefsExpr{}            = Bool
False
  isAtom UserrefsExpr{}           = Bool
False
  isAtom WithSymbolsExpr{}        = Bool
False
  isAtom MatchExpr{}              = Bool
False
  isAtom MatchAllExpr{}           = Bool
False
  isAtom MatchLambdaExpr{}        = Bool
False
  isAtom MatchAllLambdaExpr{}     = Bool
False
  isAtom MatcherExpr{}            = Bool
False
  isAtom AlgebraicDataMatcherExpr{} = Bool
False
  isAtom GenerateTensorExpr{}     = Bool
False
  isAtom TensorExpr{}             = Bool
False
  isAtom FunctionExpr{}           = Bool
False
  isAtom TensorContractExpr{}     = Bool
False
  isAtom TensorMapExpr{}          = Bool
False
  isAtom TensorMap2Expr{}         = Bool
False
  isAtom TransposeExpr{}          = Bool
False
  isAtom Expr
_                        = Bool
True

  isAtomOrApp :: Expr -> Bool
isAtomOrApp ApplyExpr{} = Bool
True
  isAtomOrApp Expr
e           = Expr -> Bool
forall a. Complex a => a -> Bool
isAtom Expr
e

  isInfix :: Expr -> Bool
isInfix InfixExpr{} = Bool
True
  isInfix Expr
_           = Bool
False

instance Complex a => Complex (Arg a) where
  isAtom :: Arg a -> Bool
isAtom (TensorArg a
x) = a -> Bool
forall a. Complex a => a -> Bool
isAtom a
x
  isAtom Arg a
_             = Bool
True

  isAtomOrApp :: Arg a -> Bool
isAtomOrApp = Arg a -> Bool
forall a. Complex a => a -> Bool
isAtom

  isInfix :: Arg a -> Bool
isInfix Arg a
_ = Bool
False

instance Complex ArgPattern where
  isAtom :: ArgPattern -> Bool
isAtom (APInductivePat [Char]
_ []) = Bool
True
  isAtom APInductivePat{}      = Bool
False
  isAtom APConsPat{}           = Bool
False
  isAtom APSnocPat{}           = Bool
False
  isAtom ArgPattern
_                     = Bool
True

  isAtomOrApp :: ArgPattern -> Bool
isAtomOrApp = ArgPattern -> Bool
forall a. Complex a => a -> Bool
isAtom
  isInfix :: ArgPattern -> Bool
isInfix ArgPattern
_ = Bool
False

instance Complex Pattern where
  isAtom :: Pattern -> Bool
isAtom LetPat{}            = Bool
False
  isAtom (InductivePat [Char]
_ []) = Bool
True
  isAtom (InductivePat [Char]
_ [Pattern]
_)  = Bool
False
  isAtom InfixPat{}          = Bool
False
  isAtom LoopPat{}           = Bool
False
  isAtom (PApplyPat Expr
_ [])    = Bool
True
  isAtom (PApplyPat Expr
_ [Pattern]
_)     = Bool
False
  isAtom Pattern
_                   = Bool
True

  isAtomOrApp :: Pattern -> Bool
isAtomOrApp PApplyPat{}    = Bool
True
  isAtomOrApp InductivePat{} = Bool
True
  isAtomOrApp Pattern
e              = Pattern -> Bool
forall a. Complex a => a -> Bool
isAtom Pattern
e

  isInfix :: Pattern -> Bool
isInfix InfixPat{} = Bool
True
  isInfix Pattern
_          = Bool
False

instance Complex PrimitiveDataPattern where
  isAtom :: PDPatternBase [Char] -> Bool
isAtom (PDInductivePat [Char]
_ []) = Bool
True
  isAtom (PDInductivePat [Char]
_ [PDPatternBase [Char]]
_)  = Bool
False
  isAtom PDConsPat{}           = Bool
False
  isAtom PDSnocPat{}           = Bool
False
  isAtom PDPatternBase [Char]
_                     = Bool
True

  isAtomOrApp :: PDPatternBase [Char] -> Bool
isAtomOrApp PDInductivePat{} = Bool
True
  isAtomOrApp PDSnocPat{}      = Bool
True
  isAtomOrApp PDPatternBase [Char]
e                = PDPatternBase [Char] -> Bool
forall a. Complex a => a -> Bool
isAtom PDPatternBase [Char]
e

  isInfix :: PDPatternBase [Char] -> Bool
isInfix PDConsPat{} = Bool
True
  isInfix PDPatternBase [Char]
_           = Bool
False

pretty' :: (Pretty a, Complex a) => a -> Doc ann
pretty' :: a -> Doc ann
pretty' a
x | a -> Bool
forall a. Complex a => a -> Bool
isAtom a
x  = a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
x
          | Bool
otherwise = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
x

pretty'' :: (Pretty a, Complex a) => a -> Doc ann
pretty'' :: a -> Doc ann
pretty'' a
x | a -> Bool
forall a. Complex a => a -> Bool
isAtomOrApp a
x Bool -> Bool -> Bool
|| a -> Bool
forall a. Complex a => a -> Bool
isInfix a
x = a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
x
           | Bool
otherwise                  = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
x

-- Display "hoge" instead of "() := hoge"
prettyDoBinds :: BindingExpr -> Doc ann
prettyDoBinds :: BindingExpr -> Doc ann
prettyDoBinds (Bind (PDTuplePat []) Expr
expr) = Expr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Expr
expr
prettyDoBinds BindingExpr
bind                        = [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"let" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> BindingExpr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty BindingExpr
bind

prettyMatch :: Expr -> [MatchClause] -> Doc ann
prettyMatch :: Expr -> [MatchClause] -> Doc ann
prettyMatch Expr
matcher [MatchClause]
clauses =
  [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"as" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
group (Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
flatAlt (Doc ann
forall ann. Doc ann
hardline Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Expr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Expr
matcher) (Doc ann
forall ann. Doc ann
space Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Expr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Expr
matcher) Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"with") Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
hardline Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<>
    Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep ((MatchClause -> Doc ann) -> [MatchClause] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map MatchClause -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [MatchClause]
clauses))

listoid :: String -> String -> [Doc ann] -> Doc ann
listoid :: [Char] -> [Char] -> [Doc ann] -> Doc ann
listoid [Char]
lp [Char]
rp [Doc ann]
elems =
  Doc ann -> Doc ann -> Doc ann -> [Doc ann] -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann -> [Doc ann] -> Doc ann
encloseSep ([Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
lp) ([Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
rp) (Doc ann
forall ann. Doc ann
comma Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
space) [Doc ann]
elems

-- Just like |fillSep|, but does not break the atomicity of grouped Docs
fillSepAtom :: [Doc ann] -> Doc ann
fillSepAtom :: [Doc ann] -> Doc ann
fillSepAtom [] = Doc ann
forall ann. Doc ann
emptyDoc
fillSepAtom [Doc ann
x] = Doc ann
x
fillSepAtom (Doc ann
x:[Doc ann]
xs) = Doc ann
x Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
fillSepAtom' [Doc ann]
xs
  where
    fillSepAtom' :: [Doc ann] -> Doc ann
fillSepAtom' [] = Doc ann
forall ann. Doc ann
emptyDoc
    fillSepAtom' (Doc ann
x:[Doc ann]
xs) =
      Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
group (Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
flatAlt (Doc ann
forall ann. Doc ann
hardline Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
x) (Doc ann
forall ann. Doc ann
space Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
x)) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Doc ann] -> Doc ann
fillSepAtom' [Doc ann]
xs

indentBlock :: Doc ann -> [Doc ann] -> Doc ann
indentBlock :: Doc ann -> [Doc ann] -> Doc ann
indentBlock Doc ann
header [Doc ann]
bodies =
  Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
group (Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
nest Int
2 (Doc ann
header Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
flatAlt (Doc ann
forall ann. Doc ann
hardline Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsepHard [Doc ann]
bodies) (Doc ann
forall ann. Doc ann
space Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep [Doc ann]
bodies)))

hsepHard :: [Doc ann] -> Doc ann
hsepHard :: [Doc ann] -> Doc ann
hsepHard = (Doc ann -> Doc ann -> Doc ann) -> [Doc ann] -> Doc ann
forall (t :: * -> *) ann.
Foldable t =>
(Doc ann -> Doc ann -> Doc ann) -> t (Doc ann) -> Doc ann
concatWith (\Doc ann
x Doc ann
y -> Doc ann
x Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
hardline Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
y)

lambdaLike :: Doc ann -> [Doc ann] -> Doc ann -> Doc ann -> Doc ann
lambdaLike :: Doc ann -> [Doc ann] -> Doc ann -> Doc ann -> Doc ann
lambdaLike Doc ann
start [] Doc ann
arrow Doc ann
body =
  Doc ann -> [Doc ann] -> Doc ann
forall ann. Doc ann -> [Doc ann] -> Doc ann
indentBlock (Doc ann
start Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
"()" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
arrow) [Doc ann
body]
lambdaLike Doc ann
start [Doc ann]
args Doc ann
arrow Doc ann
body =
  Doc ann -> [Doc ann] -> Doc ann
forall ann. Doc ann -> [Doc ann] -> Doc ann
indentBlock (Doc ann
start Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep [Doc ann]
args Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
arrow) [Doc ann
body]

applyLike :: [Doc ann] -> Doc ann
applyLike :: [Doc ann] -> Doc ann
applyLike = Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
hang Int
2 (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
sep ([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) -> [Doc ann] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
group

-- Tests if the argument can be printed in a single line, and if not,
-- inserts a line break before printing it.
-- This is useful for nicely printing infix expressions.
infixRight :: Doc ann -> Doc ann
infixRight :: Doc ann -> Doc ann
infixRight Doc ann
p = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
group (Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
flatAlt (Doc ann
forall ann. Doc ann
hardline Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
p) (Doc ann
forall ann. Doc ann
space Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
p))

showTSV :: EgisonValue -> String
showTSV :: EgisonValue -> [Char]
showTSV (Tuple (EgisonValue
val:[EgisonValue]
vals)) = ([Char] -> [Char] -> [Char]) -> [Char] -> [[Char]] -> [Char]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\[Char]
r [Char]
x -> [Char]
r [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\t" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
x) (EgisonValue -> [Char]
forall a. Show a => a -> [Char]
show EgisonValue
val) ((EgisonValue -> [Char]) -> [EgisonValue] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map EgisonValue -> [Char]
forall a. Show a => a -> [Char]
show [EgisonValue]
vals)
showTSV (Collection Seq EgisonValue
vals)  = [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"\t" ((EgisonValue -> [Char]) -> [EgisonValue] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map EgisonValue -> [Char]
forall a. Show a => a -> [Char]
show (Seq EgisonValue -> [EgisonValue]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq EgisonValue
vals))
showTSV EgisonValue
val                = EgisonValue -> [Char]
forall a. Show a => a -> [Char]
show EgisonValue
val

--
-- Pretty printer for error messages
--

prettyStr :: Pretty a => a -> String
prettyStr :: a -> [Char]
prettyStr = SimpleDocStream Any -> [Char]
forall ann. SimpleDocStream ann -> [Char]
renderString (SimpleDocStream Any -> [Char])
-> (a -> SimpleDocStream Any) -> a -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayoutOptions -> Doc Any -> SimpleDocStream Any
forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutPretty (PageWidth -> LayoutOptions
LayoutOptions PageWidth
Unbounded) (Doc Any -> SimpleDocStream Any)
-> (a -> Doc Any) -> a -> SimpleDocStream Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Doc Any
forall a ann. Pretty a => a -> Doc ann
pretty