make Setup and base.cabal suitable for building the libraries with GHC

diff --git a/GHC/PArr.hs b/GHC/PArr.hs
index 0b5154e..cd2f03b 100644 (file)
--- a/GHC/PArr.hs
+++ b/GHC/PArr.hs
@@ -141,6 +141,8 @@ module GHC.PArr (
   indexOfP             -- :: (a -> Bool) -> [:a:] -> [:Int:]
 ) where
 
+#ifndef __HADDOCK__
+
 import Prelude
 
 import GHC.ST   ( ST(..), STRep, runST )
@@ -712,3 +714,6 @@ writeMPArr (MPArr n# marr#) (I# i#) e
   | otherwise = error $ "writeMPArr: out of bounds parallel array index; " ++
                        "idx = " ++ show (I# i#) ++ ", arr len = "
                        ++ show (I# n#)
+
+#endif /* __HADDOCK__ */
+

diff --git a/Setup.hs b/Setup.hs
new file mode 100644 (file)
index 0000000..13502f4
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,104 @@
+
+{-
+We need to do some ugly hacks here as base mix of portable and
+unportable stuff, as well as home to some GHC magic.
+-}
+
+module Main (main) where
+
+import Control.Monad
+import Data.List
+import Distribution.Simple
+import Distribution.PackageDescription
+import Distribution.PreProcess
+import Distribution.Setup
+import Distribution.Simple.Configure
+import Distribution.Simple.LocalBuildInfo
+import System.Environment
+import System.Exit
+
+main :: IO ()
+main = do args <- getArgs
+          let (ghcArgs, args') = extractGhcArgs args
+          let hooks = defaultUserHooks {
+                  confHook = add_extra_deps
+                           $ confHook defaultUserHooks,
+                  buildHook = add_ghc_options ghcArgs
+                            $ filter_modules_hook
+                            $ buildHook defaultUserHooks,
+                  instHook = filter_modules_hook
+                           $ instHook defaultUserHooks }
+          withArgs args' $ defaultMainWithHooks hooks
+
+extractGhcArgs :: [String] -> ([String], [String])
+extractGhcArgs args
+ = let f [] = ([], [])
+       f (x:xs) = case f xs of
+                      (ghcArgs, otherArgs) ->
+                          case removePrefix "--ghc-option=" x of
+                              Just ghcArg ->
+                                  (ghcArg:ghcArgs, otherArgs)
+                              Nothing ->
+                                  (ghcArgs, x:otherArgs)
+   in f args
+
+removePrefix :: String -> String -> Maybe String
+removePrefix "" ys = Just ys
+removePrefix (x:xs) (y:ys)
+ | x == y = removePrefix xs ys
+ | otherwise = Nothing
+
+type Hook a = PackageDescription -> LocalBuildInfo -> Maybe UserHooks -> a
+           -> IO ()
+type ConfHook = PackageDescription -> ConfigFlags -> IO LocalBuildInfo
+
+-- type PDHook = PackageDescription -> ConfigFlags -> IO ()
+
+add_ghc_options :: [String] -> Hook a -> Hook a
+add_ghc_options args f pd lbi muhs x
+ = do let lib' = case library pd of
+                     Just lib ->
+                         let bi = libBuildInfo lib
+                             opts = options bi ++ [(GHC, args)]
+                             bi' = bi { options = opts }
+                         in lib { libBuildInfo = bi' }
+                     Nothing -> error "Expected a library"
+          pd' = pd { library = Just lib' }
+      f pd' lbi muhs x
+
+filter_modules_hook :: Hook a -> Hook a
+filter_modules_hook f pd lbi muhs x
+ = let build_filter = case compilerFlavor $ compiler lbi of
+                          GHC -> forGHCBuild
+                          _ -> isPortableBuild
+       lib' = case library pd of
+                  Just lib ->
+                      let ems = filter build_filter (exposedModules lib)
+                      in lib { exposedModules = ems }
+                  Nothing -> error "Expected a library"
+       pd' = pd { library = Just lib' }
+   in f pd' lbi muhs x
+
+isPortableBuild :: String -> Bool
+isPortableBuild s
+ | "GHC" `isPrefixOf` s = False
+ | "Data.Generics" `isPrefixOf` s = False
+ | otherwise = s `elem` ["Foreign.Concurrent",
+                         "System.Process"]
+
+forGHCBuild :: String -> Bool
+forGHCBuild = ("GHC.Prim" /=)
+
+add_extra_deps :: ConfHook -> ConfHook
+add_extra_deps f pd cf
+ = do lbi <- f pd cf
+      case compilerFlavor (compiler lbi) of
+          GHC ->
+              do -- Euch. We should just add the right thing to the lbi
+                 -- ourselves rather than rerunning configure.
+                 let pd' = pd { buildDepends = Dependency "rts" AnyVersion
+                                             : buildDepends pd }
+                 f pd' cf
+          _ ->
+              return lbi
+

diff --git a/base.cabal b/base.cabal
index e670051..6e696e7 100644 (file)
--- a/base.cabal
+++ b/base.cabal
@@ -51,13 +51,13 @@ exposed-modules:
        Data.Foldable,
        Data.Fixed,
        Data.Function,
-       -- Data.Generics,
-       -- Data.Generics.Aliases,
-       -- Data.Generics.Basics,
-       -- Data.Generics.Instances,
-       -- Data.Generics.Schemes,
-       -- Data.Generics.Text,
-       -- Data.Generics.Twins,
+       Data.Generics,
+       Data.Generics.Aliases,
+       Data.Generics.Basics,
+       Data.Generics.Instances,
+       Data.Generics.Schemes,
+       Data.Generics.Text,
+       Data.Generics.Twins,
        Data.Graph,
        Data.HashTable,
        Data.IORef,
@@ -91,7 +91,7 @@ exposed-modules:
        Foreign.C.Error,
        Foreign.C.String,
        Foreign.C.Types,
-       -- Foreign.Concurrent,
+       Foreign.Concurrent,
        Foreign.ForeignPtr,
        Foreign.Marshal,
        Foreign.Marshal.Alloc,
@@ -102,6 +102,40 @@ exposed-modules:
        Foreign.Ptr,
        Foreign.StablePtr,
        Foreign.Storable,
+       GHC.Arr,
+       GHC.Base,
+       GHC.Conc,
+       GHC.ConsoleHandler,
+       GHC.Dotnet,
+       GHC.Dynamic,
+       GHC.Enum,
+       GHC.Err,
+       GHC.Exception,
+       GHC.Exts,
+       GHC.Float,
+       GHC.ForeignPtr,
+       GHC.Handle,
+       GHC.IO,
+       GHC.IOBase,
+       GHC.Int,
+       GHC.List,
+       GHC.Num,
+       GHC.PArr,
+       GHC.Pack,
+       GHC.Prim,
+       GHC.PrimopWrappers,
+       GHC.Ptr,
+       GHC.Read,
+       GHC.Real,
+       GHC.ST,
+       GHC.STRef,
+       GHC.Show,
+       GHC.Stable,
+       GHC.Storable,
+       GHC.TopHandler,
+       GHC.Unicode,
+       GHC.Weak,
+       GHC.Word,
        Numeric,
        Prelude,
        System.Cmd,
@@ -122,7 +156,7 @@ exposed-modules:
        System.Posix.Internals,
        System.Posix.Signals,
        System.Posix.Types,
-       -- System.Process,
+       System.Process,
        System.Process.Internals,
        System.Random,
        System.Time,
@@ -138,6 +172,25 @@ exposed-modules:
        Unsafe.Coerce
 other-modules:
        Data.Array.IO.Internals
-include-dirs:  include, ../../ghc/includes
+c-sources:
+       cbits/PrelIOUtils.c
+       cbits/WCsubst.c
+       cbits/Win32Utils.c
+       cbits/consUtils.c
+       cbits/dirUtils.c
+       cbits/execvpe.c
+       cbits/fpstring.c
+       cbits/inputReady.c
+       cbits/lockFile.c
+       cbits/longlong.c
+       cbits/runProcess.c
+       cbits/selectUtils.c
+       cbits/timeUtils.c
+include-dirs: include, ../../includes, ../../rts
 includes:      HsBase.h
 extensions:    CPP
+-- XXX is there an extension for using # in varids?
+-- We need to set the package name to base (without a version number)
+-- as it's magic.
+ghc-options: -fglasgow-exts -package-name base -v0
+