[stage1] remove hard ghc-internal/ghc-heap dependency from stage1

Author: angerman

cabal.project.stage1

@@ -17,7 +17,6 @@ packages:
   libraries/ghc-platform
   libraries/ghc-boot
   libraries/ghc-boot-th-next
-  libraries/ghc-heap
   libraries/ghci
   libraries/libffi-clib
   libraries/os-string

compiler/GHC/ByteCode/Types.hs

@@ -49,7 +49,9 @@ import GHCi.ResolvedBCO ( BCOByteArray(..), mkBCOByteArray )
 
 import Foreign
 import Data.ByteString (ByteString)
+#ifndef BOOTSTRAPPING
 import qualified GHC.Exts.Heap as Heap
+#endif
 import GHC.Cmm.Expr ( GlobalRegSet, emptyRegSet, regSetToList )
 import GHC.Unit.Module
 
@@ -166,8 +168,13 @@ type AddrEnv = NameEnv (Name, AddrPtr)
         -- We need the Name in the range so we know which
         -- elements to filter out when unloading a module
 
+#ifndef BOOTSTRAPPING
 newtype ItblPtr = ItblPtr (RemotePtr Heap.StgInfoTable)
   deriving (Show, NFData)
+#else
+newtype ItblPtr = ItblPtr (RemotePtr ())
+  deriving (Show, NFData)
+#endif
 newtype AddrPtr = AddrPtr (RemotePtr ())
   deriving (NFData)
 

compiler/GHC/Runtime/Heap/Inspect.hs

@@ -34,6 +34,7 @@ module GHC.Runtime.Heap.Inspect(
      constrClosToName -- exported to use in test T4891
  ) where
 
+#ifndef BOOTSTRAPPING
 import GHC.Prelude hiding (head, init, last, tail)
 import GHC.Platform
 
@@ -1474,3 +1475,91 @@ quantifyType ty = ( filter isTyVar $
                   , ty)
   where
     (_tvs, _, rho) = tcSplitNestedSigmaTys ty
+
+#else
+import GHC.Prelude
+import GHC.Types.Name
+import GHC.Core.DataCon
+import GHC.Core.Type
+import GHC.Utils.Outputable
+import GHC.Types.Var.Set
+import GHC.Driver.Env
+import GHCi.RemoteTypes
+import GHC.InfoProv
+import GHC.Types.Basic (Boxity)
+import GHC.Utils.Panic
+
+-- Dummy types
+data ClosureType = DummyClosureType
+data GenClosure a = DummyGenClosure
+
+type RttiType = Type
+
+data Term = Term { ty        :: RttiType
+                 , dc        :: Either String DataCon
+                 , val       :: ForeignHValue
+                 , subTerms  :: [Term] }
+          | Prim { ty        :: RttiType
+                 , valRaw    :: [Word] }
+          | Suspension { ctype    :: ClosureType
+                       , ty       :: RttiType
+                       , val      :: ForeignHValue
+                       , bound_to :: Maybe Name
+                       , infoprov :: Maybe InfoProv
+                       }
+          | NewtypeWrap{ ty           :: RttiType
+                       , dc           :: Either String DataCon
+                       , wrapped_term :: Term }
+          | RefWrap    { ty           :: RttiType
+                       , wrapped_term :: Term }
+
+-- Dummy functions
+cvObtainTerm :: HscEnv -> Int -> Bool -> RttiType -> ForeignHValue -> IO Term
+cvObtainTerm _ _ _ ty _ = return (Prim ty []) -- Dummy return
+
+cvReconstructType :: HscEnv -> Int -> RttiType -> ForeignHValue -> IO (Maybe RttiType)
+cvReconstructType _ _ _ _ = return Nothing
+
+improveRTTIType :: HscEnv -> RttiType -> RttiType -> Maybe Subst
+improveRTTIType _ _ _ = Nothing
+
+isFullyEvaluatedTerm :: Term -> Bool
+isFullyEvaluatedTerm _ = False
+
+termType :: Term -> RttiType
+termType t = ty t
+
+mapTermType :: (RttiType -> Type) -> Term -> Term
+mapTermType _ t = t
+
+termTyCoVars :: Term -> TyCoVarSet
+termTyCoVars _ = emptyVarSet
+
+type TermProcessor a b = RttiType -> Either String DataCon -> ForeignHValue -> [a] -> b
+
+data TermFold a = TermFold { fTerm        :: TermProcessor a a
+                           , fPrim        :: RttiType -> [Word] -> a
+                           , fSuspension  :: ClosureType -> RttiType -> ForeignHValue
+                                            -> Maybe Name -> Maybe InfoProv -> a
+                           , fNewtypeWrap :: RttiType -> Either String DataCon
+                                            -> a -> a
+                           , fRefWrap     :: RttiType -> a -> a
+                           }
+
+foldTerm :: TermFold a -> Term -> a
+foldTerm _ _ = panic "foldTerm: bootstrapping"
+
+type Precedence = Int
+type TermPrinterM m = Precedence -> Term -> m SDoc
+type CustomTermPrinter m = TermPrinterM m -> [Precedence -> Term -> m (Maybe SDoc)]
+
+cPprTerm :: Monad m => CustomTermPrinter m -> Term -> m SDoc
+cPprTerm _ _ = return (text "Bootstrapping Term")
+
+cPprTermBase :: Monad m => CustomTermPrinter m
+cPprTermBase _ = []
+
+constrClosToName :: HscEnv -> GenClosure a -> IO (Either String Name)
+constrClosToName _ _ = return (Left "Bootstrapping")
+
+#endif

