diff --git a/ghc/lib/std/PrelHandle.lhs b/ghc/lib/std/PrelHandle.lhs
index 4fa4a7d45bd453007ed0de533ee1a7ecab954888..6d7a6c96282a001ba3c3a44facf50f6afb14be68 100644
--- a/ghc/lib/std/PrelHandle.lhs
+++ b/ghc/lib/std/PrelHandle.lhs
@@ -35,15 +35,13 @@ import PrelConc				-- concurrent only
 
 %*********************************************************
 %*							*
-\subsection{Types @FilePath@, @Handle@, @Handle__@}
+\subsection{Types @Handle@, @Handle__@}
 %*							*
 %*********************************************************
 
 The @Handle@ and @Handle__@ types are defined in @IOBase@.
 
 \begin{code}
-type FilePath = String
-
 {-# INLINE newHandle   #-}
 {-# INLINE readHandle  #-}
 {-# INLINE writeHandle #-}
diff --git a/ghc/lib/std/PrelIOBase.lhs b/ghc/lib/std/PrelIOBase.lhs
index fe137694d83cd406c8d0bc7eeaabfac9f4ab437f..56b7d337ba7de31b9db838a003afba792d949632 100644
--- a/ghc/lib/std/PrelIOBase.lhs
+++ b/ghc/lib/std/PrelIOBase.lhs
@@ -291,6 +291,13 @@ constructErrorMsg call_site reason =
  return (IOError Nothing iot call_site msg)
 \end{code}
 
+File names are specified using @FilePath@, a OS-dependent
+string that (hopefully, I guess) maps to an accessible file/object.
+
+\begin{code}
+type FilePath = String
+\end{code}
+
 %*********************************************************
 %*							*
 \subsection{Types @Handle@, @Handle__@}
@@ -367,7 +374,7 @@ data Handle__
       haFO__	      :: FILE_OBJECT,
       haType__        :: Handle__Type,
       haBufferMode__  :: BufferMode,
-      haFilePath__    :: String
+      haFilePath__    :: FilePath
     }      
 
 {-