diff --git a/Distribution/PackageDescription.hs b/Distribution/PackageDescription.hs
index 3777aaf409cefe22c6494872e49a09d7c974680d..52adda0f9b39678ce4c0548677e12670cb78055f 100644
--- a/Distribution/PackageDescription.hs
+++ b/Distribution/PackageDescription.hs
@@ -43,7 +43,7 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -}
 module Distribution.PackageDescription (
         -- * Package descriptions
         PackageDescription(..),
-        PreparedPackageDescription(..),
+        GenericPackageDescription(..),
         finalizePackageDescription,
         emptyPackageDescription,
         readPackageDescription,
@@ -198,8 +198,8 @@ emptyPackageDescription
                       extraTmpFiles = []
                      }
 
-data PreparedPackageDescription = 
-    PreparedPackageDescription {
+data GenericPackageDescription = 
+    GenericPackageDescription {
         packageDescription :: PackageDescription,
         packageFlags       :: [Flag],
         condLibrary        :: Maybe (CondTree ConfVar Dependency Library),
@@ -208,8 +208,8 @@ data PreparedPackageDescription =
     --deriving (Show)
 
 -- XXX: I think we really want a PPrint or Pretty or ShowPretty class.
-instance Show PreparedPackageDescription where
-    show (PreparedPackageDescription pkg flgs mlib exes) =
+instance Show GenericPackageDescription where
+    show (GenericPackageDescription pkg flgs mlib exes) =
         showPackageDescription pkg ++ "\n" ++
         (render $ vcat $ map ppFlag flgs) ++ "\n" ++
         render (maybe empty (\l -> text "Library:" $+$ 
@@ -229,11 +229,11 @@ instance Show PreparedPackageDescription where
 
 finalizePackageDescription :: [(String,Bool)] -> Maybe [PackageIdentifier] 
                            -> String -> String
-                           -> PreparedPackageDescription
+                           -> GenericPackageDescription
                            -> Either [Dependency]
                                      (PackageDescription, [(String,Bool)])
 finalizePackageDescription userflags mpkgs os arch 
-        (PreparedPackageDescription pkg flags mlib0 exes) =
+        (GenericPackageDescription pkg flags mlib0 exes) =
     case resolveFlags mlib0 of 
       Right (mlib, deps, flagVals) ->
         let exes' = finalizeExes flagVals in
@@ -726,7 +726,7 @@ readHookedBuildInfo verbosity = readAndParseFile verbosity parseHookedBuildInfo
 -- |Parse the given package file.
 -- readPackageDescription :: Int -> FilePath -> IO PackageDescription
 -- readPackageDescription verbosity = readAndParseFile verbosity parseDescription 
-readPackageDescription :: Verbosity -> FilePath -> IO PreparedPackageDescription
+readPackageDescription :: Verbosity -> FilePath -> IO GenericPackageDescription
 readPackageDescription verbosity = 
     readAndParseFile verbosity (\s -> readFields s >>= parseDescription') 
 {-
@@ -860,7 +860,7 @@ skipField :: PM ()
 skipField = modify tail
 
 -- | Parses the pre-parsed list of fields into a prepared package description.
-parseDescription' :: [Field] -> ParseResult PreparedPackageDescription
+parseDescription' :: [Field] -> ParseResult GenericPackageDescription
 parseDescription' fields0 = do
     let sf = sectionizeFields fields0
     fields <- mapSimpleFields deprecField sf
@@ -870,7 +870,7 @@ parseDescription' fields0 = do
       pkg <- lift $ parseFields pkgDescrFieldDescrs emptyPackageDescription hfs
       (flags, mlib, exes) <- getBody
       warnIfRest
-      return (PreparedPackageDescription pkg flags mlib exes)
+      return (GenericPackageDescription pkg flags mlib exes)
 
   where
     -- "Sectionize" an old-style Cabal file.  A sectionized file has:
diff --git a/Distribution/Simple.hs b/Distribution/Simple.hs
index 12ffbcde3e85bbc52e3f0bfec86ccb0eaeb6dd45..bdf66c6638a721c85575c21f8420da81e325cb0c 100644
--- a/Distribution/Simple.hs
+++ b/Distribution/Simple.hs
@@ -143,7 +143,7 @@ data UserHooks = UserHooks
       -- |Hook to run before configure command
      preConf  :: Args -> ConfigFlags -> IO HookedBuildInfo,
      -- |Over-ride this hook to get different behavior during configure.
-     confHook :: ( Either PreparedPackageDescription PackageDescription
+     confHook :: ( Either GenericPackageDescription PackageDescription
                  , HookedBuildInfo)
               -> ConfigFlags -> IO (LocalBuildInfo, PackageDescription),
       -- |Hook to run after configure command
@@ -329,7 +329,7 @@ defaultMainWorker mdescr action all_args hooks prog_conf
                 
                 postConf hooks args flags' pkg_descr localbuildinfo
               where
-                confPkgDescr :: ConfigFlags -> IO (Either PreparedPackageDescription
+                confPkgDescr :: ConfigFlags -> IO (Either GenericPackageDescription
                                                           PackageDescription)
                 confPkgDescr cfgflags = do
                   mdescr' <- readDesc hooks
diff --git a/Distribution/Simple/Configure.hs b/Distribution/Simple/Configure.hs
index c6a590566b3cbdb7a2e45086c992d597dfdc5db5..3e11d8cbccf23a6108e6c2e1993dc83b65b79a6c 100644
--- a/Distribution/Simple/Configure.hs
+++ b/Distribution/Simple/Configure.hs
@@ -78,7 +78,7 @@ import Distribution.Package (PackageIdentifier(..), showPackageId,
 			     parsePackageId)
 import Distribution.PackageDescription(
  	PackageDescription(..), Library(..),
-        PreparedPackageDescription(..),
+        GenericPackageDescription(..),
         finalizePackageDescription,
         HookedBuildInfo, sanityCheckPackage, updatePackageDescription,
 	BuildInfo(..), Executable(..), setupMessage,
@@ -177,7 +177,7 @@ getConfiguredPkgDescr = tryGetConfiguredPkgDescr >>= either die return
 
 -- |Perform the \"@.\/setup configure@\" action.
 -- Returns the @.setup-config@ file.
-configure :: ( Either PreparedPackageDescription PackageDescription
+configure :: ( Either GenericPackageDescription PackageDescription
              , HookedBuildInfo) 
           -> ConfigFlags -> IO (LocalBuildInfo, PackageDescription)
 configure (pkg_descr0, pbi) cfg