{- |
Module      : Language.Egison.Type.Pretty
Licence     : MIT

This module provides pretty printing for Egison types.
-}

module Language.Egison.Type.Pretty
  ( prettyType
  , prettyTypeScheme
  , prettyTypeExpr
  , prettyTensorShape
  , prettyIndex
  ) where

import           Data.List                  (intercalate)

import           Language.Egison.AST        (TypeExpr (..))
import           Language.Egison.Type.Types (Constraint(..))
import           Language.Egison.Type.Index (Index (..), IndexKind (..))
import           Language.Egison.Type.Types (ShapeDimType (..), TensorShape (..), TyVar (..), Type (..),
                                             TypeScheme (..))

-- | Pretty print a Type
prettyType :: Type -> String
prettyType :: Type -> String
prettyType Type
TInt             = String
"Integer"
prettyType Type
TMathExpr        = String
"MathExpr"
prettyType Type
TPolyExpr        = String
"PolyExpr"
prettyType Type
TTermExpr        = String
"TermExpr"
prettyType Type
TSymbolExpr      = String
"SymbolExpr"
prettyType Type
TIndexExpr       = String
"IndexExpr"
prettyType Type
TFloat           = String
"Float"
prettyType Type
TBool            = String
"Bool"
prettyType Type
TChar            = String
"Char"
prettyType Type
TString          = String
"String"
prettyType (TTuple [])      = String
"()"
prettyType (TVar (TyVar String
v)) = String
v
prettyType (TTuple [Type]
ts)      = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((Type -> String) -> [Type] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Type -> String
prettyType [Type]
ts) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
prettyType (TCollection Type
t)  = String
"[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Type -> String
prettyType Type
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"
prettyType (TInductive String
name []) = String
name
prettyType (TInductive String
name [Type]
args) = String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords ((Type -> String) -> [Type] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Type -> String
prettyTypeAtom [Type]
args)
prettyType (TTensor Type
t)      = String
"Tensor " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Type -> String
prettyTypeAtom Type
t
prettyType (THash Type
k Type
v)      = String
"Hash " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Type -> String
prettyTypeAtom Type
k String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Type -> String
prettyHashValueType Type
v
  where
    -- Hash value types need parentheses if they are function types
    prettyHashValueType :: Type -> String
prettyHashValueType t :: Type
t@(TFun Type
_ Type
_) = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Type -> String
prettyType Type
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
    prettyHashValueType Type
t            = Type -> String
prettyTypeAtom Type
t
prettyType (TMatcher Type
t)     = String
"Matcher " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Type -> String
prettyTypeAtom Type
t
prettyType (TFun Type
t1 Type
t2)     = Type -> String
prettyTypeArg Type
t1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" -> " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Type -> String
prettyType Type
t2
  where
    prettyTypeArg :: Type -> String
prettyTypeArg t :: Type
t@(TFun Type
_ Type
_) = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Type -> String
prettyType Type
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
    prettyTypeArg Type
t            = Type -> String
prettyType Type
t
prettyType (TIO Type
t)          = String
"IO " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Type -> String
prettyTypeAtom Type
t
prettyType (TIORef Type
t)       = String
"IORef " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Type -> String
prettyTypeAtom Type
t
prettyType Type
TPort            = String
"Port"
prettyType Type
TAny             = String
"_"

-- | Pretty print an atomic type (with parentheses if needed)
prettyTypeAtom :: Type -> String
prettyTypeAtom :: Type -> String
prettyTypeAtom t :: Type
t@Type
TInt       = Type -> String
prettyType Type
t
prettyTypeAtom t :: Type
t@Type
TMathExpr  = Type -> String
prettyType Type
t
prettyTypeAtom t :: Type
t@Type
TPolyExpr  = Type -> String
prettyType Type
t
prettyTypeAtom t :: Type
t@Type
TTermExpr  = Type -> String
prettyType Type
t
prettyTypeAtom t :: Type
t@Type
TSymbolExpr = Type -> String
prettyType Type
t
prettyTypeAtom t :: Type
t@Type
TIndexExpr = Type -> String
prettyType Type
t
prettyTypeAtom t :: Type
t@Type
TFloat     = Type -> String
prettyType Type
t
prettyTypeAtom t :: Type
t@Type
TBool      = Type -> String
prettyType Type
t
prettyTypeAtom t :: Type
t@Type
TChar      = Type -> String
prettyType Type
t
prettyTypeAtom t :: Type
t@Type
TString    = Type -> String
prettyType Type
t
prettyTypeAtom t :: Type
t@(TTuple []) = Type -> String
prettyType Type
t
prettyTypeAtom t :: Type
t@(TVar TyVar
_)    = Type -> String
prettyType Type
t
prettyTypeAtom t :: Type
t@(TTuple [Type]
_) = Type -> String
prettyType Type
t
prettyTypeAtom t :: Type
t@(TCollection Type
_) = Type -> String
prettyType Type
t
prettyTypeAtom t :: Type
t@Type
TPort       = Type -> String
prettyType Type
t
prettyTypeAtom t :: Type
t@Type
TAny        = Type -> String
prettyType Type
t
prettyTypeAtom Type
t            = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Type -> String
prettyType Type
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"

