Define magicDict in GHC.Magic, not GHC.Prim

10 files changed, 59 insertions, 22 deletions

diff --git a/compiler/GHC/Builtin/Names.hs b/compiler/GHC/Builtin/Names.hs
index ec8d5a0afc..309b11f070 100644
--- a/compiler/GHC/Builtin/Names.hs
+++ b/compiler/GHC/Builtin/Names.hs
@@ -545,7 +545,7 @@ pRELUDE :: Module
 pRELUDE         = mkBaseModule_ pRELUDE_NAME
 
 gHC_PRIM, gHC_PRIM_PANIC, gHC_PRIM_EXCEPTION,
-    gHC_TYPES, gHC_GENERICS, gHC_MAGIC,
+    gHC_TYPES, gHC_GENERICS, gHC_MAGIC, gHC_MAGIC_DICT,
     gHC_CLASSES, gHC_PRIMOPWRAPPERS, gHC_BASE, gHC_ENUM,
     gHC_GHCI, gHC_GHCI_HELPERS, gHC_CSTRING,
     gHC_SHOW, gHC_READ, gHC_NUM, gHC_MAYBE,
@@ -567,6 +567,7 @@ gHC_PRIM_PANIC  = mkPrimModule (fsLit "GHC.Prim.Panic")
 gHC_PRIM_EXCEPTION = mkPrimModule (fsLit "GHC.Prim.Exception")
 gHC_TYPES       = mkPrimModule (fsLit "GHC.Types")
 gHC_MAGIC       = mkPrimModule (fsLit "GHC.Magic")
+gHC_MAGIC_DICT  = mkPrimModule (fsLit "GHC.Magic.Dict")
 gHC_CSTRING     = mkPrimModule (fsLit "GHC.CString")
 gHC_CLASSES     = mkPrimModule (fsLit "GHC.Classes")
 gHC_PRIMOPWRAPPERS = mkPrimModule (fsLit "GHC.PrimopWrappers")
diff --git a/compiler/GHC/Builtin/primops.txt.pp b/compiler/GHC/Builtin/primops.txt.pp
index a00f3f8215..d4f56cadfa 100644
--- a/compiler/GHC/Builtin/primops.txt.pp
+++ b/compiler/GHC/Builtin/primops.txt.pp
@@ -3288,13 +3288,6 @@ pseudoop "void#"
    }
    with deprecated_msg = { Use an unboxed unit tuple instead }
 
