{-# 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           Prettyprinter
import           Prettyprinter.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
forall ann. TopExpr -> Doc ann
pretty [TopExpr]
exprs)

instance Pretty TopExpr where
  pretty :: forall ann. TopExpr -> Doc ann
pretty (Define VarWithIndices
x (LambdaExpr [Arg ArgPattern]
args Expr
body)) =
    [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"def" Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: VarWithIndices -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. VarWithIndices -> 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 (String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
":=") [Expr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Expr -> Doc ann
pretty Expr
body]
  pretty (Define VarWithIndices
x Expr
expr) =
    String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"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
forall ann. VarWithIndices -> 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 (String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
":=") [Expr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Expr -> Doc ann
pretty Expr
expr]
  pretty (Test Expr
expr) = Expr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Expr -> Doc ann
pretty Expr
expr
  pretty (LoadFile String
file) = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"loadFile" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (String -> String
forall a. Show a => a -> String
show String
file)
  pretty (Load String
lib) = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"load" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (String -> String
forall a. Show a => a -> String
show String
lib)
  pretty TopExpr
_ = String -> Doc ann
forall a. HasCallStack => String -> a
error String
"Unsupported topexpr"

instance Pretty ConstantExpr where
  pretty :: forall ann. 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)  = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Text -> String
forall a. Show a => a -> String
ushow Text
x)
  pretty (BoolExpr Bool
x)    = Bool -> Doc ann
forall ann. Bool -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Bool
x
  pretty (IntegerExpr Integer
x) = Integer -> Doc ann
forall ann. Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Integer
x
  pretty (FloatExpr Double
x)   = Double -> Doc ann
forall ann. Double -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Double
x
  pretty ConstantExpr
SomethingExpr   = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"something"
  pretty ConstantExpr
UndefinedExpr   = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"undefined"

instance Pretty Expr where
  pretty :: forall ann. Expr -> Doc ann
pretty (ConstantExpr ConstantExpr
c) = ConstantExpr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ConstantExpr -> Doc ann
pretty ConstantExpr
c
  -- Use |viaShow| to correctly handle escaped characters
  pretty (VarExpr String
x)     = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
x
  pretty Expr
FreshVarExpr    = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"#"
  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
