1 files changed, 98 insertions, 0 deletions
diff --git a/compiler/GHC/Unit/Module/Name.hs b/compiler/GHC/Unit/Module/Name.hs
new file mode 100644
index 0000000000..ad09fa7549
--- /dev/null
+++ b/compiler/GHC/Unit/Module/Name.hs
@@ -0,0 +1,98 @@
+
+-- | The ModuleName type
+module GHC.Unit.Module.Name
+    ( ModuleName
+    , pprModuleName
+    , moduleNameFS
+    , moduleNameString
+    , moduleNameSlashes, moduleNameColons
+    , mkModuleName
+    , mkModuleNameFS
+    , stableModuleNameCmp
+    , parseModuleName
+    )
+where
+
+import GHC.Prelude
+
+import GHC.Utils.Outputable
+import GHC.Types.Unique
+import GHC.Data.FastString
+import GHC.Utils.Binary
+import GHC.Utils.Misc
+
+import Control.DeepSeq
+import Data.Data
+import System.FilePath
+
+import qualified Text.ParserCombinators.ReadP as Parse
+import Text.ParserCombinators.ReadP (ReadP)
+import Data.Char (isAlphaNum)
+
+-- | A ModuleName is essentially a simple string, e.g. @Data.List@.
+newtype ModuleName = ModuleName FastString
+
+instance Uniquable ModuleName where
+  getUnique (ModuleName nm) = getUnique nm
+
+instance Eq ModuleName where
+  nm1 == nm2 = getUnique nm1 == getUnique nm2
+
+instance Ord ModuleName where
+  nm1 `compare` nm2 = stableModuleNameCmp nm1 nm2
+
+instance Outputable ModuleName where
+  ppr = pprModuleName
+
+instance Binary ModuleName where
+  put_ bh (ModuleName fs) = put_ bh fs
+  get bh = do fs <- get bh; return (ModuleName fs)
+
+instance Data ModuleName where
+  -- don't traverse?
+  toConstr _   = abstractConstr "ModuleName"
+  gunfold _ _  = error "gunfold"
+  dataTypeOf _ = mkNoRepType "ModuleName"
+
+instance NFData ModuleName where
+  rnf x = x `seq` ()
+
+stableModuleNameCmp :: ModuleName -> ModuleName -> Ordering
+-- ^ Compares module names lexically, rather than by their 'Unique's
+stableModuleNameCmp n1 n2 = moduleNameFS n1 `compare` moduleNameFS n2
+
+pprModuleName :: ModuleName -> SDoc
+pprModuleName (ModuleName nm) =
+    getPprStyle $ \ sty ->
+    if codeStyle sty
+        then ztext (zEncodeFS nm)
+        else ftext nm
+
+moduleNameFS :: ModuleName -> FastString
+moduleNameFS (ModuleName mod) = mod
+
+moduleNameString :: ModuleName -> String
+moduleNameString (ModuleName mod) = unpackFS mod
+
+mkModuleName :: String -> ModuleName
+mkModuleName s = ModuleName (mkFastString s)
+
+mkModuleNameFS :: FastString -> ModuleName
+mkModuleNameFS s = ModuleName s
+
+-- |Returns the string version of the module name, with dots replaced by slashes.
+--
+moduleNameSlashes :: ModuleName -> String
+moduleNameSlashes = dots_to_slashes . moduleNameString
+  where dots_to_slashes = map (\c -> if c == '.' then pathSeparator else c)
+
+-- |Returns the string version of the module name, with dots replaced by colons.
+--
+moduleNameColons :: ModuleName -> String
+moduleNameColons = dots_to_colons . moduleNameString
+  where dots_to_colons = map (\c -> if c == '.' then ':' else c)
+
+parseModuleName :: ReadP ModuleName
+parseModuleName = fmap mkModuleName
+                $ Parse.munch1 (\c -> isAlphaNum c || c `elem` "_.")
+