{-# 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 hiding (TIPatternNode(..))
import           Language.Egison.IExpr (TIPatternNode(..))
import qualified Language.Egison.Type.Types as Types
import           Language.Egison.Type.Pretty (prettyTypeScheme)

--
-- 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 (PatternInductiveDecl String
typeName [String]
typeParams [PatternConstructor]
constructors) =
    let typeParamsDoc :: Doc ann
typeParamsDoc = if [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
typeParams then Doc ann
forall ann. Doc ann
emptyDoc else [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep ((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]
typeParams)
        constructorsDoc :: Doc ann
constructorsDoc = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ (PatternConstructor -> Doc ann)
-> [PatternConstructor] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map (\(PatternConstructor String
name [TypeExpr]
args) ->
          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
<+> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
name Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep ((TypeExpr -> Doc ann) -> [TypeExpr] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map TypeExpr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. TypeExpr -> Doc ann
pretty [TypeExpr]
args)) [PatternConstructor]
constructors
    in String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"inductive" 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
"pattern" 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
typeName Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
forall ann. Doc ann
typeParamsDoc 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
forall ann. Doc ann
constructorsDoc
  pretty (PatternFunctionDecl String
name [String]
typeParams [(String, TypeExpr)]
params TypeExpr
retType Pattern
body) =
    let typeParamsDoc :: Doc ann
typeParamsDoc = if [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
typeParams then Doc ann
forall ann. Doc ann
emptyDoc 
                        else Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
braces ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate (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]
typeParams))
        paramsDoc :: Doc ann
paramsDoc = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ ((String, TypeExpr) -> Doc ann)
-> [(String, TypeExpr)] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
pname, TypeExpr
ptype) -> 
          Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
pname 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
<+> TypeExpr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. TypeExpr -> Doc ann
pretty TypeExpr
ptype)) [(String, TypeExpr)]
params
    in 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
<+> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"pattern" 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
name Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
forall ann. Doc ann
typeParamsDoc Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> 
       Doc ann
forall ann. Doc ann
paramsDoc 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
<+> TypeExpr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. TypeExpr -> Doc ann
pretty TypeExpr
retType 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
<+> Pattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Pattern -> Doc ann
pretty Pattern
body
  pretty (DeclareSymbol [String]
names Maybe TypeExpr
mTypeExpr) =
    let namesDoc :: Doc ann
namesDoc = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate (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]
names)
        typeDoc :: Doc ann
typeDoc = case Maybe TypeExpr
mTypeExpr of
                    Just TypeExpr
typeExpr -> 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
<+> TypeExpr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. TypeExpr -> Doc ann
pretty TypeExpr
typeExpr
                    Maybe TypeExpr
Nothing -> Doc ann
forall ann. Doc ann
emptyDoc
    in String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"declare" 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
"symbol" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
forall ann. Doc ann
namesDoc Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
forall ann. Doc ann
typeDoc
  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 (TypedMemoizedLambdaExpr [TypedParam]
params TypeExpr
retType 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 ") ((TypedParam -> Doc ann) -> [TypedParam] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map TypedParam -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. TypedParam -> Doc ann
pretty [TypedParam]
params) (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
<+> TypeExpr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. TypeExpr -> Doc ann
pretty TypeExpr
retType 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 (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 {ann}. PatternDef -> Doc ann
prettyPatDef [PatternDef]
patDefs)))
      where
        prettyPatDef :: PatternDef -> Doc ann
prettyPatDef (PatternDef PrimitivePatPattern
pppat Expr
expr [(PrimitiveDataPattern, Expr)]
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
<+> PrimitivePatPattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. PrimitivePatPattern -> Doc ann
pretty PrimitivePatPattern
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 (Expr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Expr -> Doc ann
pretty Expr
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 (((PrimitiveDataPattern, Expr) -> Doc ann)
-> [(PrimitiveDataPattern, Expr)] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map (PrimitiveDataPattern, Expr) -> Doc ann
forall {a} {a} {ann}. (Pretty a, Pretty a) => (a, a) -> Doc ann
prettyPatBody [(PrimitiveDataPattern, Expr)]
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 (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 (Arg a
x)         = a -> Doc ann
forall ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
x
  pretty (InvertedArg 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

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)   = ArgPattern -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty'' 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
<+> 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)
  pretty (BindWithType TypedVarWithIndices
typedVar Expr
expr) =
    let constraints :: [ConstraintExpr]
constraints = TypedVarWithIndices -> [ConstraintExpr]
typedVarConstraints TypedVarWithIndices
typedVar
        constraintsDoc :: Doc ann
constraintsDoc = if [ConstraintExpr] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ConstraintExpr]
constraints
                         then Doc ann
forall a. Monoid a => a
mempty
                         else 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
hsep (Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate (String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
",") ((ConstraintExpr -> Doc ann) -> [ConstraintExpr] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map ConstraintExpr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ConstraintExpr -> Doc ann
pretty [ConstraintExpr]
constraints)) 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
forall ann. Doc ann
space
    in [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 (TypedVarWithIndices -> String
typedVarName TypedVarWithIndices
typedVar) Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: [Doc ann
forall ann. Doc ann
constraintsDoc | Bool -> Bool
not ([ConstraintExpr] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ConstraintExpr]
constraints)] [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. [a] -> [a] -> [a]
++ (TypedParam -> Doc ann) -> [TypedParam] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map TypedParam -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. TypedParam -> Doc ann
pretty (TypedVarWithIndices -> [TypedParam]
typedVarParams TypedVarWithIndices
typedVar)) 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
<+> TypeExpr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. TypeExpr -> Doc ann
pretty (TypedVarWithIndices -> TypeExpr
typedVarRetType TypedVarWithIndices
typedVar) 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 Pretty TypedParam where
  pretty :: forall ann. TypedParam -> Doc ann
pretty (TPVar String
name TypeExpr
ty) = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
name 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
<+> TypeExpr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. TypeExpr -> Doc ann
pretty TypeExpr
ty)
  pretty (TPInvertedVar String
name TypeExpr
ty) = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (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
<+> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
name 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
<+> TypeExpr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. TypeExpr -> Doc ann
pretty TypeExpr
ty)
  pretty (TPTuple [TypedParam]
elems) = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
comma ((TypedParam -> Doc ann) -> [TypedParam] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map TypedParam -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. TypedParam -> Doc ann
pretty [TypedParam]
elems)))
  pretty (TPWildcard TypeExpr
ty) = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (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
<+> 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
<+> TypeExpr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. TypeExpr -> Doc ann
pretty TypeExpr
ty)
  pretty (TPUntypedVar String
name) = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
name
  pretty TypedParam
TPUntypedWildcard = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"_"

instance Pretty TypeExpr where
  pretty :: forall ann. TypeExpr -> Doc ann
pretty TypeExpr
TEInt = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"Integer"
  pretty TypeExpr
TEMathExpr = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"MathExpr"
  pretty TypeExpr
TEFloat = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"Float"
  pretty TypeExpr
TEBool = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"Bool"
  pretty TypeExpr
TEChar = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"Char"
  pretty TypeExpr
TEString = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"String"
  pretty (TEVar String
v) = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
v
  pretty (TEList TypeExpr
t) = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
brackets (TypeExpr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. TypeExpr -> Doc ann
pretty TypeExpr
t)
  pretty (TETuple []) = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"()"
  pretty (TETuple [TypeExpr]
ts) = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
comma ((TypeExpr -> Doc ann) -> [TypeExpr] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map TypeExpr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. TypeExpr -> Doc ann
pretty [TypeExpr]
ts)))
  pretty (TEFun TypeExpr
t1 TypeExpr
t2) = TypeExpr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. TypeExpr -> Doc ann
pretty TypeExpr
t1 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
<+> TypeExpr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. TypeExpr -> Doc ann
pretty TypeExpr
t2
  pretty (TEMatcher TypeExpr
t) = 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 ann. Doc ann -> Doc ann -> Doc ann
<+> TypeExpr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. TypeExpr -> Doc ann
pretty TypeExpr
t
  pretty (TEPattern TypeExpr
t) = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"Pattern" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> TypeExpr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. TypeExpr -> Doc ann
pretty TypeExpr
t
  pretty (TEIO TypeExpr
t) = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"IO" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> TypeExpr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. TypeExpr -> Doc ann
pretty TypeExpr
t
  pretty (TETensor TypeExpr
t) = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"Tensor" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> TypeExpr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. TypeExpr -> Doc ann
pretty TypeExpr
t
  pretty (TEApp TypeExpr
t [TypeExpr]
args) = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (TypeExpr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. TypeExpr -> Doc ann
pretty TypeExpr
t Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: (TypeExpr -> Doc ann) -> [TypeExpr] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map TypeExpr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. TypeExpr -> Doc ann
pretty [TypeExpr]
args)

instance Pretty ConstraintExpr where
  pretty :: forall ann. ConstraintExpr -> Doc ann
pretty (ConstraintExpr String
cls [TypeExpr]
types) = [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
cls Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: (TypeExpr -> Doc ann) -> [TypeExpr] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map TypeExpr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. TypeExpr -> Doc ann
pretty [TypeExpr]
types)

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")
                                    [ApplyExpr (VarExpr String
"i.-") [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)     = 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 (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 (IConstantExpr ConstantExpr
c) = ConstantExpr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ConstantExpr -> Doc ann
pretty ConstantExpr
c
  pretty (IVarExpr String
name) = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
name
  
  pretty (IIndexedExpr Bool
override IExpr
expr [Index IExpr]
indices) =
    IExpr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' IExpr
expr Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> (if Bool
override 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) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hcat ((Index IExpr -> Doc ann) -> [Index IExpr] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Index IExpr -> Doc ann
forall {a} {ann}. (Complex a, Pretty a) => Index a -> Doc ann
prettyIndex [Index IExpr]
indices)
    where
      prettyIndex :: Index a -> Doc ann
prettyIndex (Sub a
e) = 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}. (Complex a, Pretty a) => a -> Doc ann
prettyIndexExpr a
e
      prettyIndex (Sup a
e) = 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}. (Complex a, Pretty a) => a -> Doc ann
prettyIndexExpr a
e
      prettyIndex (SupSub a
e) = 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}. (Complex a, Pretty a) => a -> Doc ann
prettyIndexExpr a
e
      prettyIndex (User a
e) = 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}. (Complex a, Pretty a) => a -> Doc ann
prettyIndexExpr a
e
      prettyIndex (DF Integer
_ Integer
_) = Doc ann
forall ann. Doc ann
emptyDoc
      prettyIndex (MultiSub a
_ Integer
_ a
_) = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"_..."
      prettyIndex (MultiSup a
_ Integer
_ a
_) = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"~..."
      prettyIndexExpr :: a -> Doc ann