forall ann. IndexExpr Expr -> 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
<> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"..." 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
forall ann. IndexExpr Expr -> 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 [String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"subrefs" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> (if Bool
b then String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"!" 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 [String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"suprefs" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> (if Bool
b then String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"!" 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 [String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"userRefs" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> (if Bool
b then String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"!" 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
forall ann. Expr -> Doc ann
pretty [Expr]
xs)
  pretty (CollectionExpr [Expr]
xs)
    | [Expr] -> Int
forall a. [a] -> 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
forall ann. Expr -> Doc ann
pretty [Expr]
xs)
    | Bool
otherwise      =
      String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"[" 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
forall ann. Expr -> Doc ann
pretty [Expr]
xs))) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"]"
  pretty (HashExpr [(Expr, Expr)]
xs)   = String -> String -> [Doc ann] -> Doc ann
forall ann. String -> String -> [Doc ann] -> Doc ann
listoid String
"{|" String
"|}" (((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
forall ann. Expr -> Doc ann
pretty Expr
x, Expr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Expr -> Doc ann
pretty Expr
y]) [(Expr, Expr)]
xs)
  pretty (VectorExpr [Expr]
xs) = String -> String -> [Doc ann] -> Doc ann
forall ann. String -> String -> [Doc ann] -> Doc ann
listoid String
"[|" String
"|]" ((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
forall ann. Expr -> 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 (String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"\\") ((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
forall ann. Arg ArgPattern -> Doc ann
pretty [Arg ArgPattern]
xs) (String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"->") (Expr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Expr -> Doc ann
pretty Expr
e)
  pretty (MemoizedLambdaExpr [String]
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 (String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"memoizedLambda ") ((String -> Doc ann) -> [String] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [String]
xs) (String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"->") (Expr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Expr -> Doc ann
pretty Expr
e)
  pretty (CambdaExpr String
x Expr
e) =
    Doc ann -> [Doc ann] -> Doc ann
forall ann. Doc ann -> [Doc ann] -> Doc ann
indentBlock (String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"cambda" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
x Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"->") [Expr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Expr -> Doc ann
pretty Expr
e]
  pretty (PatternFunctionExpr [String]
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 (String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"\\") ((String -> Doc ann) -> [String] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [String]
xs) (String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"=>") (Pattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Pattern -> 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 (String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"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
forall ann. Expr -> Doc ann
pretty Expr
x)
      [String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"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
forall ann. Expr -> Doc ann
pretty Expr
y, String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"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
forall ann. Expr -> 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 (String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"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
forall ann. BindingExpr -> 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
<> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"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
forall ann. Expr -> Doc ann
pretty Expr
body))
  pretty (WithSymbolsExpr [String]
xs Expr
e) =
    Doc ann -> [Doc ann] -> Doc ann
forall ann. Doc ann -> [Doc ann] -> Doc ann
indentBlock (String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"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 ((String -> Doc ann) -> [String] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [String]
xs)) [Expr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Expr -> 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 (String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"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
forall ann. Expr -> 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 (String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"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
forall ann. Expr -> 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 (String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"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
forall ann. Expr -> 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 (String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"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
forall ann. Expr -> 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 (String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"\\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 (String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"\\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 (String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"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 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
<+> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"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 ann. 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
<+> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"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 ann. 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
<+> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"->") [a -> Doc ann
forall ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
expr]

  pretty (AlgebraicDataMatcherExpr [(String, [Expr])]
patDefs) =
    Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
nest Int
2 (String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"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 (((String, [Expr]) -> Doc ann) -> [(String, [Expr])] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map (String, [Expr]) -> Doc ann
forall {a} {a} {ann}. (Pretty a, Pretty a) => (a, [a]) -> Doc ann
prettyPatDef [(String, [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 ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
name Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: (a -> Doc ann) -> [a] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map a -> Doc ann
forall ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [a]
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 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
<> Expr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' Expr
e

  pretty (PrefixExpr String
op x :: Expr
x@(ConstantExpr (IntegerExpr Integer
_))) = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
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
forall ann. Expr -> Doc ann
pretty Expr
x
  pretty (PrefixExpr String
op Expr
x)
    | Expr -> Bool
forall a. Complex a => a -> Bool
isAtomOrApp Expr
x = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
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
forall ann. Expr -> Doc ann
pretty Expr
x
    | Bool
otherwise     = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
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
forall ann. Expr -> 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
forall ann. Expr -> 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
forall ann. Op -> 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
forall ann. Expr -> 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
forall ann. Op -> 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
forall ann. Op -> 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
forall ann. Expr -> 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
forall ann. Op -> 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
forall ann. Expr -> 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
forall ann. Op -> 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
forall ann. Op -> 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
forall ann. Expr -> 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
forall ann. Op -> 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
forall ann. Op -> 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
forall ann. Expr -> Doc ann
pretty Expr
x)

  pretty (DoExpr [] Expr
y) = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"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
forall ann. Expr -> Doc ann
pretty Expr
y
  pretty (DoExpr [BindingExpr]
xs (ApplyExpr (VarExpr String
"return") [])) =
    String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"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) = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"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
forall ann. Expr -> Doc ann
pretty Expr
y]))

  pretty (SeqExpr Expr
e1 Expr
e2) = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
applyLike [String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"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 [String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"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 ann. 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 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
<> Expr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' Expr
e
  pretty (AnonParamExpr Integer
n) = Char -> Doc ann
forall 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
<> Integer -> Doc ann
forall ann. 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 [String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"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 [String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"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 [String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"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 [String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"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 [String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"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 [String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"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
_) = String -> Doc ann
forall a. HasCallStack => String -> a
error String
"unreachable"

  pretty (FunctionExpr [String]
xs) = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"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 ((String -> Doc ann) -> [String] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [String]
xs)

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

instance (Pretty a, Complex a) => Pretty (Arg a) where
  pretty :: forall ann. Arg a -> Doc ann
pretty (ScalarArg a
x)         = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"$" 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) = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"*$" 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 ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
x

instance Pretty ArgPattern where
  pretty :: forall ann. ArgPattern -> Doc ann
pretty ArgPattern
APWildCard              = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"_"
  pretty (APPatVar VarWithIndices
x)            = VarWithIndices -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. VarWithIndices -> Doc ann
pretty VarWithIndices
x
  pretty (APInductivePat String
x [Arg ArgPattern]
args) = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
applyLike (String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
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
forall ann. Arg ArgPattern -> Doc ann
pretty [Arg ArgPattern]
args)
  pretty ArgPattern
APEmptyPat              = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"[]"
  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
<+> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"::" 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 [String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"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 :: forall ann. VarWithIndices -> Doc ann
pretty (VarWithIndices String
xs [VarIndex]
is) = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
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
forall ann. VarIndex -> Doc ann
pretty [VarIndex]
is)

instance Pretty VarIndex where
  pretty :: forall ann. VarIndex -> Doc ann
pretty (VSubscript String
x)        = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Char
'_' Char -> String -> String
forall a. a -> [a] -> [a]
: String
x)
  pretty (VSuperscript String
x)      = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Char
'~' Char -> String -> String
forall a. a -> [a] -> [a]
: String
x)
  pretty (VSymmScripts [VarIndex]
xs)     = Char -> Doc ann
forall 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
<> [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
forall ann. VarIndex -> Doc ann
pretty [VarIndex]
xs) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Char -> Doc ann
forall ann. Char -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Char
'}'
  pretty (VAntiSymmScripts [VarIndex]
xs) = Char -> Doc ann
forall 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
<> [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
forall ann. VarIndex -> Doc ann
pretty [VarIndex]
xs) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Char -> Doc ann
forall ann. Char -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Char
']'

instance Pretty BindingExpr where
  pretty :: forall ann. BindingExpr -> Doc ann
pretty (Bind (PDPatVar String
f) (LambdaExpr [Arg ArgPattern]
args Expr
body)) =
    [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
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 (String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
":=") [Expr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Expr -> Doc ann
pretty Expr
body]
  pretty (Bind PrimitiveDataPattern
pat Expr
expr) = PrimitiveDataPattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. PrimitiveDataPattern -> Doc ann
pretty PrimitiveDataPattern
pat Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
":=" 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
forall ann. Expr -> Doc ann
pretty Expr
expr)
  pretty (BindWithIndices VarWithIndices
var Expr
expr) = VarWithIndices -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. VarWithIndices -> Doc ann
pretty VarWithIndices
var Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
":=" 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
forall ann. Expr -> Doc ann
pretty Expr
expr)

instance {-# OVERLAPPING #-} Pretty MatchClause where
  pretty :: forall ann. 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
forall ann. Pattern -> 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 (String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"->") [Expr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Expr -> Doc ann
pretty Expr
expr]

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

instance (Pretty a, Complex a) => Pretty (IndexExpr a) where
  pretty :: forall ann. IndexExpr a -> Doc ann
pretty (Subscript a
i)          = Char -> Doc ann
forall 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
<> a -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' a
i
  pretty (Superscript a
i)        = Char -> Doc ann
forall 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
<> a -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' a
i
  pretty (SupSubscript a
i)       = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"~_" 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 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
<> 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
<> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"..._" 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 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
<> 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
<> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"...~" 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 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
<> a -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' a
i

instance Pretty Pattern where
  pretty :: forall ann. Pattern -> Doc ann
pretty Pattern
WildCard     = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"_"
  pretty (PatVar String
x)   = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"$" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
x
  pretty (ValuePat Expr
v) = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"#" 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)  = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"?" 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
forall ann. Pattern -> 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 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
<> Expr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' Expr
i) [Expr]
indices)
  pretty (LetPat [BindingExpr]
binds Pattern
pat) =
    String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"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
forall ann. BindingExpr -> Doc ann
pretty [BindingExpr]
binds)) Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"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
forall ann. Pattern -> 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
forall ann. Pattern -> Doc ann
pretty Pattern
p1) Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Op -> String
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
forall ann. Pattern -> Doc ann
pretty Pattern
p1          Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Op -> String
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
<+> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Op -> String
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
forall ann. Pattern -> 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
<+> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Op -> String
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
forall ann. Pattern -> 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
<+> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Op -> String
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) = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"!" 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
forall ann. Pattern -> Doc ann
pretty [Pattern]
pats
  pretty (InductivePat String
"nil" []) = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"[]"
  pretty (InductivePat String
"::" [Pattern
p, InductivePat String
"nil" []]) = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"[" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Pattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Pattern -> Doc ann
pretty Pattern
p Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"]"
  pretty (InductivePat String
ctor [Pattern]
xs) = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
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 String
i LoopRange
range Pattern
p1 Pattern
p2) =
    Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
hang Int
2 (String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"loop" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Char -> Doc ann
forall 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
<> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
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
forall ann. LoopRange -> 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 = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"..."
  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 String
x) = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Char
'~' Char -> String -> String
forall a. a -> [a] -> [a]
: String
x)
  pretty Pattern
SeqNilPat = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"{}"
  pretty (SeqConsPat Pattern
p1 Pattern
p2) = String -> String -> [Doc ann] -> Doc ann
forall ann. String -> String -> [Doc ann] -> Doc ann
listoid String
"{" String
"}" (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
forall ann. Pattern -> Doc ann
pretty Pattern
p1]
      f Pattern
p1 (SeqConsPat Pattern
p2 Pattern
p3) = Pattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Pattern -> 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
forall ann. Pattern -> Doc ann
pretty Pattern
p1, Pattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Pattern -> Doc ann
pretty Pattern
p2]
  pretty Pattern
LaterPatVar = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"@"
  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            = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Pattern -> String
forall a. Show a => a -> String
show Pattern
e)