compiler/GHC/Runtime/Interpreter.hs

@@ -24,7 +24,9 @@ module GHC.Runtime.Interpreter
   , storeBreakpoint
   , breakpointStatus
   , getBreakpointVar
+#ifndef BOOTSTRAPPING
   , getClosure
+#endif
   , whereFrom
   , getModBreaks
   , readIModBreaks
@@ -107,7 +109,9 @@ import Control.Monad.Catch as MC (mask)
 import Data.Binary
 import Data.ByteString (ByteString)
 import Foreign hiding (void)
+#ifndef BOOTSTRAPPING
 import qualified GHC.Exts.Heap as Heap
+#endif
 import GHC.Stack.CCS (CostCentre,CostCentreStack)
 import System.Directory
 import System.Process
@@ -390,11 +394,13 @@ getBreakpointVar interp ref ix =
     mb <- interpCmd interp (GetBreakpointVar apStack ix)
     mapM (mkFinalizedHValue interp) mb
 
+#ifndef BOOTSTRAPPING
 getClosure :: Interp -> ForeignHValue -> IO (Heap.GenClosure ForeignHValue)
 getClosure interp ref =
   withForeignRef ref $ \hval -> do
     mb <- interpCmd interp (GetClosure hval)
     mapM (mkFinalizedHValue interp) mb
+#endif
 
 whereFrom :: Interp -> ForeignHValue -> IO (Maybe InfoProv.InfoProv)
 whereFrom interp ref =

compiler/ghc.cabal.in

@@ -113,16 +113,17 @@ Library
                    rts,
                    rts-headers,
                    ghc-boot   == @ProjectVersionMunged@,
-                   ghc-heap   >=9.10.1 && <=@ProjectVersionMunged@,
                    ghci == @ProjectVersionMunged@
 
     if flag(bootstrap)
+      CPP-Options: -DBOOTSTRAPPING
       Build-Depends:
         ghc-boot-th-next     == @ProjectVersionMunged@
     else
       Build-Depends:
         ghc-boot-th          == @ProjectVersionMunged@,
         ghc-internal         == @[email protected],