prettyIndexExpr a
e = if a -> Bool
forall a. Complex a => a -> Bool
isAtom a
e then a -> Doc ann
forall ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
e else Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (a -> Doc ann
forall ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
e)
  
  pretty (ISubrefsExpr Bool
override IExpr
expr IExpr
subExpr) =
    IExpr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' IExpr
expr Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> (if Bool
override 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) 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
<> IExpr -> Doc ann
forall ann. IExpr -> Doc ann
prettyRefExpr IExpr
subExpr
  pretty (ISuprefsExpr Bool
override IExpr
expr IExpr
supExpr) =
    IExpr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' IExpr
expr Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> (if Bool
override 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) 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
<> IExpr -> Doc ann
forall ann. IExpr -> Doc ann
prettyRefExpr IExpr
supExpr
  pretty (IUserrefsExpr Bool
override IExpr
expr IExpr
userExpr) =
    IExpr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' IExpr
expr Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> (if Bool
override 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) 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
<> IExpr -> Doc ann
forall ann. IExpr -> Doc ann
prettyRefExpr IExpr
userExpr
  
  pretty (IInductiveDataExpr String
name [IExpr]
args)
    | [IExpr] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [IExpr]
args = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
name
    | Bool
otherwise = [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
name Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: (IExpr -> Doc ann) -> [IExpr] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map IExpr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' [IExpr]
args)
  
  pretty (ITupleExpr []) = 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
")"
  pretty (ITupleExpr [IExpr]
xs) = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
tupled ((IExpr -> Doc ann) -> [IExpr] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map IExpr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IExpr -> Doc ann
pretty [IExpr]
xs)
  
  pretty (ICollectionExpr [IExpr]
xs) = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
list ((IExpr -> Doc ann) -> [IExpr] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map IExpr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IExpr -> Doc ann
pretty [IExpr]
xs)
  
  pretty (IConsExpr IExpr
x IExpr
xs) = IExpr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty'' IExpr
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
"::" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> IExpr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty'' IExpr
xs
  pretty (IJoinExpr IExpr
x IExpr
xs) = IExpr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty'' IExpr
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
"++" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> IExpr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty'' IExpr
xs
  
  pretty (IHashExpr [(IExpr, IExpr)]
pairs) = 
    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
hsep (Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
comma (((IExpr, IExpr) -> Doc ann) -> [(IExpr, IExpr)] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map (IExpr, IExpr) -> Doc ann
forall {a} {a} {ann}. (Pretty a, Pretty a) => (a, a) -> Doc ann
prettyPair [(IExpr, IExpr)]
pairs)) 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
"|}"
    where prettyPair :: (a, a) -> Doc ann
prettyPair (a
k, a
v) = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (a -> Doc ann
forall ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
k Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
comma 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
v)
  
  pretty (IVectorExpr [IExpr]
xs) = 
    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
hsep (Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
comma ((IExpr -> Doc ann) -> [IExpr] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map IExpr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IExpr -> Doc ann
pretty [IExpr]
xs)) 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
"|]"
  
  pretty (ILambdaExpr Maybe Var
_mVar [Var]
params IExpr
body) =
    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
"\\") ((Var -> Doc ann) -> [Var] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Var -> Doc ann
forall {ann}. Var -> Doc ann
prettyVar [Var]
params) (String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"->") (IExpr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IExpr -> Doc ann
pretty IExpr
body)
    where prettyVar :: Var -> Doc ann
prettyVar (Var String
name []) = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
name
          prettyVar Var
v = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Var -> String
forall a. Show a => a -> String
show Var
v)  -- fallback for complex vars
  
  pretty (IMemoizedLambdaExpr [String]
xs IExpr
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
"->") (IExpr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IExpr -> Doc ann
pretty IExpr
e)
  
  pretty (ICambdaExpr String
x IExpr
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
"->") [IExpr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IExpr -> Doc ann
pretty IExpr
e]
  
  pretty (IIfExpr IExpr
cond IExpr
thenE IExpr
elseE) =
    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
<+> IExpr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IExpr -> Doc ann
pretty IExpr
cond)
      [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
<+> IExpr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IExpr -> Doc ann
pretty IExpr
thenE, 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
<+> IExpr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IExpr -> Doc ann
pretty IExpr
elseE]
  
  pretty (ILetRecExpr [IBindingExpr]
bindings IExpr
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 ((IBindingExpr -> Doc ann) -> [IBindingExpr] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map IBindingExpr -> Doc ann
forall ann. IBindingExpr -> Doc ann
prettyIBinding [IBindingExpr]
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 (IExpr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IExpr -> Doc ann
pretty IExpr
body))
  
  pretty (ILetExpr [IBindingExpr]
bindings IExpr
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 ((IBindingExpr -> Doc ann) -> [IBindingExpr] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map IBindingExpr -> Doc ann
forall ann. IBindingExpr -> Doc ann
prettyIBinding [IBindingExpr]
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 (IExpr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IExpr -> Doc ann
pretty IExpr
body))
  
  pretty (IWithSymbolsExpr [String]
xs IExpr
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)) [IExpr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IExpr -> Doc ann
pretty IExpr
e]
  
  pretty (IMatchExpr PMMode
BFSMode IExpr
tgt IExpr
matcher [IMatchClause]
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
<+> IExpr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IExpr -> Doc ann
pretty IExpr
tgt Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> IExpr -> [IMatchClause] -> Doc ann
forall ann. IExpr -> [IMatchClause] -> Doc ann
prettyIMatch IExpr
matcher [IMatchClause]
clauses)
  pretty (IMatchExpr PMMode
DFSMode IExpr
tgt IExpr
matcher [IMatchClause]
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
<+> IExpr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IExpr -> Doc ann
pretty IExpr
tgt Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> IExpr -> [IMatchClause] -> Doc ann
forall ann. IExpr -> [IMatchClause] -> Doc ann
prettyIMatch IExpr
matcher [IMatchClause]
clauses)
  
  pretty (IMatchAllExpr PMMode
BFSMode IExpr
tgt IExpr
matcher [IMatchClause]
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
<+> IExpr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IExpr -> Doc ann
pretty IExpr
tgt Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> IExpr -> [IMatchClause] -> Doc ann
forall ann. IExpr -> [IMatchClause] -> Doc ann
prettyIMatch IExpr
matcher [IMatchClause]
clauses)
  pretty (IMatchAllExpr PMMode
DFSMode IExpr
tgt IExpr
matcher [IMatchClause]
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
<+> IExpr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IExpr -> Doc ann
pretty IExpr
tgt Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> IExpr -> [IMatchClause] -> Doc ann
forall ann. IExpr -> [IMatchClause] -> Doc ann
prettyIMatch IExpr
matcher [IMatchClause]
clauses)
  
  pretty (IMatcherExpr [IPatternDef]
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 ((IPatternDef -> Doc ann) -> [IPatternDef] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map IPatternDef -> Doc ann
forall {a} {a} {a} {a} {ann}.
(Pretty a, Pretty a, Pretty a, Pretty a) =>
(a, a, [(a, a)]) -> Doc ann
prettyIPatDef [IPatternDef]
patDefs)))
    where
      prettyIPatDef :: (a, a, [(a, a)]) -> Doc ann
prettyIPatDef (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
prettyIPatBody [(a, a)]
body)))
      prettyIPatBody :: (a, a) -> Doc ann
