summaryrefslogtreecommitdiff
path: root/compat
diff options
context:
space:
mode:
authorSimon Marlow <simonmar@microsoft.com>2006-04-07 02:05:11 +0000
committerSimon Marlow <simonmar@microsoft.com>2006-04-07 02:05:11 +0000
commit0065d5ab628975892cea1ec7303f968c3338cbe1 (patch)
tree8e2afe0ab48ee33cf95009809d67c9649573ef92 /compat
parent28a464a75e14cece5db40f2765a29348273ff2d2 (diff)
downloadhaskell-0065d5ab628975892cea1ec7303f968c3338cbe1.tar.gz
Reorganisation of the source tree
Most of the other users of the fptools build system have migrated to Cabal, and with the move to darcs we can now flatten the source tree without losing history, so here goes. The main change is that the ghc/ subdir is gone, and most of what it contained is now at the top level. The build system now makes no pretense at being multi-project, it is just the GHC build system. No doubt this will break many things, and there will be a period of instability while we fix the dependencies. A straightforward build should work, but I haven't yet fixed binary/source distributions. Changes to the Building Guide will follow, too.
Diffstat (limited to 'compat')
-rw-r--r--compat/Compat/Directory.hs131
-rw-r--r--compat/Compat/RawSystem.hs156
-rw-r--r--compat/Compat/Unicode.hs66
-rw-r--r--compat/Distribution/Compat/FilePath.hs3
-rw-r--r--compat/Distribution/Compat/ReadP.hs3
-rw-r--r--compat/Distribution/Compiler.hs3
-rw-r--r--compat/Distribution/GetOpt.hs3
-rw-r--r--compat/Distribution/InstalledPackageInfo.hs3
-rw-r--r--compat/Distribution/License.hs4
-rw-r--r--compat/Distribution/Package.hs3
-rw-r--r--compat/Distribution/ParseUtils.hs3
-rw-r--r--compat/Distribution/Version.hs3
-rw-r--r--compat/Language/Haskell/Extension.hs3
-rw-r--r--compat/Makefile101
-rw-r--r--compat/README32
-rw-r--r--compat/System/Directory/Internals.hs4
-rw-r--r--compat/cbits/directory.c96
-rw-r--r--compat/cbits/rawSystem.c140
-rw-r--r--compat/cbits/unicode.c3
-rw-r--r--compat/compat.mk44
-rw-r--r--compat/include/directory.h13
21 files changed, 817 insertions, 0 deletions
diff --git a/compat/Compat/Directory.hs b/compat/Compat/Directory.hs
new file mode 100644
index 0000000000..e6e4cd4a2c
--- /dev/null
+++ b/compat/Compat/Directory.hs
@@ -0,0 +1,131 @@
+{-# OPTIONS -cpp #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module : Compat.Directory
+-- Copyright : (c) The University of Glasgow 2001-2004
+-- License : BSD-style (see the file libraries/base/LICENSE)
+--
+-- Maintainer : libraries@haskell.org
+-- Stability : provisional
+-- Portability : portable
+--
+-- Functions from System.Directory that aren't present in older versions
+-- of that library.
+--
+-----------------------------------------------------------------------------
+
+module Compat.Directory (
+ getAppUserDataDirectory,
+ copyFile,
+ findExecutable,
+ createDirectoryIfMissing
+ ) where
+
+#include "../../includes/ghcconfig.h"
+
+import System.Environment (getEnv)
+import System.Directory.Internals
+#if __GLASGOW_HASKELL__ > 600
+import Control.Exception ( bracket )
+import Control.Monad ( when )
+import Foreign.Marshal.Alloc ( allocaBytes )
+import System.IO (IOMode(..), openBinaryFile, hGetBuf, hPutBuf, hClose)
+import System.IO.Error ( try )
+import GHC.IOBase ( IOException(..), IOErrorType(..) )
+#else
+import System.IO ( try )
+#endif
+#if __GLASGOW_HASKELL__ && defined(mingw32_HOST_OS)
+import Foreign.Ptr
+import Foreign.C
+#endif
+import System.Directory(doesFileExist, doesDirectoryExist, getPermissions, setPermissions, createDirectory)
+
+getAppUserDataDirectory :: String -> IO FilePath
+getAppUserDataDirectory appName = do
+#if __GLASGOW_HASKELL__ && defined(mingw32_HOST_OS)
+ allocaBytes long_path_size $ \pPath -> do
+ r <- c_SHGetFolderPath nullPtr csidl_APPDATA nullPtr 0 pPath
+ when (r<0) (raiseUnsupported "Compat.Directory.getAppUserDataDirectory")
+ s <- peekCString pPath
+ return (s++'\\':appName)
+#else
+ path <- getEnv "HOME"
+ return (path++'/':'.':appName)
+#endif
+
+#if __GLASGOW_HASKELL__ && defined(mingw32_HOST_OS)
+foreign import ccall unsafe "directory.h __hscore_getFolderPath"
+ c_SHGetFolderPath :: Ptr ()
+ -> CInt
+ -> Ptr ()
+ -> CInt
+ -> CString
+ -> IO CInt
+
+-- __compat_long_path_size defined in cbits/directory.c
+foreign import ccall unsafe "directory.h __compat_long_path_size"
+ long_path_size :: Int
+
+foreign import ccall unsafe "directory.h __hscore_CSIDL_APPDATA" csidl_APPDATA :: CInt
+
+raiseUnsupported loc =
+ ioError (IOError Nothing UnsupportedOperation loc "unsupported operation" Nothing)
+#endif
+
+
+copyFile :: FilePath -> FilePath -> IO ()
+copyFile fromFPath toFPath =
+#if (!(defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ > 600))
+ do readFile fromFPath >>= writeFile toFPath
+ try (getPermissions fromFPath >>= setPermissions toFPath)
+ return ()
+#else
+ (bracket (openBinaryFile fromFPath ReadMode) hClose $ \hFrom ->
+ bracket (openBinaryFile toFPath WriteMode) hClose $ \hTo ->
+ allocaBytes bufferSize $ \buffer -> do
+ copyContents hFrom hTo buffer
+ try (getPermissions fromFPath >>= setPermissions toFPath)
+ return ()) `catch` (ioError . changeFunName)
+ where
+ bufferSize = 1024
+
+ changeFunName (IOError h iot fun str mb_fp) = IOError h iot "copyFile" str mb_fp
+
+ copyContents hFrom hTo buffer = do
+ count <- hGetBuf hFrom buffer bufferSize
+ when (count > 0) $ do
+ hPutBuf hTo buffer count
+ copyContents hFrom hTo buffer
+#endif
+
+
+findExecutable :: String -> IO (Maybe FilePath)
+findExecutable binary = do
+ path <- getEnv "PATH"
+ search (parseSearchPath path)
+ where
+#ifdef mingw32_HOST_OS
+ fileName = binary `joinFileExt` "exe"
+#else
+ fileName = binary
+#endif
+
+ search :: [FilePath] -> IO (Maybe FilePath)
+ search [] = return Nothing
+ search (d:ds) = do
+ let path = d `joinFileName` fileName
+ b <- doesFileExist path
+ if b then return (Just path)
+ else search ds
+
+createDirectoryIfMissing :: Bool -- ^ Create its parents too?
+ -> FilePath -- ^ The path to the directory you want to make
+ -> IO ()
+createDirectoryIfMissing parents file = do
+ b <- doesDirectoryExist file
+ case (b,parents, file) of
+ (_, _, "") -> return ()
+ (True, _, _) -> return ()
+ (_, True, _) -> mapM_ (createDirectoryIfMissing False) (tail (pathParents file))
+ (_, False, _) -> createDirectory file
diff --git a/compat/Compat/RawSystem.hs b/compat/Compat/RawSystem.hs
new file mode 100644
index 0000000000..f0f8aa3ac7
--- /dev/null
+++ b/compat/Compat/RawSystem.hs
@@ -0,0 +1,156 @@
+{-# OPTIONS -cpp #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module : Compat.RawSystem
+-- Copyright : (c) The University of Glasgow 2001-2004
+-- License : BSD-style (see the file libraries/base/LICENSE)
+--
+-- Maintainer : libraries@haskell.org
+-- Stability : provisional
+-- Portability : portable
+--
+-- This is an implementation of rawSystem for use on older versions of GHC
+-- which had missing or buggy implementations of this function.
+--
+-----------------------------------------------------------------------------
+
+module Compat.RawSystem (rawSystem) where
+
+#include "../../includes/ghcconfig.h"
+
+#if __GLASGOW_HASKELL__ >= 603
+
+import System.Cmd (rawSystem)
+
+#else /* to end of file */
+
+import System.Exit
+import Foreign
+import Foreign.C
+
+{- |
+The computation @'rawSystem' cmd args@ runs the operating system command
+whose file name is @cmd@, passing it the arguments @args@. It
+bypasses the shell, so that @cmd@ should see precisely the argument
+strings @args@, with no funny escaping or shell meta-syntax expansion.
+(Unix users will recognise this behaviour
+as @execvp@, and indeed that's how it's implemented.)
+It will therefore behave more portably between operating systems than 'system'.
+
+The return codes are the same as for 'system'.
+-}
+
+rawSystem :: FilePath -> [String] -> IO ExitCode
+
+{- -------------------------------------------------------------------------
+ IMPORTANT IMPLEMENTATION NOTES
+ (see also libraries/base/cbits/rawSystem.c)
+
+On Unix, rawSystem is easy to implement: use execvp.
+
+On Windows it's more tricky. We use CreateProcess, passing a single
+command-line string (lpCommandLine) as its argument. (CreateProcess
+is well documented on http://msdn.microsoft/com.)
+
+ - It parses the beginning of the string to find the command. If the
+ file name has embedded spaces, it must be quoted, using double
+ quotes thus
+ "foo\this that\cmd" arg1 arg2
+
+ - The invoked command can in turn access the entire lpCommandLine string,
+ and the C runtime does indeed do so, parsing it to generate the
+ traditional argument vector argv[0], argv[1], etc. It does this
+ using a complex and arcane set of rules which are described here:
+
+ http://msdn.microsoft.com/library/default.asp?url=/library/en-us/vccelng/htm/progs_12.asp
+
+ (if this URL stops working, you might be able to find it by
+ searching for "Parsing C Command-Line Arguments" on MSDN. Also,
+ the code in the Microsoft C runtime that does this translation
+ is shipped with VC++).
+
+
+Our goal in rawSystem is to take a command filename and list of
+arguments, and construct a string which inverts the translatsions
+described above, such that the program at the other end sees exactly
+the same arguments in its argv[] that we passed to rawSystem.
+
+This inverse translation is implemented by 'translate' below.
+
+Here are some pages that give informations on Windows-related
+limitations and deviations from Unix conventions:
+
+ http://support.microsoft.com/default.aspx?scid=kb;en-us;830473
+ Command lines and environment variables effectively limited to 8191
+ characters on Win XP, 2047 on NT/2000 (probably even less on Win 9x):
+
+ http://www.microsoft.com/windowsxp/home/using/productdoc/en/default.asp?url=/WINDOWSXP/home/using/productdoc/en/percent.asp
+ Command-line substitution under Windows XP. IIRC these facilities (or at
+ least a large subset of them) are available on Win NT and 2000. Some
+ might be available on Win 9x.
+
+ http://www.microsoft.com/windowsxp/home/using/productdoc/en/default.asp?url=/WINDOWSXP/home/using/productdoc/en/Cmd.asp
+ How CMD.EXE processes command lines.
+
+
+Note: CreateProcess does have a separate argument (lpApplicationName)
+with which you can specify the command, but we have to slap the
+command into lpCommandLine anyway, so that argv[0] is what a C program
+expects (namely the application name). So it seems simpler to just
+use lpCommandLine alone, which CreateProcess supports.
+
+----------------------------------------------------------------------------- -}
+
+#ifndef mingw32_HOST_OS
+
+rawSystem cmd args =
+ withCString cmd $ \pcmd ->
+ withMany withCString (cmd:args) $ \cstrs ->
+ withArray0 nullPtr cstrs $ \arr -> do
+ status <- throwErrnoIfMinus1 "rawSystem" (c_rawSystem pcmd arr)
+ case status of
+ 0 -> return ExitSuccess
+ n -> return (ExitFailure n)
+
+foreign import ccall unsafe "rawSystem"
+ c_rawSystem :: CString -> Ptr CString -> IO Int
+
+#else
+
+-- On Windows, the command line is passed to the operating system as
+-- a single string. Command-line parsing is done by the executable
+-- itself.
+rawSystem cmd args = do
+ -- NOTE: 'cmd' is assumed to contain the application to run _only_,
+ -- as it'll be quoted surrounded in quotes here.
+ let cmdline = translate cmd ++ concat (map ((' ':) . translate) args)
+ withCString cmdline $ \pcmdline -> do
+ status <- throwErrnoIfMinus1 "rawSystem" (c_rawSystem pcmdline)
+ case status of
+ 0 -> return ExitSuccess
+ n -> return (ExitFailure n)
+
+translate :: String -> String
+translate str@('"':_) = str -- already escaped.
+ -- ToDo: this case is wrong. It is only here because we
+ -- abuse the system in GHC's SysTools by putting arguments into
+ -- the command name; at some point we should fix it up and remove
+ -- the case above.
+translate str = '"' : snd (foldr escape (True,"\"") str)
+ where escape '"' (b, str) = (True, '\\' : '"' : str)
+ escape '\\' (True, str) = (True, '\\' : '\\' : str)
+ escape '\\' (False, str) = (False, '\\' : str)
+ escape c (b, str) = (False, c : str)
+ -- See long comment above for what this function is trying to do.
+ --
+ -- The Bool passed back along the string is True iff the
+ -- rest of the string is a sequence of backslashes followed by
+ -- a double quote.
+
+foreign import ccall unsafe "rawSystem"
+ c_rawSystem :: CString -> IO Int
+
+#endif
+
+#endif
+
diff --git a/compat/Compat/Unicode.hs b/compat/Compat/Unicode.hs
new file mode 100644
index 0000000000..2637fac818
--- /dev/null
+++ b/compat/Compat/Unicode.hs
@@ -0,0 +1,66 @@
+{-# OPTIONS -cpp #-}
+module Compat.Unicode (
+ GeneralCategory(..), generalCategory, isPrint, isUpper
+ ) where
+
+#if __GLASGOW_HASKELL__ > 604
+
+import Data.Char (GeneralCategory(..), generalCategory,isPrint,isUpper)
+
+#else
+
+import Foreign.C ( CInt )
+import Data.Char ( ord )
+
+-- | Unicode General Categories (column 2 of the UnicodeData table)
+-- in the order they are listed in the Unicode standard.
+
+data GeneralCategory
+ = UppercaseLetter -- Lu Letter, Uppercase
+ | LowercaseLetter -- Ll Letter, Lowercase
+ | TitlecaseLetter -- Lt Letter, Titlecase
+ | ModifierLetter -- Lm Letter, Modifier
+ | OtherLetter -- Lo Letter, Other
+ | NonSpacingMark -- Mn Mark, Non-Spacing
+ | SpacingCombiningMark -- Mc Mark, Spacing Combining
+ | EnclosingMark -- Me Mark, Enclosing
+ | DecimalNumber -- Nd Number, Decimal
+ | LetterNumber -- Nl Number, Letter
+ | OtherNumber -- No Number, Other
+ | ConnectorPunctuation -- Pc Punctuation, Connector
+ | DashPunctuation -- Pd Punctuation, Dash
+ | OpenPunctuation -- Ps Punctuation, Open
+ | ClosePunctuation -- Pe Punctuation, Close
+ | InitialQuote -- Pi Punctuation, Initial quote
+ | FinalQuote -- Pf Punctuation, Final quote
+ | OtherPunctuation -- Po Punctuation, Other
+ | MathSymbol -- Sm Symbol, Math
+ | CurrencySymbol -- Sc Symbol, Currency
+ | ModifierSymbol -- Sk Symbol, Modifier
+ | OtherSymbol -- So Symbol, Other
+ | Space -- Zs Separator, Space
+ | LineSeparator -- Zl Separator, Line
+ | ParagraphSeparator -- Zp Separator, Paragraph
+ | Control -- Cc Other, Control
+ | Format -- Cf Other, Format
+ | Surrogate -- Cs Other, Surrogate
+ | PrivateUse -- Co Other, Private Use
+ | NotAssigned -- Cn Other, Not Assigned
+ deriving (Eq, Ord, Enum, Read, Show, Bounded)
+
+-- | Retrieves the general Unicode category of the character.
+generalCategory :: Char -> GeneralCategory
+generalCategory c = toEnum (wgencat (fromIntegral (ord c)))
+
+foreign import ccall unsafe "u_gencat"
+ wgencat :: CInt -> Int
+
+isPrint c = iswprint (fromIntegral (ord c)) /= 0
+isUpper c = iswupper (fromIntegral (ord c)) /= 0
+
+foreign import ccall unsafe "u_iswprint"
+ iswprint :: CInt -> CInt
+
+foreign import ccall unsafe "u_iswupper"
+ iswupper :: CInt -> CInt
+#endif
diff --git a/compat/Distribution/Compat/FilePath.hs b/compat/Distribution/Compat/FilePath.hs
new file mode 100644
index 0000000000..2dbd337b67
--- /dev/null
+++ b/compat/Distribution/Compat/FilePath.hs
@@ -0,0 +1,3 @@
+{-# OPTIONS -cpp #-}
+#include "Cabal/Distribution/Compat/FilePath.hs"
+-- dummy comment
diff --git a/compat/Distribution/Compat/ReadP.hs b/compat/Distribution/Compat/ReadP.hs
new file mode 100644
index 0000000000..5fc69da3da
--- /dev/null
+++ b/compat/Distribution/Compat/ReadP.hs
@@ -0,0 +1,3 @@
+{-# OPTIONS -cpp #-}
+#include "Cabal/Distribution/Compat/ReadP.hs"
+-- dummy comment
diff --git a/compat/Distribution/Compiler.hs b/compat/Distribution/Compiler.hs
new file mode 100644
index 0000000000..b5a2f68f1e
--- /dev/null
+++ b/compat/Distribution/Compiler.hs
@@ -0,0 +1,3 @@
+{-# OPTIONS -cpp #-}
+#include "Cabal/Distribution/Compiler.hs"
+-- dummy comment
diff --git a/compat/Distribution/GetOpt.hs b/compat/Distribution/GetOpt.hs
new file mode 100644
index 0000000000..7da2e30431
--- /dev/null
+++ b/compat/Distribution/GetOpt.hs
@@ -0,0 +1,3 @@
+{-# OPTIONS -cpp #-}
+#include "Cabal/Distribution/GetOpt.hs"
+-- dummy comment
diff --git a/compat/Distribution/InstalledPackageInfo.hs b/compat/Distribution/InstalledPackageInfo.hs
new file mode 100644
index 0000000000..03f509216a
--- /dev/null
+++ b/compat/Distribution/InstalledPackageInfo.hs
@@ -0,0 +1,3 @@
+{-# OPTIONS -cpp #-}
+#include "Cabal/Distribution/InstalledPackageInfo.hs"
+-- dummy comment
diff --git a/compat/Distribution/License.hs b/compat/Distribution/License.hs
new file mode 100644
index 0000000000..31b1b271a6
--- /dev/null
+++ b/compat/Distribution/License.hs
@@ -0,0 +1,4 @@
+{-# OPTIONS -cpp #-}
+#include "Cabal/Distribution/License.hs"
+
+-- dummy comment
diff --git a/compat/Distribution/Package.hs b/compat/Distribution/Package.hs
new file mode 100644
index 0000000000..d40171eec5
--- /dev/null
+++ b/compat/Distribution/Package.hs
@@ -0,0 +1,3 @@
+{-# OPTIONS -cpp #-}
+#include "Cabal/Distribution/Package.hs"
+-- dummy comment
diff --git a/compat/Distribution/ParseUtils.hs b/compat/Distribution/ParseUtils.hs
new file mode 100644
index 0000000000..f5bf266a95
--- /dev/null
+++ b/compat/Distribution/ParseUtils.hs
@@ -0,0 +1,3 @@
+{-# OPTIONS -cpp #-}
+#include "Cabal/Distribution/ParseUtils.hs"
+-- dummy comment
diff --git a/compat/Distribution/Version.hs b/compat/Distribution/Version.hs
new file mode 100644
index 0000000000..1140c03cbd
--- /dev/null
+++ b/compat/Distribution/Version.hs
@@ -0,0 +1,3 @@
+{-# OPTIONS -cpp #-}
+#include "Cabal/Distribution/Version.hs"
+-- dummy comment
diff --git a/compat/Language/Haskell/Extension.hs b/compat/Language/Haskell/Extension.hs
new file mode 100644
index 0000000000..410a07b4d6
--- /dev/null
+++ b/compat/Language/Haskell/Extension.hs
@@ -0,0 +1,3 @@
+{-# OPTIONS -cpp #-}
+#include "Cabal/Language/Haskell/Extension.hs"
+-- dummy comment
diff --git a/compat/Makefile b/compat/Makefile
new file mode 100644
index 0000000000..b4e18c9bbc
--- /dev/null
+++ b/compat/Makefile
@@ -0,0 +1,101 @@
+TOP=..
+include $(TOP)/mk/boilerplate.mk
+
+ALL_DIRS = \
+ Data \
+ Compat \
+ Distribution \
+ Distribution/Compat \
+ Language/Haskell \
+ System \
+ System/Directory \
+ cbits
+
+SplitObjs=NO
+LIBRARY = libghccompat.a
+
+# We don't want this installed
+NO_INSTALL_LIBRARY = YES
+
+# Avoid building the GHCi lib, since we don't need it
+GhcWithInterpreter = NO
+
+# Needed so that the libraries can #include relative to this directory.
+INCLUDE_DIRS=-I. -Iinclude
+
+SRC_HC_OPTS += $(INCLUDE_DIRS)
+SRC_CC_OPTS += $(INCLUDE_DIRS)
+MKDEPENDC_OPTS += $(INCLUDE_DIRS)
+
+# Just to silence warnings
+MKDEPENDC_OPTS += -I$(GHC_INCLUDE_DIR)
+
+UseGhcForCc = YES
+
+# This library is linked to the compiler, at least in stage1, so we
+# better make sure it is built the same "way".
+#
+# BUT, if GhcHcOpts includes -DDEBUG we *don't* want to compile
+# lib/compat with -DDEBUG, because the preprocessor symbols used
+# by the compiler may be understood differently by library code.
+# In this particular case, it turned out that -DDEBUG made Cabal
+# import HUnit, which might not be installed for the compiler we are
+# compiling with (e.g. 6.2.1). Hence the filter-out.
+SRC_HC_OPTS += $(filter-out -D%, $(GhcHcOpts))
+
+# GHC 6.4 didn't have WCsubst.c, but 6.4.1 did, and we need to know
+# this in cbits/unicode.c The patchlevel isn't normally exposed as a
+# CPP symbol, so we have to do it by hand:
+SRC_CC_OPTS += -D__GHC_PATCHLEVEL__=$(GhcPatchLevel)
+
+ifeq "$(ghc_ge_603)" "YES"
+# These modules are provided in GHC 6.3+
+EXCLUDED_SRCS += \
+ System/Directory/Internals.hs
+
+SRC_MKDEPENDHS_OPTS += \
+ -optdep--exclude-module=System.Directory.Internals
+
+# GHC 6.3+ has Cabal, but we're replacing it:
+SRC_HC_OPTS += -ignore-package Cabal
+endif
+
+# Some explicit dependencies, needed because ghc -M can't discover the
+# true dependencies of these stub files.
+System/Directory/Internals.$(way_)o : $(FPTOOLS_TOP)/libraries/base/System/Directory/Internals.hs
+Distribution/Compat/FilePath.$(way_) : $(FPTOOLS_TOP)/libraries/Cabal/Distribution/Compat/FilePath.hs
+Distribution/Compat/ReadP.$(way_) : $(FPTOOLS_TOP)/libraries/Cabal/Distribution/Compat/ReadP.hs
+Distribution/GetOpt.$(way_)o : $(FPTOOLS_TOP)/libraries/Cabal/Distribution/GetOpt.hs
+Distribution/InstalledPackageInfo.$(way_)o : $(FPTOOLS_TOP)/libraries/Cabal/Distribution/InstalledPackageInfo.hs
+Distribution/License.$(way_)o : $(FPTOOLS_TOP)/libraries/Cabal/Distribution/License.hs
+Distribution/Package.$(way_)o : $(FPTOOLS_TOP)/libraries/Cabal/Distribution/Package.hs
+Distribution/ParseUtils.$(way_)o : $(FPTOOLS_TOP)/libraries/Cabal/Distribution/ParseUtils.hs
+Distribution/Compiler.$(way_)o : $(FPTOOLS_TOP)/libraries/Cabal/Distribution/Compiler.hs
+Distribution/Version.$(way_)o : $(FPTOOLS_TOP)/libraries/Cabal/Distribution/Version.hs
+Language/Haskell/Extension.$(way_)o : $(FPTOOLS_TOP)/libraries/Cabal/Language/Haskell/Extension.hs
+cbits/unicode.o : $(FPTOOLS_TOP)/libraries/base/cbits/WCsubst.c $(FPTOOLS_TOP)/libraries/base/include/WCsubst.h
+
+SRC_CC_OPTS += -I$(FPTOOLS_TOP)/libraries/base/cbits -I$(FPTOOLS_TOP)/libraries/base/include
+
+# Make the #includes in the stubs independent of the current location
+SRC_HC_OPTS += -I$(FPTOOLS_TOP)/libraries
+
+SRC_HC_OPTS += -fglasgow-exts -no-recomp
+
+ifeq "$(HOSTPLATFORM)" "i386-unknown-mingw32"
+Compat/Directory_HC_OPTS += -\#include shlobj.h
+endif
+
+# libghccompat is needed to build ghc-pkg, which is built during 'make boot',
+# so we must build this library during 'make boot' too.
+# Do a recursive 'make all' after generating dependencies, because this
+# will work with 'make -j'.
+ifneq "$(BootingFromHc)" "YES"
+boot :: depend
+ $(MAKE) all
+endif
+
+# We don't ever want to build libghccompat as a shared library.
+GhcBuildDylibs=NO
+
+include $(TOP)/mk/target.mk
diff --git a/compat/README b/compat/README
new file mode 100644
index 0000000000..8d0697beb4
--- /dev/null
+++ b/compat/README
@@ -0,0 +1,32 @@
+GHC compatibiliy library: libghccompat.a
+----------------------------------------
+
+This library contains interfaces that are available in recent versions
+of GHC, but may or may not be available in older versions. The idea
+is to provide an abstraction layer and reduce the amount of #ifdefery
+and code duplication in GHC and its tools. Furthermore, we can add
+modules to the main library and start using them right away in GHC, by
+adding a stub to this compat library.
+
+There are two types of modules in here:
+
+(a) a module with the same name as a module in the main library
+ (eg. Distribution.Package). If the module is available in
+ the main library, then we don't include it in libghccompat.
+ Otherwise, we have a stub module here that just #includes
+ the source from the real location under libraries/. Go look
+ at Distribution/Package.hs for example.
+
+(b) a module that doesn't exist in another library. For example,
+ Compat.RawSystem. These modules are used to provide functions
+ that are available in newer versions of the main libraries.
+
+BIG NOTE: when building stage 2 of GHC, libghccompat is not used,
+because we would have to build another version of it. Instead, we
+just use the appropriate libraries directly. For (a)-type modules,
+just import the module directly. For (b)-type modules, a single
+#ifdef will be required to choose between the Compat version and
+the real version.
+
+In stage 1 of GHC, and tools (eg. ghc-pkg, runghc), libghccompat.a
+is linked in, so all its libraries will be accessible.
diff --git a/compat/System/Directory/Internals.hs b/compat/System/Directory/Internals.hs
new file mode 100644
index 0000000000..5ac8e3ba24
--- /dev/null
+++ b/compat/System/Directory/Internals.hs
@@ -0,0 +1,4 @@
+{-# OPTIONS -cpp #-}
+#include "../../includes/ghcplatform.h"
+#include "base/System/Directory/Internals.hs"
+-- dummy comment
diff --git a/compat/cbits/directory.c b/compat/cbits/directory.c
new file mode 100644
index 0000000000..79d6cd4d44
--- /dev/null
+++ b/compat/cbits/directory.c
@@ -0,0 +1,96 @@
+#include "HsFFI.h"
+
+#include "../../../includes/ghcconfig.h"
+
+#if HAVE_LIMITS_H
+#include <limits.h>
+#endif
+#if HAVE_WINDOWS_H
+#include <windows.h>
+#endif
+#include "directory.h"
+
+#define INLINE /* nothing */
+
+/*
+ * Following code copied from libraries/base/includes/HsBase.h
+ */
+
+#ifdef PATH_MAX
+/* A size that will contain many path names, but not necessarily all
+ * (PATH_MAX is not defined on systems with unlimited path length,
+ * e.g. the Hurd).
+ */
+INLINE HsInt __compat_long_path_size() { return PATH_MAX; }
+#else
+INLINE HsInt __compat_long_path_size() { return 4096; }
+#endif
+
+#if defined(mingw32_HOST_OS)
+
+/* Make sure we've got the reqd CSIDL_ constants in scope;
+ * w32api header files are lagging a bit in defining the full set.
+ */
+#if !defined(CSIDL_APPDATA)
+#define CSIDL_APPDATA 0x001a
+#endif
+#if !defined(CSIDL_PERSONAL)
+#define CSIDL_PERSONAL 0x0005
+#endif
+#if !defined(CSIDL_PROFILE)
+#define CSIDL_PROFILE 0x0028
+#endif
+#if !defined(CSIDL_WINDOWS)
+#define CSIDL_WINDOWS 0x0024
+#endif
+
+INLINE int __hscore_CSIDL_PROFILE() { return CSIDL_PROFILE; }
+INLINE int __hscore_CSIDL_APPDATA() { return CSIDL_APPDATA; }
+INLINE int __hscore_CSIDL_WINDOWS() { return CSIDL_WINDOWS; }
+INLINE int __hscore_CSIDL_PERSONAL() { return CSIDL_PERSONAL; }
+
+#if __GLASGOW_HASKELL__ < 604
+/*
+ * Function: __hscore_getFolderPath()
+ *
+ * Late-bound version of SHGetFolderPath(), coping with OS versions
+ * that have shell32's lacking that particular API.
+ *
+ */
+typedef HRESULT (*HSCORE_GETAPPFOLDERFUNTY)(HWND,int,HANDLE,DWORD,char*);
+int
+__hscore_getFolderPath(HWND hwndOwner,
+ int nFolder,
+ HANDLE hToken,
+ DWORD dwFlags,
+ char* pszPath)
+{
+ static int loaded_dll = 0;
+ static HMODULE hMod = (HMODULE)NULL;
+ static HSCORE_GETAPPFOLDERFUNTY funcPtr = NULL;
+ /* The DLLs to try loading entry point from */
+ char* dlls[] = { "shell32.dll", "shfolder.dll" };
+
+ if (loaded_dll < 0) {
+ return (-1);
+ } else if (loaded_dll == 0) {
+ int i;
+ for(i=0;i < sizeof(dlls); i++) {
+ hMod = LoadLibrary(dlls[i]);
+ if ( hMod != NULL &&
+ (funcPtr = (HSCORE_GETAPPFOLDERFUNTY)GetProcAddress(hMod, "SHGetFolderPathA")) ) {
+ loaded_dll = 1;
+ break;
+ }
+ }
+ if (loaded_dll == 0) {
+ loaded_dll = (-1);
+ return (-1);
+ }
+ }
+ /* OK, if we got this far the function has been bound */
+ return (int)funcPtr(hwndOwner,nFolder,hToken,dwFlags,pszPath);
+ /* ToDo: unload the DLL on shutdown? */
+}
+#endif /* __GLASGOW_HASKELL__ < 604 */
+#endif
diff --git a/compat/cbits/rawSystem.c b/compat/cbits/rawSystem.c
new file mode 100644
index 0000000000..00b8c49cc1
--- /dev/null
+++ b/compat/cbits/rawSystem.c
@@ -0,0 +1,140 @@
+/*
+ * (c) The University of Glasgow 1994-2004
+ *
+ * WARNING: this file is here for backwards compatibility only. It is
+ * not included as part of the base package, but is #included into the
+ * compiler and the runghc utility when building either of these with
+ * an old version of GHC.
+ *
+ * shell-less system Runtime Support (see System.Cmd.rawSystem).
+ */
+
+/* The itimer stuff in this module is non-posix */
+/* #include "PosixSource.h" */
+
+#include "../../../includes/ghcconfig.h"
+
+#include <stdio.h>
+#include <stdlib.h>
+
+#ifdef HAVE_UNISTD_H
+#include <unistd.h>
+#endif
+#ifdef HAVE_ERRNO_H
+#include <errno.h>
+#endif
+#ifdef HAVE_SYS_WAIT_H
+#include <sys/wait.h>
+#endif
+
+# ifdef TIME_WITH_SYS_TIME
+# include <sys/time.h>
+# include <time.h>
+# else
+# ifdef HAVE_SYS_TIME_H
+# include <sys/time.h>
+# else
+# include <time.h>
+# endif
+# endif
+
+#include "HsFFI.h"
+
+#if defined(mingw32_HOST_OS)
+#include <windows.h>
+#endif
+
+#ifdef HAVE_VFORK_H
+#include <vfork.h>
+#endif
+
+#ifdef HAVE_VFORK
+#define fork vfork
+#endif
+
+#if defined(mingw32_HOST_OS)
+/* -------------------- WINDOWS VERSION --------------------- */
+
+HsInt
+rawSystem(HsAddr cmd)
+{
+ STARTUPINFO sInfo;
+ PROCESS_INFORMATION pInfo;
+ DWORD retCode;
+
+ ZeroMemory(&sInfo, sizeof(sInfo));
+ sInfo.cb = sizeof(sInfo);
+
+ if (!CreateProcess(NULL, cmd, NULL, NULL, TRUE, 0, NULL, NULL, &sInfo, &pInfo)) {
+ /* The 'TRUE' says that the created process should share
+ handles with the current process. This is vital to ensure
+ that error messages sent to stderr actually appear on the screen.
+ Since we are going to wait for the process to terminate anyway,
+ there is no problem with such sharing. */
+
+ errno = EINVAL; // ToDo: wrong, caller should use GetLastError()
+ return -1;
+ }
+ WaitForSingleObject(pInfo.hProcess, INFINITE);
+ if (GetExitCodeProcess(pInfo.hProcess, &retCode) == 0) {
+ errno = EINVAL; // ToDo: wrong, caller should use GetLastError()
+ return -1;
+ }
+
+ CloseHandle(pInfo.hProcess);
+ CloseHandle(pInfo.hThread);
+ return retCode;
+}
+
+#else
+/* -------------------- UNIX VERSION --------------------- */
+
+HsInt
+rawSystem(HsAddr cmd, HsAddr args)
+{
+ int pid;
+ int wstat;
+
+ switch(pid = fork()) {
+ case -1:
+ {
+ return -1;
+ }
+ case 0:
+ {
+#ifdef HAVE_SETITIMER
+ /* Reset the itimers in the child, so it doesn't get plagued
+ * by SIGVTALRM interrupts.
+ */
+ struct timeval tv_null = { 0, 0 };
+ struct itimerval itv;
+ itv.it_interval = tv_null;
+ itv.it_value = tv_null;
+ setitimer(ITIMER_REAL, &itv, NULL);
+ setitimer(ITIMER_VIRTUAL, &itv, NULL);
+ setitimer(ITIMER_PROF, &itv, NULL);
+#endif
+
+ /* the child */
+ execvp(cmd, args);
+ _exit(127);
+ }
+ }
+
+ while (waitpid(pid, &wstat, 0) < 0) {
+ if (errno != EINTR) {
+ return -1;
+ }
+ }
+
+ if (WIFEXITED(wstat))
+ return WEXITSTATUS(wstat);
+ else if (WIFSIGNALED(wstat)) {
+ errno = EINTR;
+ }
+ else {
+ /* This should never happen */
+ }
+ return -1;
+}
+#endif
diff --git a/compat/cbits/unicode.c b/compat/cbits/unicode.c
new file mode 100644
index 0000000000..c744cc9436
--- /dev/null
+++ b/compat/cbits/unicode.c
@@ -0,0 +1,3 @@
+#if __GLASGOW_HASKELL__ < 604 || (__GLASGOW_HASKELL__==604 && __GHC_PATCHLEVEL__==0)
+#include "WCsubst.c"
+#endif
diff --git a/compat/compat.mk b/compat/compat.mk
new file mode 100644
index 0000000000..48b2bea76d
--- /dev/null
+++ b/compat/compat.mk
@@ -0,0 +1,44 @@
+# Settings for using the libghccompat.a library elsewhere in the build
+# tree: this file is just included into Makefiles, see
+# utils/ghc-pkg/Makefile for example.
+#
+# This is a poor-mans package, but simpler because we don't
+# have to deal with variations in the package support of different
+# versions of GHC.
+
+# Use libghccompat.a:
+SRC_HC_OPTS += -i$(GHC_COMPAT_DIR)
+SRC_LD_OPTS += -L$(GHC_COMPAT_DIR) -lghccompat
+
+# Do *not* use the installed Cabal:
+ifeq "$(ghc_ge_603)" "YES"
+SRC_HC_OPTS += -ignore-package Cabal
+endif
+
+# And similarly for when booting from .hc files:
+HC_BOOT_LD_OPTS += -L$(GHC_COMPAT_DIR)
+HC_BOOT_LIBS += -lghccompat
+
+ifeq "$(Windows)" "YES"
+# not very nice, but required for -lghccompat on Windows
+SRC_LD_OPTS += -lshell32
+HC_BOOT_LIBS += -lshell32
+endif
+
+# This is horrible. We ought to be able to omit the entire directory
+# from mkDependHS.
+SRC_MKDEPENDHS_OPTS += \
+ -optdep--exclude-module=Compat.RawSystem \
+ -optdep--exclude-module=Compat.Directory \
+ -optdep--exclude-module=Compat.Unicode \
+ -optdep--exclude-module=Distribution.Compat.FilePath \
+ -optdep--exclude-module=Distribution.Compat.ReadP \
+ -optdep--exclude-module=Distribution.Extension \
+ -optdep--exclude-module=Distribution.GetOpt \
+ -optdep--exclude-module=Distribution.InstalledPackageInfo \
+ -optdep--exclude-module=Distribution.License \
+ -optdep--exclude-module=Distribution.Package \
+ -optdep--exclude-module=Distribution.ParseUtils \
+ -optdep--exclude-module=Distribution.Compiler \
+ -optdep--exclude-module=Distribution.Version \
+ -optdep--exclude-module=System.Directory.Internals
diff --git a/compat/include/directory.h b/compat/include/directory.h
new file mode 100644
index 0000000000..2e26c3d5a1
--- /dev/null
+++ b/compat/include/directory.h
@@ -0,0 +1,13 @@
+#ifndef __DIRECTORY_H__
+#define __DIRECTORY_H__
+
+#if defined(mingw32_HOST_OS)
+extern int __compat_long_path_size();
+extern int __hscore_CSIDL_APPDATA();
+extern int __hscore_getFolderPath(HWND hwndOwner,
+ int nFolder,
+ HANDLE hToken,
+ DWORD dwFlags,
+ char* pszPath);
+#endif
+#endif