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 tys) = foldr FunTy ty tys
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 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