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

import SSTG.Core.Syntax.Language

varType :: Var -> Type
varType (Var _ ty) = ty

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)

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

primFunType :: PrimFun -> Type
primFunType (PrimFun _ ty) = ty

dataConType :: DataCon -> Type
dataConType (DataCon _ ty _) = ty

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

exprType :: Expr -> Type
exprType (Atom atom)       = atomType atom
exprType (PrimApp pf args) = foldl AppTy (primFunType pf) (map atomType args)
exprType (ConApp dcon _)   = dataConType dcon
exprType (FunApp fun args) = foldl AppTy (varType fun) (map atomType args)
exprType (Let _ expr)      = exprType expr
exprType (Case _ _ (a:_))  = altType a
exprType _                 = Bottom