-- | Pretty print a TypeScheme
prettyTypeScheme :: TypeScheme -> String
prettyTypeScheme :: TypeScheme -> String
prettyTypeScheme (Forall [] [] Type
t) = Type -> String
prettyType Type
t
prettyTypeScheme (Forall [] [Constraint]
cs Type
t) =
  [Constraint] -> String
prettyConstraintsAlt [Constraint]
cs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Type -> String
prettyType Type
t
prettyTypeScheme (Forall [TyVar]
vs [] Type
t) =
  String
"∀" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords ((TyVar -> String) -> [TyVar] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(TyVar String
v) -> String
v) [TyVar]
vs) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
". " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Type -> String
prettyType Type
t
prettyTypeScheme (Forall [TyVar]
vs [Constraint]
cs Type
t) =
  [Constraint] -> String
prettyConstraintsAlt [Constraint]
cs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Type -> String
prettyType Type
t

-- | Pretty print constraints (old format: "Eq a, Ord b")
prettyConstraints :: [Constraint] -> String
prettyConstraints :: [Constraint] -> String
prettyConstraints []  = String
""
prettyConstraints [Constraint
c] = Constraint -> String
prettyConstraint Constraint
c
prettyConstraints [Constraint]
cs  = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((Constraint -> String) -> [Constraint] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Constraint -> String
prettyConstraint [Constraint]
cs) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"

-- | Pretty print constraints (new format: "{Eq a, Ord b}")
prettyConstraintsAlt :: [Constraint] -> String
prettyConstraintsAlt :: [Constraint] -> String
prettyConstraintsAlt []  = String
""
prettyConstraintsAlt [Constraint]
cs  = String
"{" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((Constraint -> String) -> [Constraint] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Constraint -> String
prettyConstraint [Constraint]
cs) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"}"

-- | Pretty print a single constraint
prettyConstraint :: Constraint -> String
prettyConstraint :: Constraint -> String
prettyConstraint (Constraint String
cls Type
ty) = String
cls String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Type -> String
prettyTypeAtom Type
ty

-- | Pretty print a TensorShape
prettyTensorShape :: TensorShape -> String
prettyTensorShape :: TensorShape -> String
prettyTensorShape (ShapeLit [Integer]
dims) = String
"[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((Integer -> String) -> [Integer] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> String
forall a. Show a => a -> String
show [Integer]
dims) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"
prettyTensorShape (ShapeVar String
v)    = String
v
prettyTensorShape (ShapeMixed [ShapeDimType]
dims) = String
"[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((ShapeDimType -> String) -> [ShapeDimType] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ShapeDimType -> String
prettyShapeDimType [ShapeDimType]
dims) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"
prettyTensorShape TensorShape
ShapeUnknown    = String
"[?]"

-- | Pretty print a ShapeDimType
prettyShapeDimType :: ShapeDimType -> String
prettyShapeDimType :: ShapeDimType -> String
prettyShapeDimType (DimLit Integer
n) = Integer -> String
forall a. Show a => a -> String
show Integer
n
prettyShapeDimType (DimVar String
v) = String
v

-- | Pretty print an Index
prettyIndex :: Index -> String
prettyIndex :: Index -> String
prettyIndex (IndexSym IndexKind
Subscript String
s)      = String
"_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s
prettyIndex (IndexSym IndexKind
Superscript String
s)    = String
"~" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s
prettyIndex (IndexPlaceholder IndexKind
Subscript)    = String
"_#"
prettyIndex (IndexPlaceholder IndexKind
Superscript)  = String
"~#"
prettyIndex (IndexVar String
s)                = String
"_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s