instance {-# OVERLAPPING #-} Pretty LoopRange where
  pretty :: forall ann. LoopRange -> Doc ann
pretty (LoopRange Expr
from (ApplyExpr (VarExpr String
"from")
                                    [InfixExpr Op{ repr :: Op -> String
repr = String
"-'" } 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
forall ann. Expr -> Doc ann
pretty Expr
from, Pattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Pattern -> 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
forall ann. Expr -> Doc ann
pretty Expr
from, Expr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Expr -> Doc ann
pretty Expr
to, Pattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Pattern -> Doc ann
pretty Pattern
pat]

instance Pretty PrimitivePatPattern where
  pretty :: forall ann. PrimitivePatPattern -> Doc ann
pretty PrimitivePatPattern
PPWildCard                = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"_"
  pretty PrimitivePatPattern
PPPatVar                  = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"$"
  pretty (PPValuePat String
x)            = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Char
'#' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
'$' Char -> String -> String
forall a. a -> [a] -> [a]
: String
x)
  pretty (PPInductivePat String
x [PrimitivePatPattern]
pppats) = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
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
forall ann. PrimitivePatPattern -> 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
forall ann. PrimitivePatPattern -> Doc ann
pretty [PrimitivePatPattern]
pppats)

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

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

instance Pretty IExpr where
  pretty :: forall ann. 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 String
_ []) = 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 String
_ []) = Bool
True
  isAtom (InductivePat String
_ [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 :: PrimitiveDataPattern -> Bool
isAtom (PDInductivePat String
_ []) = Bool
True
  isAtom (PDInductivePat String
_ [PrimitiveDataPattern]
_)  = Bool
False
  isAtom PDConsPat{}           = Bool
False
  isAtom PDSnocPat{}           = Bool
False
  isAtom PrimitiveDataPattern
_                     = Bool
True

  isAtomOrApp :: PrimitiveDataPattern -> Bool
isAtomOrApp PDInductivePat{} = Bool
True
  isAtomOrApp PDSnocPat{}      = Bool
True
  isAtomOrApp PrimitiveDataPattern
e                = PrimitiveDataPattern -> Bool
forall a. Complex a => a -> Bool
isAtom PrimitiveDataPattern
e

  isInfix :: PrimitiveDataPattern -> Bool
isInfix PDConsPat{} = Bool
True
  isInfix PrimitiveDataPattern
_           = Bool
False

pretty' :: (Pretty a, Complex a) => a -> Doc ann
pretty' :: forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' a
x | a -> Bool
forall a. Complex a => a -> Bool
isAtom a
x  = a -> Doc ann
forall ann. 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 ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
x

pretty'' :: (Pretty a, Complex a) => a -> Doc ann
pretty'' :: forall a ann. (Pretty a, Complex a) => 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 ann. 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 ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
x

-- Display "hoge" instead of "() := hoge"
prettyDoBinds :: BindingExpr -> Doc ann
prettyDoBinds :: forall ann. BindingExpr -> Doc ann
prettyDoBinds (Bind (PDTuplePat []) Expr
expr) = Expr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Expr -> Doc ann
pretty Expr
expr
prettyDoBinds BindingExpr
bind                        = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"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
forall ann. BindingExpr -> Doc ann
pretty BindingExpr
bind

prettyMatch :: Expr -> [MatchClause] -> Doc ann
prettyMatch :: forall ann. Expr -> [MatchClause] -> Doc ann
prettyMatch Expr
matcher [MatchClause]
clauses =
  String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"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
forall ann. Expr -> 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
forall ann. Expr -> Doc ann
pretty Expr
matcher) Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"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 ann. MatchClause -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [MatchClause]
clauses))