prettyIPatBody (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 (IQuoteExpr IExpr
e) = Doc ann
forall ann. Doc ann
squote Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> IExpr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' IExpr
e
  pretty (IQuoteSymbolExpr IExpr
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
<> IExpr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' IExpr
e
  
  pretty (IWedgeApplyExpr IExpr
op [IExpr]
args) = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
applyLike (IExpr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' IExpr
op Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: (IExpr -> Doc ann) -> [IExpr] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map IExpr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' [IExpr]
args)
  
  pretty (IDoExpr [] IExpr
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
<+> IExpr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IExpr -> Doc ann
pretty IExpr
y
  pretty (IDoExpr [IBindingExpr]
xs IExpr
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 ((IBindingExpr -> Doc ann) -> [IBindingExpr] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map IBindingExpr -> Doc ann
forall ann. IBindingExpr -> Doc ann
prettyIDoBinds [IBindingExpr]
xs [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. [a] -> [a] -> [a]
++ [IExpr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IExpr -> Doc ann
pretty IExpr
y]))
  
  pretty (ISeqExpr IExpr
e1 IExpr
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", IExpr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' IExpr
e1, IExpr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' IExpr
e2]
  
  pretty (IApplyExpr IExpr
fn [IExpr]
args) = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
applyLike ((IExpr -> Doc ann) -> [IExpr] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map IExpr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' (IExpr
fn IExpr -> [IExpr] -> [IExpr]
forall a. a -> [a] -> [a]
: [IExpr]
args))
  
  pretty (IGenerateTensorExpr IExpr
gen IExpr
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", IExpr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' IExpr
gen, IExpr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' IExpr
shape]
  
  pretty (ITensorExpr IExpr
e1 IExpr
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", IExpr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' IExpr
e1, IExpr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' IExpr
e2]
  
  pretty (ITensorContractExpr IExpr
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", IExpr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' IExpr
e1]
  
  pretty (ITensorMapExpr IExpr
e1 IExpr
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", IExpr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' IExpr
e1, IExpr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' IExpr
e2]
  
  pretty (ITensorMap2Expr IExpr
e1 IExpr
e2 IExpr
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", IExpr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' IExpr
e1, IExpr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' IExpr
e2, IExpr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' IExpr
e3]

  pretty (ITensorMap2WedgeExpr IExpr
e1 IExpr
e2 IExpr
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
"tensorMap2Wedge", IExpr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' IExpr
e1, IExpr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' IExpr
e2, IExpr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' IExpr
e3]

  pretty (ITransposeExpr IExpr
e1 IExpr
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", IExpr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' IExpr
e1, IExpr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' IExpr
e2]
  
  pretty (IFlipIndicesExpr IExpr
e) =
    [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
"flipIndices", IExpr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' IExpr
e]
  
  pretty (IFunctionExpr [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)

prettyRefExpr :: IExpr -> Doc ann
prettyRefExpr :: forall ann. IExpr -> Doc ann
prettyRefExpr IExpr
e = if IExpr -> Bool
forall a. Complex a => a -> Bool
isAtom IExpr
e then IExpr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IExpr -> Doc ann
pretty IExpr
e else Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (IExpr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IExpr -> Doc ann
pretty IExpr
e)

prettyIBinding :: IBindingExpr -> Doc ann
prettyIBinding :: forall ann. IBindingExpr -> Doc ann
prettyIBinding (IPrimitiveDataPattern
pdpat, IExpr
expr) = IPrimitiveDataPattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IPrimitiveDataPattern -> Doc ann
pretty IPrimitiveDataPattern
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
":=" 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 (IExpr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IExpr -> Doc ann
pretty IExpr
expr)

prettyIDoBinds :: IBindingExpr -> Doc ann
prettyIDoBinds :: forall ann. IBindingExpr -> Doc ann
prettyIDoBinds (IPrimitiveDataPattern
pdpat, IExpr
expr) = IPrimitiveDataPattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IPrimitiveDataPattern -> Doc ann
pretty IPrimitiveDataPattern
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
"<-" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> IExpr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IExpr -> Doc ann
pretty IExpr
expr

prettyIMatch :: IExpr -> [IMatchClause] -> Doc ann
prettyIMatch :: forall ann. IExpr -> [IMatchClause] -> Doc ann
prettyIMatch IExpr
matcher [IMatchClause]
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 ann. Doc ann -> Doc ann -> Doc ann
<+> IExpr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IExpr -> Doc ann
pretty IExpr
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
<>
    Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
2 ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep ((IMatchClause -> Doc ann) -> [IMatchClause] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map IMatchClause -> Doc ann
forall {a} {a} {ann}. (Pretty a, Pretty a) => (a, a) -> Doc ann
prettyIClause [IMatchClause]
clauses))
  where
    prettyIClause :: (a, a) -> Doc ann
prettyIClause (a
pat, a
body) =
      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
<+> a -> Doc ann
forall ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
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
"->") [a -> Doc ann
forall ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
body]

instance Complex IExpr where
  isAtom :: IExpr -> Bool
isAtom (IConstantExpr (IntegerExpr Integer
i)) | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 = Bool
False
  isAtom (IConstantExpr ConstantExpr
_) = Bool
True
  isAtom (IVarExpr String
_) = Bool
True
  isAtom ITupleExpr{} = Bool
True
  isAtom ICollectionExpr{} = Bool
True
  isAtom IHashExpr{} = Bool
True
  isAtom IVectorExpr{} = Bool
True
  isAtom IMatcherExpr{} = Bool
True
  isAtom (IIndexedExpr Bool
_ IExpr
e [Index IExpr]
_) = IExpr -> Bool
forall a. Complex a => a -> Bool
isAtom IExpr
e
  isAtom (IInductiveDataExpr String
_ []) = Bool
True
  isAtom IExpr
_ = Bool
False
  
  isAtomOrApp :: IExpr -> Bool
isAtomOrApp (IApplyExpr IExpr
_ [IExpr]
_) = Bool
True
  isAtomOrApp (IInductiveDataExpr String
_ (IExpr
_:[IExpr]
_)) = Bool
True
  isAtomOrApp IExpr
e = IExpr -> Bool
forall a. Complex a => a -> Bool
isAtom IExpr
e
  
  isInfix :: IExpr -> Bool
isInfix IExpr
_ = Bool
False  -- IExpr doesn't have infix expressions (they're desugared)

instance Pretty IPrimitiveDataPattern where
  pretty :: forall ann. IPrimitiveDataPattern -> Doc ann
pretty (PDPatVar (Var String
name [])) = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
name
  pretty (PDPatVar Var
var) = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Var -> String
forall a. Show a => a -> String
show Var
var)
  pretty IPrimitiveDataPattern
PDWildCard = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"_"
  pretty (PDInductivePat String
name []) = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
name
  pretty (PDInductivePat String
name [IPrimitiveDataPattern]
pats) = [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
name Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: (IPrimitiveDataPattern -> Doc ann)
-> [IPrimitiveDataPattern] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map IPrimitiveDataPattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IPrimitiveDataPattern -> Doc ann
pretty [IPrimitiveDataPattern]
pats)
  pretty (PDTuplePat [IPrimitiveDataPattern]
pats) = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
tupled ((IPrimitiveDataPattern -> Doc ann)
-> [IPrimitiveDataPattern] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map IPrimitiveDataPattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IPrimitiveDataPattern -> Doc ann
pretty [IPrimitiveDataPattern]
pats)
  pretty IPrimitiveDataPattern
PDEmptyPat = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"[]"
  pretty (PDConsPat IPrimitiveDataPattern
pat1 IPrimitiveDataPattern
pat2) = IPrimitiveDataPattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IPrimitiveDataPattern -> Doc ann
pretty IPrimitiveDataPattern
pat1 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
<+> IPrimitiveDataPattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IPrimitiveDataPattern -> Doc ann
pretty IPrimitiveDataPattern
pat2
  pretty (PDSnocPat IPrimitiveDataPattern
pat1 IPrimitiveDataPattern
pat2) = IPrimitiveDataPattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IPrimitiveDataPattern -> Doc ann
pretty IPrimitiveDataPattern
pat1 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
<+> IPrimitiveDataPattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IPrimitiveDataPattern -> Doc ann
pretty IPrimitiveDataPattern
pat2
  pretty (PDConstantPat ConstantExpr
c) = ConstantExpr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ConstantExpr -> Doc ann
pretty ConstantExpr
c
  -- MathExpr primitive patterns
  pretty (PDDivPat IPrimitiveDataPattern
p1 IPrimitiveDataPattern
p2) = [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
"Div", IPrimitiveDataPattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IPrimitiveDataPattern -> Doc ann
pretty IPrimitiveDataPattern
p1, IPrimitiveDataPattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IPrimitiveDataPattern -> Doc ann
pretty IPrimitiveDataPattern
p2]
  pretty (PDPlusPat IPrimitiveDataPattern
p) = [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
"Plus", IPrimitiveDataPattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IPrimitiveDataPattern -> Doc ann
pretty IPrimitiveDataPattern
p]
  pretty (PDTermPat IPrimitiveDataPattern
p1 IPrimitiveDataPattern
p2) = [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
"Term", IPrimitiveDataPattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IPrimitiveDataPattern -> Doc ann
pretty IPrimitiveDataPattern
p1, IPrimitiveDataPattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IPrimitiveDataPattern -> Doc ann
pretty IPrimitiveDataPattern
p2]
  pretty (PDSymbolPat IPrimitiveDataPattern
p1 IPrimitiveDataPattern
p2) = [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
"Symbol", IPrimitiveDataPattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IPrimitiveDataPattern -> Doc ann
pretty IPrimitiveDataPattern
p1, IPrimitiveDataPattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IPrimitiveDataPattern -> Doc ann
pretty IPrimitiveDataPattern
p2]
  pretty (PDApply1Pat IPrimitiveDataPattern
p1 IPrimitiveDataPattern
p2) = [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
"Apply1", IPrimitiveDataPattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IPrimitiveDataPattern -> Doc ann
pretty IPrimitiveDataPattern
p1, IPrimitiveDataPattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IPrimitiveDataPattern -> Doc ann
pretty IPrimitiveDataPattern
p2]
  pretty (PDApply2Pat IPrimitiveDataPattern
p1 IPrimitiveDataPattern
p2 IPrimitiveDataPattern
p3) = [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
"Apply2", IPrimitiveDataPattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IPrimitiveDataPattern -> Doc ann
pretty IPrimitiveDataPattern
p1, IPrimitiveDataPattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IPrimitiveDataPattern -> Doc ann
pretty IPrimitiveDataPattern
p2, IPrimitiveDataPattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IPrimitiveDataPattern -> Doc ann
pretty IPrimitiveDataPattern
p3]
  pretty (PDApply3Pat IPrimitiveDataPattern
p1 IPrimitiveDataPattern
p2 IPrimitiveDataPattern
p3 IPrimitiveDataPattern
p4) = [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
"Apply3", IPrimitiveDataPattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IPrimitiveDataPattern -> Doc ann
pretty IPrimitiveDataPattern
p1, IPrimitiveDataPattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IPrimitiveDataPattern -> Doc ann
pretty IPrimitiveDataPattern
p2, IPrimitiveDataPattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IPrimitiveDataPattern -> Doc ann
pretty IPrimitiveDataPattern
p3, IPrimitiveDataPattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IPrimitiveDataPattern -> Doc ann
pretty IPrimitiveDataPattern
p4]
  pretty (PDApply4Pat IPrimitiveDataPattern
p1 IPrimitiveDataPattern
p2 IPrimitiveDataPattern
p3 IPrimitiveDataPattern
p4 IPrimitiveDataPattern
p5) = [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
"Apply4", IPrimitiveDataPattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IPrimitiveDataPattern -> Doc ann
pretty IPrimitiveDataPattern
p1, IPrimitiveDataPattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IPrimitiveDataPattern -> Doc ann
pretty IPrimitiveDataPattern
p2, IPrimitiveDataPattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IPrimitiveDataPattern -> Doc ann
pretty IPrimitiveDataPattern
p3, IPrimitiveDataPattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IPrimitiveDataPattern -> Doc ann
pretty IPrimitiveDataPattern
p4, IPrimitiveDataPattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IPrimitiveDataPattern -> Doc ann
pretty IPrimitiveDataPattern
p5]
  pretty (PDQuotePat IPrimitiveDataPattern
p) = [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
"Quote", IPrimitiveDataPattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IPrimitiveDataPattern -> Doc ann
pretty IPrimitiveDataPattern
p]
  pretty (PDFunctionPat IPrimitiveDataPattern
p1 IPrimitiveDataPattern
p2) = [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
"Function", IPrimitiveDataPattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IPrimitiveDataPattern -> Doc ann
pretty IPrimitiveDataPattern
p1, IPrimitiveDataPattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IPrimitiveDataPattern -> Doc ann
pretty IPrimitiveDataPattern
p2]
  pretty (PDSubPat IPrimitiveDataPattern
p) = [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
"Sub", IPrimitiveDataPattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IPrimitiveDataPattern -> Doc ann
pretty IPrimitiveDataPattern
p]
  pretty (PDSupPat IPrimitiveDataPattern
p) = [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
"Sup", IPrimitiveDataPattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IPrimitiveDataPattern -> Doc ann
pretty IPrimitiveDataPattern
p]
  pretty (PDUserPat IPrimitiveDataPattern
p) = [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
"User", IPrimitiveDataPattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IPrimitiveDataPattern -> Doc ann
pretty IPrimitiveDataPattern
p]

