-- | Typing Module
module SSTG.Core.Syntax.Typecheck
    ( module SSTG.Core.Syntax.Typecheck
    ) where

import SSTG.Core.Syntax.Language

-- | Variable type.
varType :: Var -> Type
varType (Var _ ty) = ty

-- | Literal type.
litType :: Lit -> Type
litType (MachChar _ ty)      = ty
litType (MachStr _ ty)       = ty
litType (MachInt _ ty)       = ty
litType (MachWord _ ty)      = ty
litType (MachFloat _ ty)     = ty
litType (MachDouble _ ty)    = ty
litType (MachNullAddr ty)    = ty
litType (MachLabel _ _ ty)   = ty
litType (BlankAddr)          = Bottom
litType (AddrLit _)          = Bottom
litType (SymLit var)         = varType var
litType (SymLitEval pf args) = foldl AppTy (primFunType pf) (map litType args)

-- | Atom type.
atomType :: Atom -> Type
atomType (VarAtom var) = varType var
atomType (LitAtom lit) = litType lit

-- | Primitive function type.
primFunType :: PrimFun -> Type
primFunType (PrimFun _ ty) = ty

-- | Data constructor type denoted as a function.
dataConType :: DataCon -> Type
dataConType (DataCon _ ty tys) = foldr FunTy ty tys

-- | Alt type
altType :: Alt -> Type
altType (Alt _ _ expr) = exprType expr

-- | I wonder what this could possibly be?
exprType :: Expr -> Type
exprType (Atom atom)       = atomType atom
exprType (PrimApp pf args) = foldl AppTy (primFunType pf) (map atomType args)
exprType (ConApp dc args)  = foldl AppTy (dataConType dc) (map atomType args)
exprType (FunApp fun args) = foldl AppTy (varType fun)    (map atomType args)
exprType (Let _ expr)      = exprType expr
exprType (Case _ _ (a:_))  = altType a
exprType _                 = Bottom