Typing.hs

-- | Typing Module
module SSTG.Core.Language.Typing
    ( module SSTG.Core.Language.Typing
    ) where

import SSTG.Core.Language.Syntax

-- | 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 (MachLabel _ _ ty) = ty
litType (MachNullAddr ty) = ty
litType (BlankAddr) = Bottom
litType (AddrLit _) = Bottom
litType (LitEval pf args) = foldl AppTy (primFunType pf) (map litType args)

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

-- | 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 _ _ (alt:_)) = altType alt
exprType _ = Bottom