TypedIds.hs

module TypedIds where

import Assoc
import HsName (Id)


data NameSpace  = ClassOrTypeNames | ValueNames     deriving (Eq,Ord,Show)
type IdType     = IdTy Id

data IdTy id    = Value | MemberOf id | ConstrOf id | Class | Type
                                                    deriving (Eq,Ord,Show)

instance Functor IdTy where
    fmap f (MemberOf x) = MemberOf (f x)
    fmap f (ConstrOf x) = ConstrOf (f x)
    fmap f Value        = Value
    fmap f Class        = Class
    fmap f Type         = Type


class HasNameSpace t where
    namespace :: t -> NameSpace

instance HasNameSpace (IdTy id) where
    namespace Value         = ValueNames
    namespace (MemberOf _)  = ValueNames
    namespace (ConstrOf _)  = ValueNames
    namespace Class         = ClassOrTypeNames
    namespace Type          = ClassOrTypeNames




subordinate :: IdType -> Bool
subordinate (MemberOf _) = True
subordinate (ConstrOf _) = True
subordinate _            = False


MemberOf t `belongsTo` t' = t==t'
ConstrOf t `belongsTo` t' = t==t'
_          `belongsTo` _  = False



isClassOrType,isValue :: HasNameSpace t => t -> Bool
isClassOrType   = (== ClassOrTypeNames) . namespace
isValue         = (== ValueNames)       . namespace


type TypedId    = (Id, IdType)

getId :: TypedId -> Id
getId           = fst

idType :: HasTypedId t => t -> IdType
idType          = snd . typedId

class HasTypedId t where
    typedId :: t -> TypedId

instance HasTypedId TypedId where
    typedId = id