module CSPM.DataStructures.Names (
OccName(..),
UnRenamedName(..),
Name(..),
NameType(..),
mkExternalName, mkInternalName, mkWiredInName, mkFreshInternalName,
isNameDataConstructor,
) where
import Control.Monad.Trans
import Data.IORef
import Data.Supply
import Data.Typeable
import System.IO.Unsafe
import Util.Annotated
import Util.PrettyPrint
data OccName =
OccName String
deriving (Eq, Ord, Show, Typeable)
instance PrettyPrintable OccName where
prettyPrint (OccName s) = text s
data UnRenamedName =
UnQual OccName
deriving (Eq, Ord, Show, Typeable)
instance PrettyPrintable UnRenamedName where
prettyPrint (UnQual n) = prettyPrint n
data Name =
Name {
nameType :: NameType,
nameOccurrence :: !OccName,
nameDefinition :: !SrcSpan,
nameUnique :: !Int,
nameIsConstructor :: Bool
}
deriving Typeable
data NameType =
ExternalName
| InternalName
| WiredInName
deriving Eq
instance Eq Name where
n1 == n2 = nameUnique n1 == nameUnique n2
instance Ord Name where
compare n1 n2 = compare (nameUnique n1) (nameUnique n2)
instance PrettyPrintable Name where
prettyPrint n = prettyPrint (nameOccurrence n)
instance Show Name where
show n = show (prettyPrint n)
nameUniqueSupply :: IORef (Supply Int)
nameUniqueSupply = unsafePerformIO (do
s <- newNumSupply
newIORef s)
takeNameUnique :: MonadIO m => m Int
takeNameUnique = do
s <- liftIO $ readIORef nameUniqueSupply
let (s1, s2) = split2 s
liftIO $ writeIORef nameUniqueSupply s2
return $ supplyValue s1
mkExternalName :: MonadIO m => OccName -> SrcSpan -> Bool -> m Name
mkExternalName o s b = do
u <- takeNameUnique
return $ Name ExternalName o s u b
mkInternalName :: MonadIO m => OccName -> SrcSpan -> m Name
mkInternalName o s = do
u <- takeNameUnique
return $ Name InternalName o s u False
mkFreshInternalName :: MonadIO m => m Name
mkFreshInternalName = do
u <- takeNameUnique
let s = 'i':show u
return $ Name InternalName (OccName s) Unknown u False
mkWiredInName :: MonadIO m => OccName -> Bool -> m Name
mkWiredInName o b = do
u <- takeNameUnique
return $ Name WiredInName o Unknown u b
isNameDataConstructor :: Name -> Bool
isNameDataConstructor n = nameIsConstructor n