+        ghc-heap             >= 9.10.1 && <=@ProjectVersionMunged@,
 
     if os(windows)
         Build-Depends: Win32  >= 2.3 && < 2.15

libraries/ghci/GHCi/InfoTable.hsc

@@ -19,7 +19,9 @@ import Foreign
 import Foreign.C
 import GHC.Ptr
 import GHC.Exts
+#ifndef BOOTSTRAPPING
 import GHC.Exts.Heap
+#endif
 import Data.ByteString (ByteString)
 import Control.Monad.Fail
 import qualified Data.ByteString as BS
@@ -36,11 +38,16 @@ mkConInfoTable
    -> Int     -- constr tag
    -> Int     -- pointer tag
    -> ByteString  -- con desc
+#ifndef BOOTSTRAPPING
    -> IO (Ptr StgInfoTable)
+#else
+   -> IO (Ptr ())
+#endif
       -- resulting info table is allocated with allocateExecPage(), and
       -- should be freed with freeExecPage().
 
 mkConInfoTable tables_next_to_code ptr_words nonptr_words tag ptrtag con_desc = do
+#ifndef BOOTSTRAPPING
   let entry_addr = interpConstrEntry !! ptrtag
   code' <- if tables_next_to_code
     then Just <$> mkJumpToAddr entry_addr
@@ -57,8 +64,11 @@ mkConInfoTable tables_next_to_code ptr_words nonptr_words tag ptrtag con_desc =
                  code  = code'
               }
   castFunPtrToPtr <$> newExecConItbl tables_next_to_code itbl con_desc
+#else
+  return nullPtr
+#endif
 
-
+#ifndef BOOTSTRAPPING
 -- -----------------------------------------------------------------------------
 -- Building machine code fragments for a constructor's entry code
 