-- | Pretty print a TypeExpr (source-level type)
prettyTypeExpr :: TypeExpr -> String
prettyTypeExpr :: TypeExpr -> String
prettyTypeExpr TypeExpr
TEInt          = String
"Integer"
prettyTypeExpr TypeExpr
TEMathExpr     = String
"MathExpr"
prettyTypeExpr TypeExpr
TEFloat        = String
"Float"
prettyTypeExpr TypeExpr
TEBool         = String
"Bool"
prettyTypeExpr TypeExpr
TEChar         = String
"Char"
prettyTypeExpr TypeExpr
TEString       = String
"String"
prettyTypeExpr (TEVar String
v)      = String
v
prettyTypeExpr (TEList TypeExpr
t)     = String
"[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ TypeExpr -> String
prettyTypeExpr TypeExpr
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"
prettyTypeExpr (TETuple [])   = String
"()"
prettyTypeExpr (TETuple [TypeExpr]
ts)   = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((TypeExpr -> String) -> [TypeExpr] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map TypeExpr -> String
prettyTypeExpr [TypeExpr]
ts) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
prettyTypeExpr (TEFun TypeExpr
t1 TypeExpr
t2)  = TypeExpr -> String
prettyTypeExprArg TypeExpr
t1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" -> " String -> String -> String
forall a. [a] -> [a] -> [a]
++ TypeExpr -> String
prettyTypeExpr TypeExpr
t2
  where
    prettyTypeExprArg :: TypeExpr -> String
prettyTypeExprArg t :: TypeExpr
t@(TEFun TypeExpr
_ TypeExpr
_) = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ TypeExpr -> String
prettyTypeExpr TypeExpr
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
    prettyTypeExprArg TypeExpr
t             = TypeExpr -> String
prettyTypeExpr TypeExpr
t
prettyTypeExpr (TEMatcher TypeExpr
t)  = String
"Matcher " String -> String -> String
forall a. [a] -> [a] -> [a]
++ TypeExpr -> String
prettyTypeExprAtom TypeExpr
t
prettyTypeExpr (TEPattern TypeExpr
t)  = String
"Pattern " String -> String -> String
forall a. [a] -> [a] -> [a]
++ TypeExpr -> String
prettyTypeExprAtom TypeExpr
t
prettyTypeExpr (TETensor TypeExpr
t) = String
"Tensor " String -> String -> String
forall a. [a] -> [a] -> [a]
++ TypeExpr -> String
prettyTypeExprAtom TypeExpr
t
prettyTypeExpr (TEApp TypeExpr
t [TypeExpr]
args) =
  TypeExpr -> String
prettyTypeExprAtom TypeExpr
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords ((TypeExpr -> String) -> [TypeExpr] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map TypeExpr -> String
prettyTypeExprAtom [TypeExpr]
args)

-- | Pretty print an atomic TypeExpr
prettyTypeExprAtom :: TypeExpr -> String
prettyTypeExprAtom :: TypeExpr -> String
prettyTypeExprAtom t :: TypeExpr
t@TypeExpr
TEInt       = TypeExpr -> String
prettyTypeExpr TypeExpr
t
prettyTypeExprAtom t :: TypeExpr
t@TypeExpr
TEMathExpr  = TypeExpr -> String
prettyTypeExpr TypeExpr
t
prettyTypeExprAtom t :: TypeExpr
t@TypeExpr
TEFloat     = TypeExpr -> String
prettyTypeExpr TypeExpr
t
prettyTypeExprAtom t :: TypeExpr
t@TypeExpr
TEBool      = TypeExpr -> String
prettyTypeExpr TypeExpr
t
prettyTypeExprAtom t :: TypeExpr
t@TypeExpr
TEChar      = TypeExpr -> String
prettyTypeExpr TypeExpr
t
prettyTypeExprAtom t :: TypeExpr
t@TypeExpr
TEString    = TypeExpr -> String
prettyTypeExpr TypeExpr
t
prettyTypeExprAtom t :: TypeExpr
t@(TEVar String
_)   = TypeExpr -> String
prettyTypeExpr TypeExpr
t
prettyTypeExprAtom t :: TypeExpr
t@(TEList TypeExpr
_)  = TypeExpr -> String
prettyTypeExpr TypeExpr
t
prettyTypeExprAtom t :: TypeExpr
t@(TETuple [TypeExpr]
_) = TypeExpr -> String
prettyTypeExpr TypeExpr
t
prettyTypeExprAtom TypeExpr
t             = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ TypeExpr -> String
prettyTypeExpr TypeExpr
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"