-pseudoop "magicDict"
-   a
-   { {\tt magicDict} is a special-purpose placeholder value.
-     It is used internally by modules such as {\tt GHC.TypeNats} to cast a typeclass
-     dictionary with a single method. It is eliminated by a rule during compilation.
-     For the details, see Note [magicDictId magic] in GHC. }
-
 primtype Proxy# a
    { The type constructor {\tt Proxy#} is used to bear witness to some
    type variable. It's used when you want to pass around proxy values
diff --git a/compiler/GHC/Types/Id/Make.hs b/compiler/GHC/Types/Id/Make.hs
index 1fcdabc977..37a052d9ab 100644
--- a/compiler/GHC/Types/Id/Make.hs
+++ b/compiler/GHC/Types/Id/Make.hs
@@ -137,9 +137,10 @@ Note [magicIds]
 ~~~~~~~~~~~~~~~
 The magicIds
 
-  * Are exported from GHC.Magic
+  * Are exported from GHC.Magic and GHC.Magic.Dict. (The former is
+    Trustworthy, while the latter is unsafe.)
 
-  * Can be defined in Haskell (and are, in ghc-prim:GHC/Magic.hs).
+  * Can be defined in Haskell (and are, in ghc-prim:GHC/Magic{/Dict}.hs).
     This definition at least generates Haddock documentation for them.
 
   * May or may not have a CompulsoryUnfolding.
@@ -165,7 +166,7 @@ wiredInIds
   ++ errorIds           -- Defined in GHC.Core.Make
 
 magicIds :: [Id]    -- See Note [magicIds]
-magicIds = [lazyId, oneShotId, noinlineId]
+magicIds = [lazyId, oneShotId, noinlineId, magicDictId]
 
 ghcPrimIds :: [Id]  -- See Note [ghcPrimIds (aka pseudoops)]
 ghcPrimIds
@@ -173,7 +174,6 @@ ghcPrimIds
     , voidPrimId
     , nullAddrId
     , seqId
-    , magicDictId
     , coerceId
     , proxyHashId
     , leftSectionId
@@ -1436,7 +1436,6 @@ seqName           = mkWiredInIdName gHC_PRIM  (fsLit "seq")            seqIdKey
 realWorldName     = mkWiredInIdName gHC_PRIM  (fsLit "realWorld#")     realWorldPrimIdKey realWorldPrimId
 voidPrimIdName    = mkWiredInIdName gHC_PRIM  (fsLit "void#")          voidPrimIdKey      voidPrimId
 coercionTokenName = mkWiredInIdName gHC_PRIM  (fsLit "coercionToken#") coercionTokenIdKey coercionTokenId
-magicDictName     = mkWiredInIdName gHC_PRIM  (fsLit "magicDict")      magicDictKey       magicDictId
 coerceName        = mkWiredInIdName gHC_PRIM  (fsLit "coerce")         coerceKey          coerceId
 proxyName         = mkWiredInIdName gHC_PRIM  (fsLit "proxy#")         proxyHashKey       proxyHashId
 leftSectionName   = mkWiredInIdName gHC_PRIM  (fsLit "leftSection")    leftSectionKey     leftSectionId
@@ -1447,6 +1446,7 @@ lazyIdName, oneShotName, noinlineIdName :: Name
 lazyIdName        = mkWiredInIdName gHC_MAGIC (fsLit "lazy")           lazyIdKey          lazyId
 oneShotName       = mkWiredInIdName gHC_MAGIC (fsLit "oneShot")        oneShotKey         oneShotId
 noinlineIdName    = mkWiredInIdName gHC_MAGIC (fsLit "noinline")       noinlineIdKey      noinlineId
+magicDictName     = mkWiredInIdName gHC_MAGIC_DICT (fsLit "magicDict") magicDictKey       magicDictId
 
 ------------------------------------------------
 proxyHashId :: Id
diff --git a/libraries/base/GHC/Base.hs b/libraries/base/GHC/Base.hs
index 205fee906b..29e7ec85af 100644
--- a/libraries/base/GHC/Base.hs
+++ b/libraries/base/GHC/Base.hs
@@ -100,6 +100,7 @@ module GHC.Base
         module GHC.Classes,
         module GHC.CString,
         module GHC.Magic,
+        module GHC.Magic.Dict,
         module GHC.Types,
         module GHC.Prim,        -- Re-export GHC.Prim and [boot] GHC.Err,
         module GHC.Prim.Ext,    -- to avoid lots of people having to
@@ -112,6 +113,7 @@ import GHC.Types
 import GHC.Classes
 import GHC.CString
 import GHC.Magic
+import GHC.Magic.Dict
 import GHC.Prim
 import GHC.Prim.Ext
 import GHC.Err
diff --git a/libraries/base/GHC/Exts.hs b/libraries/base/GHC/Exts.hs
index 0e3cd14407..d2dc4e0f11 100755
--- a/libraries/base/GHC/Exts.hs
+++ b/libraries/base/GHC/Exts.hs
@@ -76,6 +76,9 @@ module GHC.Exts
         -- * Running 'RealWorld' state thread
         runRW#,
 
+        -- * Casting class dictionaries with single methods
+        magicDict,
+
         -- * Safe coercions
         --
         -- | These are available from the /Trustworthy/ module "Data.Coerce" as well
diff --git a/libraries/base/GHC/TypeLits.hs b/libraries/base/GHC/TypeLits.hs
index 2dcc28b223..3adf826002 100644
--- a/libraries/base/GHC/TypeLits.hs
+++ b/libraries/base/GHC/TypeLits.hs
@@ -58,13 +58,13 @@ module GHC.TypeLits
 
   ) where
 
-import GHC.Base(Eq(..), Ord(..), Ordering(..), String, otherwise)
+import GHC.Base(Eq(..), Ord(..), Ordering(..), String, magicDict, otherwise)
 import GHC.Types(Symbol, Char)
 import GHC.Num(Integer, fromInteger)
 import GHC.Show(Show(..))
 import GHC.Read(Read(..))
 import GHC.Real(toInteger)
-import GHC.Prim(magicDict, Proxy#)
+import GHC.Prim(Proxy#)
 import Data.Maybe(Maybe(..))
 import Data.Proxy (Proxy(..))
 import Data.Type.Equality((:~:)(Refl))
@@ -308,7 +308,7 @@ newtype SSymbol (s :: Symbol) = SSymbol String
 
 data WrapS a b = WrapS (KnownSymbol a => Proxy a -> b)
 
--- See Note [magicDictId magic] in "basicType/MkId.hs"
+-- See Note [magicDictId magic] in "GHC.Types.Id.Make" in GHC
 withSSymbol :: (KnownSymbol a => Proxy a -> b)
             -> SSymbol a      -> Proxy a -> b
 withSSymbol f x y = magicDict (WrapS f) x y
@@ -317,7 +317,7 @@ newtype SChar (s :: Char) = SChar Char
 
 data WrapC a b = WrapC (KnownChar a => Proxy a -> b)
 
--- See Note [q] in "basicType/MkId.hs"
+-- See Note [magicDictId magic] in "GHC.Types.Id.Make" in GHC
 withSChar :: (KnownChar a => Proxy a -> b)
             -> SChar a      -> Proxy a -> b
 withSChar f x y = magicDict (WrapC f) x y
diff --git a/libraries/base/GHC/TypeNats.hs b/libraries/base/GHC/TypeNats.hs
index f9733d55a3..354e6005a2 100644
--- a/libraries/base/GHC/TypeNats.hs
+++ b/libraries/base/GHC/TypeNats.hs
@@ -38,12 +38,12 @@ module GHC.TypeNats
 
   ) where
 
-import GHC.Base(Eq(..), Ord(..), otherwise)
+import GHC.Base(Eq(..), Ord(..), magicDict, otherwise)
 import GHC.Types
 import GHC.Num.Natural(Natural)
 import GHC.Show(Show(..))
 import GHC.Read(Read(..))
-import GHC.Prim(magicDict, Proxy#)
+import GHC.Prim(Proxy#)
 import Data.Maybe(Maybe(..))
 import Data.Proxy (Proxy(..))
 import Data.Type.Equality((:~:)(Refl))
@@ -242,7 +242,7 @@ newtype SNat    (n :: Nat)    = SNat    Natural
 
 data WrapN a b = WrapN (KnownNat    a => Proxy a -> b)
 
--- See Note [magicDictId magic] in "basicType/MkId.hs"
+-- See Note [magicDictId magic] in "GHC.Types.Id.Make" in GHC
 withSNat :: (KnownNat a => Proxy a -> b)
          -> SNat a      -> Proxy a -> b
 withSNat f x y = magicDict (WrapN f) x y
diff --git a/libraries/ghc-prim/GHC/Magic/Dict.hs b/libraries/ghc-prim/GHC/Magic/Dict.hs
new file mode 100644
index 0000000000..d8bc70e9ff
--- /dev/null
+++ b/libraries/ghc-prim/GHC/Magic/Dict.hs
@@ -0,0 +1,33 @@
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE Unsafe #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.Magic.Dict
+-- Copyright   :  (c) The University of Glasgow 2009
+-- License     :  see libraries/ghc-prim/LICENSE
+--
+-- Maintainer  :  cvs-ghc@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable (GHC Extensions)
+--
+-- Defines the 'magicDict' function. For more information, see
+-- @Note [magicDictId magic]@ in "GHC.Types.Id.Make" in GHC.
+--
+-- Use "GHC.Exts" from the @base@ package instead of importing this
+-- module directly.
+--
+-----------------------------------------------------------------------------
+
+module GHC.Magic.Dict (magicDict) where
+
+import GHC.Prim.Panic (panicError)
+
+-- | 'magicDict' is a special-purpose placeholder value.
+-- It is used internally by modules such as "GHC.TypeNats" to cast a typeclass
+-- dictionary with a single method. It is eliminated by a rule during compilation.
+-- For the details, see @Note [magicDictId magic]@ in "GHC.Types.Id.Make" in GHC.
+magicDict :: a
+{-# NOINLINE magicDict #-}
+magicDict = panicError "Non-rewritten magicDict"#
diff --git a/libraries/ghc-prim/changelog.md b/libraries/ghc-prim/changelog.md
index 6c7723068f..94ede15904 100644
--- a/libraries/ghc-prim/changelog.md
+++ b/libraries/ghc-prim/changelog.md
@@ -1,3 +1,7 @@
+## next (edit as necessary)
+
+- `magicDict` is now defined in `GHC.Magic.Dict` instead of `GHC.Prim`.
+
 ## 0.8.0 (edit as necessary)
 
 - Change array access primops to use type with size maxing the element size:
@@ -23,7 +27,7 @@
 - Add known-key `cstringLength#` to `GHC.CString`. This is just the
   C function `strlen`, but a built-in rewrite rule allows GHC to
   compute the result at compile time when the argument is known.
-  
+
 - In order to support unicode better the following functions in `GHC.CString`
   gained UTF8 counterparts:
 
@@ -47,7 +51,7 @@
         atomicCasAddrAddr# :: Addr# -> Addr# -> Addr# -> State# s -> (# State# s, Addr# #)
         atomicCasWordAddr# :: Addr# -> Word# -> Word# -> State# s -> (# State# s, Word# #)
 
-- Add an explicit fixity for `(~)` and `(~~)`: 
+- Add an explicit fixity for `(~)` and `(~~)`:
 
         infix 4 ~, ~~
 
diff --git a/libraries/ghc-prim/ghc-prim.cabal b/libraries/ghc-prim/ghc-prim.cabal
index 05fd60f09a..61840021c1 100644
--- a/libraries/ghc-prim/ghc-prim.cabal
+++ b/libraries/ghc-prim/ghc-prim.cabal
@@ -45,6 +45,7 @@ Library
         GHC.Debug
         GHC.IntWord64
         GHC.Magic
+        GHC.Magic.Dict
         GHC.Prim.Ext
         GHC.Prim.Panic
         GHC.Prim.Exception