@@ -382,3 +392,4 @@ wORD_SIZE = (#const SIZEOF_HSINT)
 
 conInfoTableSizeB :: Int
 conInfoTableSizeB = wORD_SIZE + itblSize
+#endif

libraries/ghci/GHCi/Message.hs

@@ -37,9 +37,7 @@ import GHCi.ResolvedBCO
 
 import GHC.LanguageExtensions
 import GHC.InfoProv
-#if MIN_VERSION_ghc_internal(9,1500,0)
-import qualified GHC.Exts.Heap as Heap
-#else
+#ifndef BOOTSTRAPPING
 import qualified GHC.Exts.Heap as Heap
 #endif
 import GHC.ForeignSrcLang
@@ -122,9 +120,15 @@ data Message a where
   FreeFFI :: RemotePtr C_ffi_cif -> Message ()
 
   -- | Create an info table for a constructor
+#ifndef BOOTSTRAPPING
   MkConInfoTable
    :: !ConInfoTable
    -> Message (RemotePtr Heap.StgInfoTable)
+#else
+  MkConInfoTable
+   :: !ConInfoTable
+   -> Message (RemotePtr ())
+#endif
 
   -- | Evaluate a statement
   EvalStmt
@@ -225,9 +229,11 @@ data Message a where
   -- | Remote interface to GHC.Internal.Heap.getClosureData. This is used by
   -- the GHCi debugger to inspect values in the heap for :print and
   -- type reconstruction.
+#ifndef BOOTSTRAPPING
   GetClosure
     :: HValueRef
     -> Message (Heap.GenClosure HValueRef)
+#endif
 
   -- | Remote interface to GHC.InfoProv.whereFrom. This is used by
   -- the GHCi debugger to inspect the provenance of thunks for :print.
@@ -522,11 +528,14 @@ instance Binary (FunPtr a) where
   put = put . castFunPtrToPtr
   get = castPtrToFunPtr <$> get
 
+#ifndef BOOTSTRAPPING
+#if defined(MIN_VERSION_ghc_internal)
 #if MIN_VERSION_ghc_internal(9,1400,0)
 instance Binary Heap.HalfWord where
   put x = put (fromIntegral x :: Word32)
   get = fromIntegral <$> (get :: Get Word32)
 #endif
+#endif
 
 -- Binary instances to support the GetClosure message
 instance Binary Heap.StgTSOProfInfo
@@ -541,6 +550,7 @@ instance Binary Heap.StgInfoTable
 instance Binary Heap.ClosureType
 instance Binary Heap.PrimType
 instance Binary a => Binary (Heap.GenClosure a)
+#endif
 instance Binary InfoProv where
 #if MIN_VERSION_base(4,20,0)
   get = InfoProv <$> get <*> get <*> get <*> get <*> get <*> get <*> get <*> get
@@ -593,7 +603,9 @@ getMessage = do
       32 -> Msg <$> (RunModFinalizers <$> get <*> get)
       33 -> Msg <$> (AddSptEntry <$> get <*> get)
       34 -> Msg <$> (RunTH <$> get <*> get <*> get <*> get)
+#ifndef BOOTSTRAPPING
       35 -> Msg <$> (GetClosure <$> get)
+#endif
       36 -> Msg <$> (Seq <$> get)
       37 -> Msg <$> return RtsRevertCAFs
       38 -> Msg <$> (ResumeSeq <$> get)
@@ -639,7 +651,9 @@ putMessage m = case m of
   RunModFinalizers a b        -> putWord8 32 >> put a >> put b
   AddSptEntry a b             -> putWord8 33 >> put a >> put b
   RunTH st q loc ty           -> putWord8 34 >> put st >> put q >> put loc >> put ty
+#ifndef BOOTSTRAPPING
   GetClosure a                -> putWord8 35 >> put a
+#endif
   Seq a                       -> putWord8 36 >> put a
   RtsRevertCAFs               -> putWord8 37
   ResumeSeq a                 -> putWord8 38 >> put a

libraries/ghci/GHCi/Run.hs

@@ -37,7 +37,9 @@ import Data.ByteString (ByteString)
 import qualified Data.ByteString.Short as BS
 import qualified Data.ByteString.Unsafe as B
 import GHC.Exts
+#ifndef BOOTSTRAPPING
 import qualified GHC.Exts.Heap as Heap
+#endif
 import GHC.Stack
 import Foreign hiding (void)
 import Foreign.C
@@ -114,9 +116,11 @@ run m = case m of
   PrepFFI args res -> toRemotePtr <$> prepForeignCall args res
   FreeFFI p -> freeForeignCallInfo (fromRemotePtr p)
   StartTH -> startTH
+#ifndef BOOTSTRAPPING
   GetClosure ref -> do
     clos <- Heap.getClosureData =<< localRef ref
     mapM (\(Heap.Box x) -> mkRemoteRef (HValue x)) clos
+#endif
   WhereFrom ref ->
     InfoProv.whereFrom =<< localRef ref
   Seq ref -> doSeq ref

libraries/ghci/ghci.cabal.in

@@ -97,7 +97,6 @@ library
         deepseq          >= 1.4 && < 1.6,
         filepath         >= 1.4 && < 1.6,
         ghc-boot         == @ProjectVersionMunged@,
-        ghc-heap         >= 9.10.1 && <=@ProjectVersionMunged@,
         transformers     >= 0.5 && < 0.7
 
     if !arch(javascript)
@@ -122,11 +121,13 @@ library
         CPP-Options:          -DHAVE_GHC_INTERNAL
 
     if flag(bootstrap)
+      CPP-Options: -DBOOTSTRAPPING
       build-depends:
             ghc-boot-th-next  == @ProjectVersionMunged@
     else
       build-depends:
-            ghc-boot-th       == @ProjectVersionMunged@
+            ghc-boot-th       == @ProjectVersionMunged@,
+            ghc-heap          >= 9.10.1 && <=@ProjectVersionMunged@
 
     if !os(windows)
         Build-Depends: unix >= 2.7 && < 2.9