instance Pretty IPattern where
  pretty :: forall ann. IPattern -> Doc ann
pretty IPattern
IWildCard = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"_"
  pretty (IPatVar String
name) = 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
name  -- IPatVar is VarPat (~x, pattern variable reference)
  pretty (IValuePat IExpr
expr) = 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
<> IExpr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' IExpr
expr
  pretty (IPredPat IExpr
expr) = 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
<> IExpr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' IExpr
expr
  pretty (IIndexedPat IPattern
pat [IExpr]
indices) =
    IPattern -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' IPattern
pat Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hcat ((IExpr -> Doc ann) -> [IExpr] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map IExpr -> Doc ann
forall {a} {ann}. (Complex a, Pretty a) => a -> Doc ann
prettyIndex [IExpr]
indices)
    where
      prettyIndex :: a -> Doc ann
prettyIndex a
e = if a -> Bool
forall a. Complex a => a -> Bool
isAtom a
e then a -> Doc ann
forall ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
e else Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (a -> Doc ann
forall ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
e)
  pretty (ILetPat [IBindingExpr]
bindings IPattern
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 ((IBindingExpr -> Doc ann) -> [IBindingExpr] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map IBindingExpr -> Doc ann
forall ann. IBindingExpr -> Doc ann
prettyIBinding [IBindingExpr]
bindings)) 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
<+> IPattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IPattern -> Doc ann
pretty IPattern
pat
  pretty (INotPat IPattern
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
<> IPattern -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' IPattern
pat
  pretty (IAndPat IPattern
pat1 IPattern
pat2) = IPattern -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' IPattern
pat1 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
<+> IPattern -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' IPattern
pat2
  pretty (IOrPat IPattern
pat1 IPattern
pat2) = IPattern -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' IPattern
pat1 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
<+> IPattern -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' IPattern
pat2
  pretty (IForallPat IPattern
var IPattern
pat) = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"forall" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> IPattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IPattern -> Doc ann
pretty IPattern
var Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> IPattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IPattern -> Doc ann
pretty IPattern
pat
  pretty (ITuplePat [IPattern]
pats) = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
tupled ((IPattern -> Doc ann) -> [IPattern] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map IPattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IPattern -> Doc ann
pretty [IPattern]
pats)
  pretty (IInductivePat String
name []) = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
name
  pretty (IInductivePat String
name [IPattern]
pats) = [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
name Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: (IPattern -> Doc ann) -> [IPattern] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map IPattern -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' [IPattern]
pats)
  pretty (ILoopPat String
var (ILoopRange IExpr
start IExpr
end IPattern
pat) IPattern
bodyPat IPattern
restPat) =
    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
<+> 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
var 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 [IExpr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IExpr -> Doc ann
pretty IExpr
start, IExpr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IExpr -> Doc ann
pretty IExpr
end, IPattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IPattern -> Doc ann
pretty IPattern
pat] Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+>
    IPattern -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' IPattern
bodyPat Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> IPattern -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' IPattern
restPat
  pretty IPattern
IContPat = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"..."
  pretty (IPApplyPat IExpr
expr [IPattern]
pats) = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
applyLike (IExpr -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' IExpr
expr Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: (IPattern -> Doc ann) -> [IPattern] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map IPattern -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' [IPattern]
pats)
  pretty (IVarPat String
name) = 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
name  -- IVarPat is PatVar ($x, new binding)
  pretty (IInductiveOrPApplyPat String
name [IPattern]
pats)
    | [IPattern] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [IPattern]
pats = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
name
    | Bool
otherwise = [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
name Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: (IPattern -> Doc ann) -> [IPattern] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map IPattern -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' [IPattern]
pats)
  pretty IPattern
ISeqNilPat = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"{}"
  pretty (ISeqConsPat IPattern
p1 IPattern
p2) = String -> String -> [Doc ann] -> Doc ann
forall ann. String -> String -> [Doc ann] -> Doc ann
listoid String
"{" String
"}" (IPattern -> IPattern -> [Doc ann]
forall {ann}. IPattern -> IPattern -> [Doc ann]
f IPattern
p1 IPattern
p2)
    where
      f :: IPattern -> IPattern -> [Doc ann]
f IPattern
p1 IPattern
ISeqNilPat          = [IPattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IPattern -> Doc ann
pretty IPattern
p1]
      f IPattern
p1 (ISeqConsPat IPattern
p2 IPattern
p3) = IPattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IPattern -> Doc ann
pretty IPattern
p1 Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: IPattern -> IPattern -> [Doc ann]
f IPattern
p2 IPattern
p3
      f IPattern
p1 IPattern
p2                  = [IPattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IPattern -> Doc ann
pretty IPattern
p1, IPattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IPattern -> Doc ann
pretty IPattern
p2]
  pretty IPattern
ILaterPatVar = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"@"
  pretty (IDApplyPat IPattern
pat [IPattern]
pats) = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
applyLike (IPattern -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' IPattern
pat Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: (IPattern -> Doc ann) -> [IPattern] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map IPattern -> Doc ann
forall a ann. (Pretty a, Complex a) => a -> Doc ann
pretty' [IPattern]
pats)

instance Complex IPattern where
  isAtom :: IPattern -> Bool
isAtom IPattern
IWildCard = Bool
True
  isAtom (IPatVar String
_) = Bool
True
  isAtom (ITuplePat [IPattern]
_) = Bool
True
  isAtom (IInductivePat String
_ []) = Bool
True
  isAtom IPattern
ISeqNilPat = Bool
True
  isAtom IPattern
_ = Bool
False
  
  isAtomOrApp :: IPattern -> Bool
isAtomOrApp (IPApplyPat IExpr
_ [IPattern]
_) = Bool
True
  isAtomOrApp (IInductiveOrPApplyPat String
_ (IPattern
_:[IPattern]
_)) = Bool
True
  isAtomOrApp (IInductivePat String
_ (IPattern
_:[IPattern]
_)) = Bool
True
  isAtomOrApp IPattern
pat = IPattern -> Bool
forall a. Complex a => a -> Bool
isAtom IPattern
pat
  
  isInfix :: IPattern -> Bool
isInfix IPattern
_ = Bool
False

-- Pretty print for TIPattern (use existing prettyPatternWithType)
instance Pretty TIPattern where
  pretty :: forall ann. TIPattern -> Doc ann
pretty = TIPattern -> Doc ann
forall ann. TIPattern -> Doc ann
prettyPatternWithType

instance Complex TIPattern where
  isAtom :: TIPattern -> Bool
isAtom (TIPattern TypeScheme
_ TIPatternNode
TIWildCard) = Bool
True
  isAtom (TIPattern TypeScheme
_ (TIVarPat String
_)) = Bool
True
  isAtom (TIPattern TypeScheme
_ (TITuplePat [TIPattern]
_)) = Bool
True
  isAtom (TIPattern TypeScheme
_ (TIInductivePat String
_ [])) = Bool
True
  isAtom (TIPattern TypeScheme
_ TIPatternNode
TISeqNilPat) = Bool
True
  isAtom TIPattern
_ = Bool
False
  
  isAtomOrApp :: TIPattern -> Bool
isAtomOrApp (TIPattern TypeScheme
_ (TIPApplyPat TIExpr
_ [TIPattern]
_)) = Bool
True
  isAtomOrApp (TIPattern TypeScheme
_ (TIInductiveOrPApplyPat String
_ (TIPattern
_:[TIPattern]
_))) = Bool
True
  isAtomOrApp (TIPattern TypeScheme
_ (TIInductivePat String
_ (TIPattern
_:[TIPattern]
_))) = Bool
True
  isAtomOrApp TIPattern
pat = TIPattern -> Bool
forall a. Complex a => a -> Bool
isAtom TIPattern
pat
  
  isInfix :: TIPattern -> Bool
isInfix TIPattern
_ = Bool
False

-- Pretty print for ITopExpr
instance Pretty ITopExpr where
  pretty :: forall ann. ITopExpr -> Doc ann
pretty (IDefine Var
var IExpr
iexpr) =
    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
<+> Var -> Doc ann
forall {ann}. Var -> Doc ann
prettyVar Var
var 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
":=") [IExpr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IExpr -> Doc ann
pretty IExpr
iexpr]
  pretty (IDefineMany [(Var, IExpr)]
bindings) =
    [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep (((Var, IExpr) -> Doc ann) -> [(Var, IExpr)] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map (Var, IExpr) -> Doc ann
forall {a} {ann}. Pretty a => (Var, a) -> Doc ann
prettyDefineMany [(Var, IExpr)]
bindings)
    where
      prettyDefineMany :: (Var, a) -> Doc ann
prettyDefineMany (Var
var, a
iexpr) =
        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
<+> Var -> Doc ann
forall {ann}. Var -> Doc ann
prettyVar Var
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
<+> a -> Doc ann
forall ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
iexpr
  pretty (ITest IExpr
iexpr) = 
    IExpr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IExpr -> Doc ann
pretty IExpr
iexpr
  pretty (IExecute IExpr
iexpr) =
    String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"execute" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> IExpr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IExpr -> Doc ann
pretty IExpr
iexpr
  pretty (ILoadFile String
path) =
    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
path)
  pretty (ILoad 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 (IDeclareSymbol [String]
names Maybe Type
mType) =
    let namesDoc :: Doc ann
namesDoc = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate (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]
names)
        typeDoc :: Doc ann