listoid :: String -> String -> [Doc ann] -> Doc ann
listoid :: forall ann. String -> String -> [Doc ann] -> Doc ann
listoid String
lp String
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 (String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
lp) (String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
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 :: forall ann. [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 :: forall ann. 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 :: forall ann. [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 :: forall ann. 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
<> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"()" 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 :: forall ann. [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 :: forall ann. 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 -> String
showTSV (Tuple (EgisonValue
val:[EgisonValue]
vals)) = (String -> String -> String) -> String -> [String] -> String
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\String
r String
x -> String
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\t" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x) (EgisonValue -> String
forall a. Show a => a -> String
show EgisonValue
val) ((EgisonValue -> String) -> [EgisonValue] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map EgisonValue -> String
forall a. Show a => a -> String
show [EgisonValue]
vals)
showTSV (Collection Seq EgisonValue
vals)  = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\t" ((EgisonValue -> String) -> [EgisonValue] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map EgisonValue -> String
forall a. Show a => a -> String
show (Seq EgisonValue -> [EgisonValue]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq EgisonValue
vals))
showTSV EgisonValue
val                = EgisonValue -> String
forall a. Show a => a -> String
show EgisonValue
val

--
-- Pretty printer for error messages
--

prettyStr :: Pretty a => a -> String
prettyStr :: forall a. Pretty a => a -> String
prettyStr = SimpleDocStream Any -> String
forall ann. SimpleDocStream ann -> String
renderString (SimpleDocStream Any -> String)
-> (a -> SimpleDocStream Any) -> a -> String
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 ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty