module CSPM.DataStructures.Names (
OccName(..),
UnRenamedName(..),
Name(..),
NameType(..),
mkExternalName, mkInternalName, mkWiredInName, mkFreshInternalName,
isNameDataConstructor,
) where
import Control.Applicative
import Control.Monad.Trans
import Data.Hashable
import Data.IORef
import Data.Supply
import Data.Typeable
import System.IO.Unsafe
import Util.Annotated
import qualified Util.MonadicPrettyPrint as M
import Util.PrettyPrint
data OccName =
OccName String
deriving (Eq, Ord, Show, Typeable)
instance PrettyPrintable OccName where
prettyPrint (OccName s) = text s
instance (Applicative m, Monad m) => M.MonadicPrettyPrintable m OccName where
prettyPrint (OccName s) = M.text s
data UnRenamedName =
UnQual OccName
| Qual {
unRenamedNameModuleName :: OccName,
unRenamedNameMemberName :: UnRenamedName
}
deriving (Eq, Ord, Show, Typeable)
instance PrettyPrintable UnRenamedName where
prettyPrint (UnQual n) = prettyPrint n
prettyPrint (Qual mn n) = prettyPrint mn <> text "::" <> prettyPrint n
instance (Applicative m, Monad m) => M.MonadicPrettyPrintable m UnRenamedName where
prettyPrint (UnQual n) = M.prettyPrint n
prettyPrint (Qual mn n) = M.prettyPrint mn M.<> M.text "::" M.<> M.prettyPrint n
data Name =
Name {
nameType :: NameType,
nameFullyQualified :: !UnRenamedName,
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 Hashable Name where
hash n = nameUnique n
instance Ord Name where
compare n1 n2 = compare (nameUnique n1) (nameUnique n2)
instance PrettyPrintable Name where
prettyPrint n = prettyPrint (nameFullyQualified n)
instance (Applicative m, Monad m) => M.MonadicPrettyPrintable m Name where
prettyPrint n = M.prettyPrint (nameFullyQualified 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 $ atomicModifyIORef nameUniqueSupply split2
return $ supplyValue s
mkExternalName :: MonadIO m => UnRenamedName -> SrcSpan -> Bool -> m Name
mkExternalName o s b = do
u <- takeNameUnique
return $ Name ExternalName o s u b
mkInternalName :: MonadIO m => UnRenamedName -> 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 (UnQual (OccName s)) Unknown u False
mkWiredInName :: MonadIO m => UnRenamedName -> Bool -> m Name
mkWiredInName o b = do
u <- takeNameUnique
return $ Name WiredInName o BuiltIn u b
isNameDataConstructor :: Name -> Bool
isNameDataConstructor n = nameIsConstructor n