typeDoc = case Maybe Type
mType of
                    Just Type
ty -> 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
<+> Type -> Doc ann
forall ann. Type -> Doc ann
prettyTypeDoc Type
ty
                    Maybe Type
Nothing -> Doc ann
forall ann. Doc ann
emptyDoc
    in String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"declare" 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
"symbol" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
forall ann. Doc ann
namesDoc Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
forall ann. Doc ann
typeDoc
  pretty (IPatternFunctionDecl String
name [TyVar]
tyVars [(String, Type)]
params Type
retType IPattern
body) =
    let tyVarsDoc :: Doc ann
tyVarsDoc = if [TyVar] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TyVar]
tyVars
                      then Doc ann
forall ann. Doc ann
emptyDoc
                      else 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
hsep (Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate (String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
",") ((TyVar -> Doc ann) -> [TyVar] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map TyVar -> Doc ann
forall {ann}. TyVar -> Doc ann
prettyTyVar [TyVar]
tyVars)) 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
"}"
        paramsDoc :: Doc ann
paramsDoc = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (((String, Type) -> Doc ann) -> [(String, Type)] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map (String, Type) -> Doc ann
forall {a} {ann}. Pretty a => (a, Type) -> Doc ann
prettyParam [(String, Type)]
params)
        retTypeDoc :: Doc ann
retTypeDoc = Type -> Doc ann
forall ann. Type -> Doc ann
prettyTypeDoc Type
retType
    in 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
<+> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"pattern" 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
name Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
forall ann. Doc ann
tyVarsDoc Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
forall ann. Doc ann
paramsDoc 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
forall ann. Doc ann
retTypeDoc 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
":=") [IPattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. IPattern -> Doc ann
pretty IPattern
body]
    where
      prettyTyVar :: TyVar -> Doc ann
prettyTyVar (Types.TyVar String
v) = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
v
      prettyParam :: (a, Type) -> Doc ann
prettyParam (a
pname, Type
pty) = 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 ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
pname 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
<+> Type -> Doc ann
forall ann. Type -> Doc ann
prettyTypeDoc Type
pty 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 print for TIExpr and TITopExpr
instance Pretty TIExpr where
  pretty :: forall ann. TIExpr -> Doc ann
pretty TIExpr
tiexpr = TIExpr -> Doc ann
forall ann. TIExpr -> Doc ann
prettyTIExprWithType TIExpr
tiexpr

-- Pretty print TIExpr with type annotations for all subexpressions
prettyTIExprWithType :: TIExpr -> Doc ann
prettyTIExprWithType :: forall ann. TIExpr -> Doc ann
prettyTIExprWithType TIExpr
tiexpr =
  let (Types.Forall [TyVar]
_ [Constraint]
constraints Type
ty) = TIExpr -> TypeScheme
tiScheme TIExpr
tiexpr
      constraintDoc :: Doc ann
constraintDoc = [Constraint] -> Doc ann
forall ann. [Constraint] -> Doc ann
prettyConstraintsDoc [Constraint]
constraints
  in Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (TIExprNode -> Doc ann
forall ann. TIExprNode -> Doc ann
prettyTIExprNode (TIExpr -> TIExprNode
tiExprNode TIExpr
tiexpr) 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
forall ann. Doc ann
constraintDoc Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Type -> Doc ann
forall ann. Type -> Doc ann
prettyTypeDoc Type
ty)

-- Pretty print pattern with type annotations (recursive)
prettyPatternWithType :: TIPattern -> Doc ann
prettyPatternWithType :: forall ann. TIPattern -> Doc ann
prettyPatternWithType (TIPattern (Types.Forall [TyVar]
_ [Constraint]
constraints Type
ty) TIPatternNode
node) =
  let constraintDoc :: Doc ann
constraintDoc = [Constraint] -> Doc ann
forall ann. [Constraint] -> Doc ann
prettyConstraintsDoc [Constraint]
constraints
  in Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (TIPatternNode -> Doc ann
forall ann. TIPatternNode -> Doc ann
prettyTIPatternNode TIPatternNode
node 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
forall ann. Doc ann
constraintDoc Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Type -> Doc ann
forall ann. Type -> Doc ann
prettyTypeDoc Type
ty)

-- Pretty print pattern node recursively
prettyTIPatternNode :: TIPatternNode -> Doc ann
prettyTIPatternNode :: forall ann. TIPatternNode -> Doc ann
prettyTIPatternNode TIPatternNode
node = case TIPatternNode
node of
  TIPatternNode
TIWildCard -> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"_"
  TIPatVar String
name -> 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
name  -- TIPatVar is VarPat (~x, pattern variable reference)
  TIValuePat TIExpr
expr -> 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
<> TIExpr -> Doc ann
forall ann. TIExpr -> Doc ann
prettyTIExprWithType TIExpr
expr
  TIPredPat TIExpr
expr -> 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
<> TIExpr -> Doc ann
forall ann. TIExpr -> Doc ann
prettyTIExprWithType TIExpr
expr
  TIIndexedPat TIPattern
pat [TIExpr]
exprs -> TIPattern -> Doc ann
forall ann. TIPattern -> Doc ann
prettyPatternWithType TIPattern
pat Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hcat ((TIExpr -> Doc ann) -> [TIExpr] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map TIExpr -> Doc ann
forall ann. TIExpr -> Doc ann
prettyIndexExpr [TIExpr]
exprs)
    where prettyIndexExpr :: TIExpr -> Doc ann
prettyIndexExpr TIExpr
e = 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
<> TIExpr -> Doc ann
forall ann. TIExpr -> Doc ann
prettyTIExprWithType TIExpr
e
  TILetPat [TIBindingExpr]
bindings TIPattern
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
hsep ((TIBindingExpr -> Doc ann) -> [TIBindingExpr] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map TIBindingExpr -> Doc ann
forall {a} {ann}. Pretty a => (a, TIExpr) -> Doc ann
prettyBinding [TIBindingExpr]
bindings) 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
<+> TIPattern -> Doc ann
forall ann. TIPattern -> Doc ann
prettyPatternWithType TIPattern
pat
    where prettyBinding :: (a, TIExpr) -> Doc ann
prettyBinding (a
p, TIExpr
e) = a -> Doc ann
forall ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
p 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
<+> TIExpr -> Doc ann
forall ann. TIExpr -> Doc ann
prettyTIExprWithType TIExpr
e
  TINotPat TIPattern
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
<> TIPattern -> Doc ann
forall ann. TIPattern -> Doc ann
prettyPatternWithType TIPattern
pat
  TIAndPat TIPattern
p1 TIPattern
p2 -> TIPattern -> Doc ann
forall ann. TIPattern -> Doc ann
prettyPatternWithType TIPattern
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 String
"&" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> TIPattern -> Doc ann
forall ann. TIPattern -> Doc ann
prettyPatternWithType TIPattern
p2
  TIOrPat TIPattern
p1 TIPattern
p2 -> TIPattern -> Doc ann
forall ann. TIPattern -> Doc ann
prettyPatternWithType TIPattern
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 String
"|" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> TIPattern -> Doc ann
forall ann. TIPattern -> Doc ann
prettyPatternWithType TIPattern
p2
  TIForallPat TIPattern
p1 TIPattern
p2 -> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"forall" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> TIPattern -> Doc ann
forall ann. TIPattern -> Doc ann
prettyPatternWithType TIPattern
p1 Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> TIPattern -> Doc ann
forall ann. TIPattern -> Doc ann
prettyPatternWithType TIPattern
p2
  TITuplePat [TIPattern]
pats -> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
tupled ((TIPattern -> Doc ann) -> [TIPattern] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map TIPattern -> Doc ann
forall ann. TIPattern -> Doc ann
prettyPatternWithType [TIPattern]
pats)
  TIInductivePat String
name [TIPattern]
pats -> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
name Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep ((TIPattern -> Doc ann) -> [TIPattern] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map TIPattern -> Doc ann
forall ann. TIPattern -> Doc ann
prettyPatternWithType [TIPattern]
pats)
  TILoopPat String
var (TILoopRange TIExpr
start TIExpr
end TIPattern
pat) TIPattern
p1 TIPattern
p2 ->
    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
<+> 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
var 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 [TIExpr -> Doc ann
forall ann. TIExpr -> Doc ann
prettyTIExprWithType TIExpr
start, TIExpr -> Doc ann
forall ann. TIExpr -> Doc ann
prettyTIExprWithType TIExpr
end, TIPattern -> Doc ann
forall ann. TIPattern -> Doc ann
prettyPatternWithType TIPattern
pat] Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+>
    TIPattern -> Doc ann
forall ann. TIPattern -> Doc ann
prettyPatternWithType TIPattern
p1 Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> TIPattern -> Doc ann
forall ann. TIPattern -> Doc ann
prettyPatternWithType TIPattern
p2
  TIPatternNode
