module SSTG.Core.Language.Typing
( module SSTG.Core.Language.Typing
) where
import SSTG.Core.Language.Syntax
class Typeable a where
typeOf :: a -> Type
instance Typeable Var where
typeOf (Var _ ty) = ty
instance Typeable Lit where
typeOf (MachChar _ ty) = ty
typeOf (MachStr _ ty) = ty
typeOf (MachInt _ ty) = ty
typeOf (MachWord _ ty) = ty
typeOf (MachFloat _ ty) = ty
typeOf (MachDouble _ ty) = ty
typeOf (MachLabel _ _ ty) = ty
typeOf (MachNullAddr ty) = ty
typeOf (BlankAddr) = Bottom
typeOf (AddrLit _) = Bottom
typeOf (LitEval pfun args) = foldl AppTy (typeOf pfun) (map typeOf args)
instance Typeable Atom where
typeOf (LitAtom lit) = typeOf lit
typeOf (VarAtom var) = typeOf var
instance Typeable PrimFun where
typeOf (PrimFun _ ty) = ty
instance Typeable DataCon where
typeOf (DataCon _ ty tys) = foldr FunTy ty tys
instance Typeable Alt where
typeOf (Alt _ expr) = typeOf expr
instance Typeable Expr where
typeOf (Atom atom) = typeOf atom
typeOf (PrimApp pfun args) = foldl AppTy (typeOf pfun) (map typeOf args)
typeOf (ConApp dcon args) = foldl AppTy (typeOf dcon) (map typeOf args)
typeOf (FunApp fun args) = foldl AppTy (typeOf fun) (map typeOf args)
typeOf (Let _ expr) = typeOf expr
typeOf (Case _ _ (alt:_)) = typeOf alt
typeOf _ = Bottom