diff --git a/Distribution/PackageDescription.hs b/Distribution/PackageDescription.hs
index 382151b1c40b11cef8ad1ea0c4220adf26aad1f4..bd09b46ecb6df9f8fd3d06eee8e6656b95859a32 100644
--- a/Distribution/PackageDescription.hs
+++ b/Distribution/PackageDescription.hs
@@ -69,7 +69,7 @@ import Control.Monad(foldM, when)
 import Data.Char
 import Data.List(concatMap)
 import Data.Maybe(fromMaybe, fromJust)
-import Text.PrettyPrint.HughesPJ
+import Text.PrettyPrint.HughesPJ(text, render, ($$), empty, space, vcat, fsep)
 import System.Directory(doesFileExist)
 
 import Distribution.ParseUtils
@@ -429,7 +429,7 @@ binfoFields =
                            exposedModules     (\xs    binfo -> binfo{exposedModules=xs})
  , listField   "executable-modules"
                            text               parseModuleNameQ
-                           exposedModules     (\xs    binfo -> binfo{executableModules=xs})
+                           executableModules  (\xs    binfo -> binfo{executableModules=xs})
  , listField   "c-sources"
                            showFilePath       parseFilePathQ
                            cSources           (\paths binfo -> binfo{cSources=paths})
@@ -447,7 +447,7 @@ binfoFields =
                            includes           (\paths binfo -> binfo{includes=paths})
  , listField   "include-dirs"
                            showFilePath       parseFilePathQ
-                           includes           (\paths binfo -> binfo{includeDirs=paths})
+                           includeDirs        (\paths binfo -> binfo{includeDirs=paths})
  , simpleField "hs-source-dir"
                            showFilePath       parseFilePathQ
                            hsSourceDir        (\path  binfo -> binfo{hsSourceDir=path})
diff --git a/Distribution/ParseUtils.hs b/Distribution/ParseUtils.hs
index 315d9b28840001cddd2bb121a0e939bb2ae53e1e..0cda93328e90f00d0255cadc63018e10223eaede 100644
--- a/Distribution/ParseUtils.hs
+++ b/Distribution/ParseUtils.hs
@@ -271,9 +271,12 @@ parseQuoted p = between (ReadP.char '"') (ReadP.char '"') p
 
 showFilePath :: FilePath -> Doc
 showFilePath fpath
-	| all (\x -> isAlphaNum x || x `elem` "-+/_.") fpath = text fpath
-	| otherwise = doubleQuotes (text fpath)
-
+	| all (\x -> isAlphaNum x || x `elem` "-+/_.") fpath = text (replaceSlash fpath)
+	| otherwise = doubleQuotes (text (replaceSlash fpath))
+        where
+        replaceSlash s = case break (== '\\') s of
+                         (a, (h:t)) -> a ++ (h:h:(replaceSlash t))
+                         (a, []) -> a
 
 showTestedWith :: (CompilerFlavor,VersionRange) -> Doc
 showTestedWith (compiler,version) = text (show compiler ++ " " ++ showVersionRange version)
diff --git a/TODO b/TODO
index c630d52f9d221466661f627545884a99d538fa5b..b16fd1a5fd329612f0b4a73ba0c3b125307184b1 100644
--- a/TODO
+++ b/TODO
@@ -1,7 +1,4 @@
 * misc
-** if you're passing arguments to hooks, you shouldn't call
-   no_extra_flags, should you?  Perhaps it should be in the empty hooks.
-
 ** two executables in same directory fails because both create Main.o
 ** Executables that depend on the package itself
 ** make debian watchfile