TIContPat -> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"..."
  TIPApplyPat TIExpr
func [TIPattern]
pats -> TIExpr -> Doc ann
forall ann. TIExpr -> Doc ann
prettyTIExprWithType TIExpr
func 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 ((TIPattern -> Doc ann) -> [TIPattern] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map TIPattern -> Doc ann
forall ann. TIPattern -> Doc ann
prettyPatternWithType [TIPattern]
pats)
  TIVarPat String
name -> 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
name  -- TIVarPat is PatVar ($x, new binding)
  TIInductiveOrPApplyPat String
name [TIPattern]
pats -> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
name Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep ((TIPattern -> Doc ann) -> [TIPattern] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map TIPattern -> Doc ann
forall ann. TIPattern -> Doc ann
prettyPatternWithType [TIPattern]
pats)
  TIPatternNode
TISeqNilPat -> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"{}"
  TISeqConsPat TIPattern
p1 TIPattern
p2 -> String -> String -> [Doc ann] -> Doc ann
forall ann. String -> String -> [Doc ann] -> Doc ann
listoid String
"{" String
"}" (TIPattern -> TIPattern -> [Doc ann]
forall {ann}. TIPattern -> TIPattern -> [Doc ann]
f TIPattern
p1 TIPattern
p2)
    where
      f :: TIPattern -> TIPattern -> [Doc ann]
f TIPattern
p1 (TIPattern TypeScheme
_ TIPatternNode
TISeqNilPat)          = [TIPattern -> Doc ann
forall ann. TIPattern -> Doc ann
prettyPatternWithType TIPattern
p1]
      f TIPattern
p1 (TIPattern TypeScheme
_ (TISeqConsPat TIPattern
p2 TIPattern
p3)) = TIPattern -> Doc ann
forall ann. TIPattern -> Doc ann
prettyPatternWithType TIPattern
p1 Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: TIPattern -> TIPattern -> [Doc ann]
f TIPattern
p2 TIPattern
p3
      f TIPattern
p1 TIPattern
p2                                  = [TIPattern -> Doc ann
forall ann. TIPattern -> Doc ann
prettyPatternWithType TIPattern
p1, TIPattern -> Doc ann
forall ann. TIPattern -> Doc ann
prettyPatternWithType TIPattern
p2]
  TIPatternNode
TILaterPatVar -> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"@"
  TIDApplyPat TIPattern
pat [TIPattern]
pats -> TIPattern -> Doc ann
forall ann. TIPattern -> Doc ann
prettyPatternWithType TIPattern
pat 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 ((TIPattern -> Doc ann) -> [TIPattern] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map TIPattern -> Doc ann
forall ann. TIPattern -> Doc ann
prettyPatternWithType [TIPattern]
pats)

-- Pretty print TIExprNode recursively
prettyTIExprNode :: TIExprNode -> Doc ann
prettyTIExprNode :: forall ann. TIExprNode -> Doc ann
prettyTIExprNode TIExprNode
node = case TIExprNode
node of
  TIConstantExpr ConstantExpr
c -> ConstantExpr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ConstantExpr -> Doc ann
pretty ConstantExpr
c
  TIVarExpr String
name -> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
name
  
  TILambdaExpr Maybe Var
_ [Var]
params TIExpr
body ->
    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
hsep ((Var -> Doc ann) -> [Var] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Var -> Doc ann
forall {ann}. Var -> Doc ann
prettyVar [Var]
params) 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
<+> TIExpr -> Doc ann
forall ann. TIExpr -> Doc ann
prettyTIExprWithType TIExpr
body
  
  TIApplyExpr TIExpr
func [TIExpr]
args ->
    TIExpr -> Doc ann
forall ann. TIExpr -> Doc ann
prettyTIExprWithType TIExpr
func 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 ((TIExpr -> Doc ann) -> [TIExpr] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map TIExpr -> Doc ann
forall ann. TIExpr -> Doc ann
prettyTIExprWithType [TIExpr]
args)
  
  TITupleExpr [TIExpr]
exprs ->
    [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
tupled ((TIExpr -> Doc ann) -> [TIExpr] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map TIExpr -> Doc ann
forall ann. TIExpr -> Doc ann
prettyTIExprWithType [TIExpr]
exprs)
  
  TICollectionExpr [TIExpr]
exprs ->
    Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
brackets ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
comma ((TIExpr -> Doc ann) -> [TIExpr] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map TIExpr -> Doc ann
forall ann. TIExpr -> Doc ann
prettyTIExprWithType [TIExpr]
exprs))
  
  TIConsExpr TIExpr
h TIExpr
t ->
    TIExpr -> Doc ann
forall ann. TIExpr -> Doc ann
prettyTIExprWithType TIExpr
h 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
<+> TIExpr -> Doc ann
forall ann. TIExpr -> Doc ann
prettyTIExprWithType TIExpr
t
  
  TIJoinExpr TIExpr
l TIExpr
r ->
    TIExpr -> Doc ann
forall ann. TIExpr -> Doc ann
prettyTIExprWithType TIExpr
l 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
<+> TIExpr -> Doc ann
forall ann. TIExpr -> Doc ann
prettyTIExprWithType TIExpr
r
  
  TIIfExpr TIExpr
cond TIExpr
thenE TIExpr
elseE ->
    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
<+> TIExpr -> Doc ann
forall ann. TIExpr -> Doc ann
prettyTIExprWithType TIExpr
cond 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
"then" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> TIExpr -> Doc ann
forall ann. TIExpr -> Doc ann
prettyTIExprWithType TIExpr
thenE 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
"else" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> TIExpr -> Doc ann
forall ann. TIExpr -> Doc ann
prettyTIExprWithType TIExpr
elseE
  
  TILetExpr [TIBindingExpr]
bindings TIExpr
body ->
    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
vsep ((TIBindingExpr -> Doc ann) -> [TIBindingExpr] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map TIBindingExpr -> Doc ann
forall {a} {ann}. Pretty a => (a, TIExpr) -> Doc ann
prettyBinding [TIBindingExpr]
bindings) 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
<+> TIExpr -> Doc ann
forall ann. TIExpr -> Doc ann
prettyTIExprWithType TIExpr
body
    where prettyBinding :: (a, TIExpr) -> Doc ann
prettyBinding (a
pat, TIExpr
expr) = a -> Doc ann
forall ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
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
<+> TIExpr -> Doc ann
forall ann. TIExpr -> Doc ann
prettyTIExprWithType TIExpr
expr
  
  TITensorMapExpr TIExpr
func TIExpr
tensor ->
    String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"tensorMap" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> TIExpr -> Doc ann
forall ann. TIExpr -> Doc ann
prettyTIExprWithType TIExpr
func Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> TIExpr -> Doc ann
forall ann. TIExpr -> Doc ann
prettyTIExprWithType TIExpr
tensor
  
  TITensorMap2Expr TIExpr
func TIExpr
t1 TIExpr
t2 ->
    String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"tensorMap2" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> TIExpr -> Doc ann
forall ann. TIExpr -> Doc ann
prettyTIExprWithType TIExpr
func Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> TIExpr -> Doc ann
forall ann. TIExpr -> Doc ann
prettyTIExprWithType TIExpr
t1 Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> TIExpr -> Doc ann
forall ann. TIExpr -> Doc ann
prettyTIExprWithType TIExpr
t2

  TITensorMap2WedgeExpr TIExpr
func TIExpr
t1 TIExpr
t2 ->
    String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"tensorMap2Wedge" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> TIExpr -> Doc ann
forall ann. TIExpr -> Doc ann
prettyTIExprWithType TIExpr
func Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> TIExpr -> Doc ann
forall ann. TIExpr -> Doc ann
prettyTIExprWithType TIExpr
t1 Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> TIExpr -> Doc ann
forall ann. TIExpr -> Doc ann
prettyTIExprWithType TIExpr
t2

  TITensorContractExpr TIExpr
tensor ->
    String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"contract" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> TIExpr -> Doc ann
forall ann. TIExpr -> Doc ann
prettyTIExprWithType TIExpr
tensor
  
  TITensorExpr TIExpr
shape TIExpr
elems ->
    String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"tensor" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> TIExpr -> Doc ann
forall ann. TIExpr -> Doc ann
prettyTIExprWithType TIExpr
shape Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> TIExpr -> Doc ann
forall ann. TIExpr -> Doc ann
prettyTIExprWithType TIExpr
elems
  
  TIGenerateTensorExpr TIExpr
func TIExpr
shape ->
    String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"generateTensor" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> TIExpr -> Doc ann
forall ann. TIExpr -> Doc ann
prettyTIExprWithType TIExpr
func Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> TIExpr -> Doc ann
forall ann. TIExpr -> Doc ann
prettyTIExprWithType TIExpr
shape
  
  TITransposeExpr TIExpr
perm TIExpr
tensor ->
    String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"transpose" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> TIExpr -> Doc ann
forall ann. TIExpr -> Doc ann
prettyTIExprWithType TIExpr
perm Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> TIExpr -> Doc ann
forall ann. TIExpr -> Doc ann
prettyTIExprWithType TIExpr
tensor
  
  TIFlipIndicesExpr TIExpr
tensor ->
    String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"flipIndices" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> TIExpr -> Doc ann
forall ann. TIExpr -> Doc ann
prettyTIExprWithType TIExpr
tensor
  
  TIVectorExpr [TIExpr]
exprs ->
    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
hsep (Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
comma ((TIExpr -> Doc ann) -> [TIExpr] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map TIExpr -> Doc ann
forall ann. TIExpr -> Doc ann
prettyTIExprWithType [TIExpr]
exprs)) 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
"|]"
  
  TIHashExpr [(TIExpr, TIExpr)]
pairs ->
    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
hsep (Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
comma (((TIExpr, TIExpr) -> Doc ann) -> [(TIExpr, TIExpr)] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map (TIExpr, TIExpr) -> Doc ann
forall {ann}. (TIExpr, TIExpr) -> Doc ann
prettyPair [(TIExpr, TIExpr)]
pairs)) 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
"|}"
    where prettyPair :: (TIExpr, TIExpr) -> Doc ann
prettyPair (TIExpr
k, TIExpr
v) = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (TIExpr -> Doc ann
forall ann. TIExpr -> Doc ann
prettyTIExprWithType TIExpr
k Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
comma Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> TIExpr -> Doc ann
forall ann. TIExpr -> Doc ann
prettyTIExprWithType TIExpr
v)
  
  TISeqExpr TIExpr
e1 TIExpr
e2 ->
    TIExpr -> Doc ann
forall ann. TIExpr -> Doc ann
prettyTIExprWithType TIExpr
e1 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
<+> TIExpr -> Doc ann
forall ann. TIExpr -> Doc ann
prettyTIExprWithType TIExpr
e2
  
  TIMemoizedLambdaExpr [String]
params TIExpr
body ->
    String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"memoizedLambda" 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 ((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]
params) 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
<+> TIExpr -> Doc ann
forall ann. TIExpr -> Doc ann
prettyTIExprWithType TIExpr
body
  
  TICambdaExpr String
param TIExpr
body ->
    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
param 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
<+> TIExpr -> Doc ann
forall ann. TIExpr -> Doc ann
prettyTIExprWithType TIExpr
body
  
  TIWithSymbolsExpr [String]
syms TIExpr
body ->
    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]
syms) Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> TIExpr -> Doc ann
forall ann. TIExpr -> Doc ann
prettyTIExprWithType TIExpr
body
  
  TIDoExpr [TIBindingExpr]
bindings TIExpr
body ->
    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
vsep ((TIBindingExpr -> Doc ann) -> [TIBindingExpr] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map TIBindingExpr -> Doc ann
forall {a} {ann}. Pretty a => (a, TIExpr) -> Doc ann
prettyBinding [TIBindingExpr]
bindings) Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> TIExpr -> Doc ann
forall ann. TIExpr -> Doc ann
prettyTIExprWithType TIExpr
body
    where prettyBinding :: (a, TIExpr) -> Doc ann
prettyBinding (a
pat, TIExpr
expr) = a -> Doc ann
forall ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
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
<+> TIExpr -> Doc ann
forall ann. TIExpr -> Doc ann
prettyTIExprWithType TIExpr
expr
  
  TIMatchExpr PMMode
_mode TIExpr
target TIExpr
matcher [TIMatchClause]
clauses ->
    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
<+> TIExpr -> Doc ann
forall ann. TIExpr -> Doc ann
prettyTIExprWithType TIExpr
target 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
<+> TIExpr -> Doc ann
forall ann. TIExpr -> Doc ann
prettyTIExprWithType TIExpr
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 ann. Doc ann -> Doc ann -> Doc ann
<+> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep ((TIMatchClause -> Doc ann) -> [TIMatchClause] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map TIMatchClause -> Doc ann
forall {ann}. TIMatchClause -> Doc ann
prettyClause [TIMatchClause]
clauses)
    where prettyClause :: TIMatchClause -> Doc ann
prettyClause (TIPattern
tipat, TIExpr
body) = 
            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
<+> TIPattern -> Doc ann
forall ann. TIPattern -> Doc ann
prettyPatternWithType TIPattern
tipat 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
<+> TIExpr -> Doc ann
forall ann. TIExpr -> Doc ann
prettyTIExprWithType TIExpr
body

  TIMatchAllExpr PMMode
_mode TIExpr
target TIExpr
matcher [TIMatchClause]
clauses ->
    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
<+> TIExpr -> Doc ann
forall ann. TIExpr -> Doc ann
prettyTIExprWithType TIExpr
target 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
<+> TIExpr -> Doc ann
forall ann. TIExpr -> Doc ann
prettyTIExprWithType TIExpr
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 ann. Doc ann -> Doc ann -> Doc ann
<+> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep ((TIMatchClause -> Doc ann) -> [TIMatchClause] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map TIMatchClause -> Doc ann
forall {ann}. TIMatchClause -> Doc ann
prettyClause [TIMatchClause]
clauses)
    where prettyClause :: TIMatchClause -> Doc ann
prettyClause (TIPattern
tipat, TIExpr
body) = 
            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
<+> TIPattern -> Doc ann
forall ann. TIPattern -> Doc ann
prettyPatternWithType TIPattern
tipat 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
<+> TIExpr -> Doc ann
forall ann. TIExpr -> Doc ann
prettyTIExprWithType TIExpr
body
  
  TIInductiveDataExpr String
name [TIExpr]
exprs ->
    String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
name Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep ((TIExpr -> Doc ann) -> [TIExpr] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map TIExpr -> Doc ann
forall ann. TIExpr -> Doc ann
prettyTIExprWithType [TIExpr]
exprs)
  
  TIQuoteExpr TIExpr
e ->
    Doc ann
forall ann. Doc ann
squote Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> TIExpr -> Doc ann
forall ann. TIExpr -> Doc ann
prettyTIExprWithType TIExpr
e
  
  TIQuoteSymbolExpr TIExpr
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
<> TIExpr -> Doc ann
forall ann. TIExpr -> Doc ann
prettyTIExprWithType TIExpr
e
  
  TISubrefsExpr Bool
_ TIExpr
base TIExpr
ref ->
    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 ann. Doc ann -> Doc ann -> Doc ann
<+> TIExpr -> Doc ann
forall ann. TIExpr -> Doc ann
prettyTIExprWithType TIExpr
base Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> TIExpr -> Doc ann
forall ann. TIExpr -> Doc ann
prettyTIExprWithType TIExpr
ref
  
  TISuprefsExpr Bool
_ TIExpr
base TIExpr
ref ->
    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 ann. Doc ann -> Doc ann -> Doc ann
<+> TIExpr -> Doc ann
forall ann. TIExpr -> Doc ann
prettyTIExprWithType TIExpr
base Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> TIExpr -> Doc ann
forall ann. TIExpr -> Doc ann
prettyTIExprWithType TIExpr
ref
  
  TIUserrefsExpr Bool
_ TIExpr
base TIExpr
ref ->
    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 ann. Doc ann -> Doc ann -> Doc ann
<+> TIExpr -> Doc ann
forall ann. TIExpr -> Doc ann
prettyTIExprWithType TIExpr
base Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> TIExpr -> Doc ann
forall ann. TIExpr -> Doc ann
prettyTIExprWithType TIExpr
ref
  
  TIWedgeApplyExpr TIExpr
func [TIExpr]
args ->
    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
<+> TIExpr -> Doc ann
forall ann. TIExpr -> Doc ann
prettyTIExprWithType TIExpr
func 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 ((TIExpr -> Doc ann) -> [TIExpr] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map TIExpr -> Doc ann
forall ann. TIExpr -> Doc ann
prettyTIExprWithType [TIExpr]
args)
  
  TIIndexedExpr Bool
_ TIExpr
base [Index TIExpr]
indices ->
    TIExpr -> Doc ann
forall ann. TIExpr -> Doc ann
prettyTIExprWithType TIExpr
base Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hcat ((Index TIExpr -> Doc ann) -> [Index TIExpr] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Index TIExpr -> Doc ann
forall {a} {ann}. Pretty a => Index a -> Doc ann
prettyIndex [Index TIExpr]
indices)
    where
      prettyIndex :: Index a -> Doc ann
prettyIndex (Sub a
e) = 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 ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
e
      prettyIndex (Sup a
e) = 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 ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
e
      prettyIndex (SupSub a
e) = 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 ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
e
      prettyIndex (User a
e) = 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 ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
e
      prettyIndex (MultiSub a
e1 Integer
n a
e2) = 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 ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
e1 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 Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> a -> Doc ann
forall ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
e2
      prettyIndex (MultiSup a
e1 Integer
n a
e2) = 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 ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
e1 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 Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> a -> Doc ann
forall ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
e2
      prettyIndex (DF Integer
_i1 Integer
_i2) = Doc ann
forall ann. Doc ann
emptyDoc
  
  TIFunctionExpr [String]
names ->
    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
hsep ((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]
names)
  
  TILetRecExpr [TIBindingExpr]
bindings TIExpr
body ->
    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
vsep ((TIBindingExpr -> Doc ann) -> [TIBindingExpr] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map TIBindingExpr -> Doc ann
forall {a} {ann}. Pretty a => (a, TIExpr) -> Doc ann
prettyBinding [TIBindingExpr]
bindings) 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
<+> TIExpr -> Doc ann
forall ann. TIExpr -> Doc ann
prettyTIExprWithType TIExpr
body
    where prettyBinding :: (a, TIExpr) -> Doc ann
prettyBinding (a
pat, TIExpr
expr) = a -> Doc ann
forall ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
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
<+> TIExpr -> Doc ann
forall ann. TIExpr -> Doc ann
prettyTIExprWithType TIExpr
expr
  
  TIMatcherExpr [TIPatternDef]
patDefs ->
    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 ann. Doc ann -> Doc ann -> Doc ann
<+> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep ((TIPatternDef -> Doc ann) -> [TIPatternDef] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map TIPatternDef -> Doc ann
forall {a} {c} {ann}. Pretty a => (a, TIExpr, c) -> Doc ann
prettyPatDef [TIPatternDef]
patDefs)
    where prettyPatDef :: (a, TIExpr, c) -> Doc ann
prettyPatDef (a
pat, TIExpr
expr, c
_bindings) = a -> Doc ann
forall ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
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
<+> TIExpr -> Doc ann
forall ann. TIExpr -> Doc ann
prettyTIExprWithType TIExpr
expr

instance Pretty TITopExpr where
  pretty :: forall ann. TITopExpr -> Doc ann
pretty (TIDefine TypeScheme
scheme Var
var TIExpr
tiexpr) =
    let typeStr :: String
typeStr = TypeScheme -> String
prettyTypeScheme TypeScheme
scheme
    in 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
<+> Var -> Doc ann
forall {ann}. Var -> Doc ann
prettyVar Var
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
<+> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
typeStr 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
":=") [TIExpr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. TIExpr -> Doc ann
pretty TIExpr
tiexpr]
  pretty (TITest TIExpr
tiexpr) = 
    TIExpr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. TIExpr -> Doc ann
pretty TIExpr
tiexpr
  pretty (TIExecute TIExpr
tiexpr) =
    String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"execute" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> TIExpr -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. TIExpr -> Doc ann
pretty TIExpr
tiexpr
  pretty (TILoadFile String
path) =
    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
path)
  pretty (TILoad 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 (TIDefineMany [(Var, TIExpr)]
bindings) =
    [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep (((Var, TIExpr) -> Doc ann) -> [(Var, TIExpr)] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map (Var, TIExpr) -> Doc ann
forall {a} {ann}. Pretty a => (Var, a) -> Doc ann
prettyBinding [(Var, TIExpr)]
bindings)
    where
      prettyBinding :: (Var, a) -> Doc ann
prettyBinding (Var
var, a
tiexpr) =
        Var -> Doc ann
forall {ann}. Var -> Doc ann
prettyVar Var
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
<+> a -> Doc ann
forall ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
tiexpr
  pretty (TIDeclareSymbol [String]
names Type
ty) =
    let namesDoc :: Doc ann
namesDoc = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate (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]
names)
    in String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"declare" 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
"symbol" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
forall ann. Doc ann
namesDoc 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
<+> Type -> Doc ann
forall ann. Type -> Doc ann
prettyTypeDoc Type
ty
  pretty (TIPatternFunctionDecl String
name TypeScheme
typeScheme [(String, Type)]
params Type
retType TIPattern
body) =
    let typeStr :: String
typeStr = TypeScheme -> String
prettyTypeScheme TypeScheme
typeScheme
        paramsDoc :: Doc ann
paramsDoc = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (((String, Type) -> Doc ann) -> [(String, Type)] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map (String, Type) -> Doc ann
forall {a} {ann}. Pretty a => (a, Type) -> Doc ann
prettyParam [(String, Type)]
params)
        retTypeDoc :: Doc ann
retTypeDoc = Type -> Doc ann
forall ann. Type -> Doc ann
prettyTypeDoc Type
retType
    in 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
<+> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"pattern" 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
name 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
<+> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
typeStr Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+>
       Doc ann
forall ann. Doc ann
paramsDoc 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
forall ann. Doc ann
retTypeDoc 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
":=") [TIPattern -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. TIPattern -> Doc ann
pretty TIPattern
body]
    where
      prettyParam :: (a, Type) -> Doc ann
prettyParam (a
pname, Type
pty) = 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 ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
pname 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
<+> Type -> Doc ann
forall ann. Type -> Doc ann
prettyTypeDoc Type
pty 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
")"

-- Helper function to pretty print Var
prettyVar :: Var -> Doc ann
prettyVar :: forall {ann}. Var -> Doc ann
prettyVar (Var String
name []) = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
name
prettyVar (Var String
name [Index (Maybe Var)]
indices) = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
name Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hcat ((Index (Maybe Var) -> Doc ann) -> [Index (Maybe Var)] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Index (Maybe Var) -> Doc ann
forall {ann}. Index (Maybe Var) -> Doc ann
prettyVarIndex [Index (Maybe Var)]
indices)
  where
    prettyVarIndex :: Index (Maybe Var) -> Doc ann
prettyVarIndex (Sub Maybe Var
Nothing) = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"_"
    prettyVarIndex (Sub (Just Var
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
<> Var -> Doc ann
forall {ann}. Var -> Doc ann
prettyVar Var
v
    prettyVarIndex (Sup Maybe Var
Nothing) = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"~"
    prettyVarIndex (Sup (Just Var
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
<> Var -> Doc ann
forall {ann}. Var -> Doc ann
prettyVar Var
v
    prettyVarIndex (SupSub Maybe Var
Nothing) = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"~_"
    prettyVarIndex (SupSub (Just Var
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
<> Var -> Doc ann
forall {ann}. Var -> Doc ann
prettyVar Var
v
    prettyVarIndex (User Maybe Var
Nothing) = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"|"
    prettyVarIndex (User (Just Var
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
<> Var -> Doc ann
forall {ann}. Var -> Doc ann
prettyVar Var
v
    prettyVarIndex (MultiSub Maybe Var
_ Integer
_ Maybe Var
_) = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"_..."
    prettyVarIndex (MultiSup Maybe Var
_ Integer
_ Maybe Var
_) = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"~..."
    prettyVarIndex (DF Integer
_ Integer
_) = Doc ann
forall ann. Doc ann
emptyDoc

-- Helper function to pretty print constraints as Doc
prettyConstraintsDoc :: [Types.Constraint] -> Doc ann
prettyConstraintsDoc :: forall ann. [Constraint] -> Doc ann
prettyConstraintsDoc [] = Doc ann
forall ann. Doc ann
emptyDoc
prettyConstraintsDoc [Constraint
c] = 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
<> Constraint -> Doc ann
forall ann. Constraint -> Doc ann
prettyConstraintDoc Constraint
c 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
forall ann. Doc ann
space
prettyConstraintsDoc [Constraint]
cs =
  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
hsep (Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
comma ((Constraint -> Doc ann) -> [Constraint] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Constraint -> Doc ann
forall ann. Constraint -> Doc ann
prettyConstraintDoc [Constraint]
cs)) 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
forall ann. Doc ann
space

-- Helper function to pretty print a single constraint as Doc
prettyConstraintDoc :: Types.Constraint -> Doc ann
prettyConstraintDoc :: forall ann. Constraint -> Doc ann
prettyConstraintDoc (Types.Constraint String
className Type
tyArg) = 
  String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
className Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Type -> Doc ann
forall ann. Type -> Doc ann
prettyTypeDoc Type
tyArg

-- Helper function to pretty print Type as Doc
prettyTypeDoc :: Types.Type -> Doc ann
prettyTypeDoc :: forall ann. Type -> Doc ann
prettyTypeDoc Type
Types.TInt = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"Integer"
prettyTypeDoc Type
Types.TFloat = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"Float"
prettyTypeDoc Type
Types.TBool = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"Bool"
prettyTypeDoc Type
Types.TChar = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"Char"
prettyTypeDoc Type
Types.TString = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"String"
prettyTypeDoc (Types.TTuple []) = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"()"
prettyTypeDoc (Types.TVar (Types.TyVar String
v)) = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
v
prettyTypeDoc (Types.TFun Type
t1 Type
t2) = Type -> Doc ann
forall ann. Type -> Doc ann
prettyTypeArg Type
t1 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
<+> Type -> Doc ann
forall ann. Type -> Doc ann
prettyTypeDoc Type
t2
  where
    prettyTypeArg :: Type -> Doc ann
prettyTypeArg t :: Type
t@(Types.TFun Type
_ Type
_) = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (Type -> Doc ann
forall ann. Type -> Doc ann
prettyTypeDoc Type
t)
    prettyTypeArg Type
t = Type -> Doc ann
forall ann. Type -> Doc ann
prettyTypeDoc Type
t
prettyTypeDoc (Types.TTuple [Type]
ts) = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
tupled ((Type -> Doc ann) -> [Type] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Doc ann
forall ann. Type -> Doc ann
prettyTypeDoc [Type]
ts)
prettyTypeDoc (Types.TCollection Type
t) = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
brackets (Type -> Doc ann
forall ann. Type -> Doc ann
prettyTypeDoc Type
t)
prettyTypeDoc (Types.THash Type
k Type
v) =
  String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"Hash" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Type -> Doc ann
forall ann. Type -> Doc ann
prettyTypeDoc Type
k Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Type -> Doc ann
forall ann. Type -> Doc ann
prettyHashValueTypeDoc Type
v
  where
    -- Hash value types need parentheses if they are function types
    prettyHashValueTypeDoc :: Type -> Doc ann
prettyHashValueTypeDoc t :: Type
t@(Types.TFun Type
_ Type
_) = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (Type -> Doc ann
forall ann. Type -> Doc ann
prettyTypeDoc Type
t)
    prettyHashValueTypeDoc Type
t = Type -> Doc ann
forall ann. Type -> Doc ann
prettyTypeDoc Type
t
prettyTypeDoc (Types.TMatcher Type
t) = 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 ann. Doc ann -> Doc ann -> Doc ann
<+> Type -> Doc ann
forall ann. Type -> Doc ann
prettyTypeDoc Type
t
prettyTypeDoc (Types.TIO Type
t) = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"IO" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Type -> Doc ann
forall ann. Type -> Doc ann
prettyTypeDoc Type
t
prettyTypeDoc (Types.TIORef Type
t) = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"IORef" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Type -> Doc ann
forall ann. Type -> Doc ann
prettyTypeDoc Type
t
prettyTypeDoc (Types.TTensor Type
t) = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"Tensor" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Type -> Doc ann
forall ann. Type -> Doc ann
prettyTypeDoc Type
t
prettyTypeDoc (Types.TInductive String
name []) = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
name
prettyTypeDoc (Types.TInductive String
name [Type]
ts) = [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
name Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: (Type -> Doc ann) -> [Type] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Doc ann
forall ann. Type -> Doc ann
prettyTypeDoc [Type]
ts)
prettyTypeDoc Type
Types.TAny = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"_"
prettyTypeDoc Type
Types.TPort = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"Port"
prettyTypeDoc Type
Types.TMathExpr = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"MathExpr"
prettyTypeDoc Type
Types.TPolyExpr = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"PolyExpr"
prettyTypeDoc Type
Types.TTermExpr = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"TermExpr"
prettyTypeDoc Type
Types.TSymbolExpr = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"SymbolExpr"
prettyTypeDoc Type
Types.TIndexExpr = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"IndexExpr"

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 LambdaExpr{}             = Bool
False
  isAtom MemoizedLambdaExpr{}     = Bool
False
  isAtom TypedMemoizedLambdaExpr{} = 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 (Arg 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