Cleanup

9 files changed, 74 insertions, 1183 deletions

diff --git a/haddock.cabal b/haddock.cabal
index 469b3f31..62780a89 100644
--- a/haddock.cabal
+++ b/haddock.cabal
@@ -58,10 +58,8 @@ hs-source-dirs: src
 main-is: Main.hs
 extensions: CPP
 other-modules:
-	Binary2
-	BlockTable
-	Digraph2
 	FastMutInt2
+	BlockTable
 	HaddockDB
 	HaddockDevHelp
 	HaddockHH
@@ -73,10 +71,5 @@ other-modules:
 	HaddockTypes
 	HaddockUtil
 	HaddockVersion
-	HsLexer
-	HsParseMonad
-	HsSyn2
 	Html
 	Main
-	Map
-	Set
diff --git a/src/HaddockDevHelp.hs b/src/HaddockDevHelp.hs
index 511cfe90..adfee1e2 100644
--- a/src/HaddockDevHelp.hs
+++ b/src/HaddockDevHelp.hs
@@ -3,17 +3,14 @@ module HaddockDevHelp(ppDevHelpFile) where
 import HaddockModuleTree
 import HaddockTypes
 import HaddockUtil
-import HsSyn2 hiding (Doc, Module)
-import qualified Map
 
 import Module ( moduleString, Module )
 import Name   ( Name, nameModule, getOccString )
 
-
 import Data.Maybe ( fromMaybe )
+import qualified Data.Map as Map
 import Text.PrettyPrint
 
-
 ppDevHelpFile :: FilePath -> String -> Maybe String -> [HaddockModule] -> IO ()
 ppDevHelpFile odir doctitle maybe_package modules = do
   let devHelpFile = package++".devhelp"
diff --git a/src/HaddockHtml.hs b/src/HaddockHtml.hs
index 6fc9d21a..0bd69b93 100644
--- a/src/HaddockHtml.hs
+++ b/src/HaddockHtml.hs
@@ -22,8 +22,8 @@ import HaddockUtil
 import HaddockVersion
 import Html
 import qualified Html
-import Map ( Map )
-import qualified Map hiding ( Map )
+import Data.Map ( Map )
+import qualified Data.Map as Map hiding ( Map )
 
 import Control.Exception ( bracket )
 import Control.Monad ( when, unless )
@@ -720,8 +720,6 @@ ppFor summary links loc mbDoc (ForeignImport lname ltype _ _)
   = ppSig summary links loc mbDoc (TypeSig lname ltype)
 ppFor _ _ _ _ _ = error "ppFor"
 
-ppDataDecl = undefined
-
 ppTySyn summary links loc mbDoc (TySynonym lname ltyvars ltype) 
   = declWithDoc summary links loc n mbDoc (
     hsep ([keyword "type", ppHsBinder summary n]
@@ -834,6 +832,8 @@ ppInstHead (ctxt, n, ts) = ppPreds ctxt <+> ppAsst n ts
 
 ppAsst n ts = ppDocName n <+> hsep (map ppType ts)
 
+ppDataDecl = undefined
+
 {-
 -- -----------------------------------------------------------------------------
 -- Converting declarations to HTML
@@ -901,9 +901,8 @@ ppShortDataDecl _ _ _ d =
     error $ "HaddockHtml.ppShortDataDecl: unexpected decl " ++ show d
 
 -- The rest of the cases:
-ppHsDataDecl :: Ord key => Bool	-> LinksInfo -> [InstHead] -> Bool -> key -> HsDecl -> HtmlTable
-ppHsDataDecl summary links instances is_newty 
-     x decl@(HsDataDecl loc _ nm args cons _ doc)
+ppDataDecl :: Ord key => Bool -> LinksInfo -> [InstHead2 DocName] -> key -> TyClDecl DocName -> HtmlTable
+ppDataDecl summary links instances x decl@(DataDecl loc _ nm args cons _ doc)
   | summary = declWithDoc summary links loc nm doc (ppShortDataDecl summary links is_newty decl)
 
   | otherwise
@@ -1159,16 +1158,6 @@ ppHsBinder False nm = linkTarget nm +++ bold << ppHsBinder' nm
 ppHsBinder' :: Name -> Html
 ppHsBinder' name = toHtml (getOccString name)
 
-{-
-ppHsBinder' :: HsName -> Html
-ppHsBinder' (HsTyClsName id0) = ppHsBindIdent id0
-ppHsBinder' (HsVarName id0)   = ppHsBindIdent id0
-
-ppHsBindIdent :: HsIdentifier -> Html
-ppHsBindIdent (HsIdent str)   =  toHtml str
-ppHsBindIdent (HsSymbol str)  =  parens (toHtml str)
-ppHsBindIdent (HsSpecial str) =  toHtml str
--}
 linkId :: GHC.Module -> Maybe Name -> Html -> Html
 linkId mod mbName = anchor ! [href hr]
   where 
@@ -1211,9 +1200,6 @@ htmlRdrMarkup = parHtmlMarkup ppRdrName
 
 -- If the doc is a single paragraph, don't surround it with <P> (this causes
 -- ugly extra whitespace with some browsers).
-{-docToHtml :: Doc -> Html
-docToHtml doc = markup htmlMarkup (unParagraph (markup htmlCleanup doc))
--}
 docToHtml :: GHC.HsDoc DocName -> Html
 docToHtml doc = markup htmlMarkup (unParagraph (markup htmlCleanup doc))
 
diff --git a/src/HaddockUtil.hs b/src/HaddockUtil.hs
index b4121752..8a0edc11 100644
--- a/src/HaddockUtil.hs
+++ b/src/HaddockUtil.hs
@@ -8,9 +8,8 @@
 module HaddockUtil (
 
   -- * Misc utilities
-  nameOfQName, collectNames, declBinders, declMainBinder, declSubBinders, 
-  splitTyConApp, restrictTo, declDoc, freeTyCons, unbang,
-  addFieldDoc, addFieldDocs, addConDoc, addConDocs,toDescription, unQual,
+  restrictTo, 
+  toDescription,
 
   -- * Filename utilities
   basename, dirname, splitFilename3, 
@@ -30,13 +29,11 @@ module HaddockUtil (
   idMarkup,
  ) where
 
-import Binary2
 import HaddockTypes
-import HsSyn2 hiding ( DocMarkup(..), markup, idMarkup )
-import Map ( Map )
-import qualified Map hiding ( Map )
+import Data.Map ( Map )
+import qualified Data.Map as Map hiding ( Map )
 
-import qualified GHC as GHC
+import GHC
 import SrcLoc
 import Name
 import OccName
@@ -55,186 +52,49 @@ import System.IO.Unsafe	 ( unsafePerformIO )
 -- -----------------------------------------------------------------------------
 -- Some Utilities
 
-nameOfQName :: HsQName -> HsName
-nameOfQName (Qual _ n) = n
-nameOfQName (UnQual n) = n
-
-unQual :: HsQName -> HsQName
-unQual (Qual _ n) = UnQual n
-unQual n = n
-
-collectNames :: [HsDecl] -> [HsName]
-collectNames ds = concat (map declBinders ds)
-
-unbang :: HsBangType -> HsType
-unbang (HsUnBangedTy ty) = ty
-unbang (HsBangedTy   ty) = ty
-
-declBinders :: HsDecl -> [HsName]
-declBinders d = maybeToList (declMainBinder d) ++ declSubBinders d
-
-declMainBinder :: HsDecl -> Maybe HsName
-declMainBinder d = 
-   case d of
-     HsTypeDecl _ n _ _ _          -> Just n
-     HsDataDecl _ _ n _ _ _ _      -> Just n
-     HsNewTypeDecl _ _ n _ _ _  _  -> Just n
-     HsClassDecl _ _ n _ _ _ _     -> Just n
-     HsTypeSig _ [n] _ _           -> Just n
-     HsTypeSig _ _ _ _             -> error "declMainBinder"
-     HsForeignImport _ _ _ _ n _ _ -> Just n
-     _                             -> Nothing
-
-declSubBinders :: HsDecl -> [HsName]
-declSubBinders d =
-   case d of
-     HsTypeDecl _ _ _ _ _          -> []
-     HsDataDecl _ _ _ _ cons _ _   -> concat (map conDeclBinders cons)
-     HsNewTypeDecl _ _ _ _ con _ _ -> conDeclBinders con
-     HsClassDecl _ _ _ _ _ decls _ -> collectNames decls
-     HsTypeSig _ _ _ _             -> []
-     HsForeignImport _ _ _ _ _ _ _ -> []
-     _                             -> []
-
-conDeclBinders :: HsConDecl -> [HsName]
-conDeclBinders (HsConDecl _ n _ _ _ _) = [n]
-conDeclBinders (HsRecDecl _ n _ _ fields _) = 
-  n : concat (map fieldDeclBinders fields)
-
-fieldDeclBinders :: HsFieldDecl -> [HsName]
-fieldDeclBinders (HsFieldDecl ns _ _) = ns
-
-splitTyConApp :: HsType -> (HsQName, [HsType])
-splitTyConApp t0 = split t0 []
- where
-	split :: HsType -> [HsType] -> (HsQName,[HsType])
-	split (HsTyApp t u) ts = split t (u:ts)
-	split (HsTyCon t)   ts = (t,ts)
-	split _ _ = error "splitTyConApp"
-
-freeTyCons :: HsType -> [HsQName]
-freeTyCons ty = go ty []
-  where go (HsForAllType _ _ t) r = go t r
-	go (HsTyApp t u) r = go t (go u r)
-	go (HsTyCon c) r = c : r
-	go (HsTyFun f a) r = go f (go a r)
-	go (HsTyTuple _ ts) r = foldr go r ts
-	go (HsTyVar _) r = r
-	go (HsTyDoc t _) r = go t r
-
 -- | extract a module's short description.
-toDescription :: HaddockModule -> Maybe (GHC.HsDoc GHC.Name)
-toDescription = GHC.hmi_description . hmod_info
-
--- -----------------------------------------------------------------------------
--- Adding documentation to record fields (used in parsing).
-
-addFieldDoc :: HsFieldDecl -> Maybe Doc -> HsFieldDecl
-addFieldDoc (HsFieldDecl ns ty doc1) doc2 = 
-   HsFieldDecl ns ty (doc1 `mplus` doc2)
-
-addFieldDocs :: [HsFieldDecl] -> Maybe Doc -> [HsFieldDecl]
-addFieldDocs [] _ = []
-addFieldDocs (x:xs) doc = addFieldDoc x doc : xs
-
-addConDoc :: HsConDecl -> Maybe Doc -> HsConDecl
-addConDoc (HsConDecl pos nm tvs ctxt typeList doc1) doc2 = 
-   HsConDecl pos nm tvs ctxt typeList (doc1 `mplus` doc2)
-addConDoc (HsRecDecl pos nm tvs ctxt fields doc1) doc2=
-   HsRecDecl pos nm tvs ctxt fields (doc1 `mplus` doc2)
-
-addConDocs :: [HsConDecl] -> Maybe Doc -> [HsConDecl]
-addConDocs [] _ = []
-addConDocs (x:xs) doc = addConDoc x doc : xs
+toDescription :: HaddockModule -> Maybe (HsDoc Name)
+toDescription = hmi_description . hmod_info
 
 -- ---------------------------------------------------------------------------
 -- Making abstract declarations
 
-restrictTo :: [GHC.Name] -> (GHC.LHsDecl GHC.Name) -> (GHC.LHsDecl GHC.Name)
+restrictTo :: [Name] -> (LHsDecl Name) -> (LHsDecl Name)
 restrictTo names (L loc decl) = L loc $ case decl of
-  GHC.TyClD d | GHC.isDataDecl d && GHC.tcdND d == GHC.DataType -> 
-    GHC.TyClD (d { GHC.tcdCons = restrictCons names (GHC.tcdCons d) }) 
-  GHC.TyClD d | GHC.isDataDecl d && GHC.tcdND d == GHC.NewType -> 
-    case restrictCons names (GHC.tcdCons d) of
-      []    -> GHC.TyClD (d { GHC.tcdND = GHC.DataType, GHC.tcdCons = [] }) 
-      [con] -> GHC.TyClD (d { GHC.tcdCons = [con] })
-  GHC.TyClD d | GHC.isClassDecl d -> 
-    GHC.TyClD (d { GHC.tcdSigs = restrictDecls names (GHC.tcdSigs d) })
+  TyClD d | isDataDecl d && tcdND d == DataType -> 
+    TyClD (d { tcdCons = restrictCons names (tcdCons d) }) 
+  TyClD d | isDataDecl d && tcdND d == NewType -> 
+    case restrictCons names (tcdCons d) of
+      []    -> TyClD (d { tcdND = DataType, tcdCons = [] }) 
+      [con] -> TyClD (d { tcdCons = [con] })
+  TyClD d | isClassDecl d -> 
+    TyClD (d { tcdSigs = restrictDecls names (tcdSigs d) })
   _ -> decl
    
-restrictCons :: [GHC.Name] -> [GHC.LConDecl GHC.Name] -> [GHC.LConDecl GHC.Name]
+restrictCons :: [Name] -> [LConDecl Name] -> [LConDecl Name]
 restrictCons names decls = [ L p (fromJust (keep d)) | L p d <- decls, isJust (keep d) ]  
-  where keep d | unLoc (GHC.con_name d) `elem` names = 
-          case GHC.con_details d of
-            GHC.PrefixCon _ -> Just d
-            GHC.RecCon fields  
+  where keep d | unLoc (con_name d) `elem` names = 
+          case con_details d of
+            PrefixCon _ -> Just d
+            RecCon fields  
               | all field_avail fields -> Just d
-              | otherwise -> Just (d { GHC.con_details = GHC.PrefixCon (field_types fields) })
+              | otherwise -> Just (d { con_details = PrefixCon (field_types fields) })
        		-- if we have *all* the field names available, then
 		-- keep the record declaration.  Otherwise degrade to
 		-- a constructor declaration.  This isn't quite right, but
 		-- it's the best we can do.
 	   where
-            field_avail (GHC.HsRecField n _ _) = (unLoc n) `elem` names
-            field_types flds = [ ty | GHC.HsRecField n ty _ <- flds] 
+            field_avail (HsRecField n _ _) = (unLoc n) `elem` names
+            field_types flds = [ ty | HsRecField n ty _ <- flds] 
         keep d | otherwise = Nothing
 
-restrictDecls :: [GHC.Name] -> [GHC.LSig GHC.Name] -> [GHC.LSig GHC.Name]
+restrictDecls :: [Name] -> [LSig Name] -> [LSig Name]
 restrictDecls names decls = filter keep decls
-  where keep d = fromJust (GHC.sigName d) `elem` names
+  where keep d = fromJust (sigName d) `elem` names
         -- has to have a name, since it's a class method type signature
 
-{-
-restrictTo :: [HsName] -> HsDecl -> HsDecl
-restrictTo names decl = case decl of
-     HsDataDecl loc ctxt n xs cons drv doc -> 
-	HsDataDecl loc ctxt n xs (restrictCons names cons) drv doc
-     decl@(HsNewTypeDecl loc ctxt n xs con drv doc) ->
-	case restrictCons names [con] of
-	   []     -> HsDataDecl loc ctxt n xs [] drv doc
-	   [con'] -> HsNewTypeDecl loc ctxt n xs con' drv doc
-		-- an abstract newtype decl appears as a data decl.
-     HsClassDecl loc ctxt n tys fds decls doc ->
-	HsClassDecl loc ctxt n tys fds (restrictDecls names decls) doc
-     _ -> decl
-   
-restrictCons :: [HsName] -> [HsConDecl] -> [HsConDecl]
-restrictCons names decls = [ d | Just d <- map keep decls ]
-  where keep d@(HsConDecl _ n _ _ _ _)
-	  | n `elem` names  = Just d
-	keep d@(HsRecDecl loc n tvs ctx fields doc) 
-	  | n `elem` names
-	  = if all field_avail fields
-		then Just d
-		else Just (HsConDecl loc n tvs ctx confields doc)
-		-- if we have *all* the field names available, then
-		-- keep the record declaration.  Otherwise degrade to
-		-- a constructor declaration.  This isn't quite right, but
-		-- it's the best we can do.
-	   where
-		field_avail (HsFieldDecl ns _ _) = all (`elem` names) ns
-		confields = [ ty | HsFieldDecl ns ty doc <- fields, n <- ns ]
-	keep d = Nothing
-
-restrictDecls :: [HsName] -> [HsDecl] -> [HsDecl]
-restrictDecls names decls = filter keep decls
-  where keep d = not (null (declBinders d `intersect` names))
-	-- ToDo: not really correct
--}
 -- -----------------------------------------------------------------------------
--- Extract documentation from a declaration
-
-declDoc :: HsDecl -> Maybe Doc
-declDoc (HsTypeDecl _ _ _ _ d)          = d
-declDoc (HsDataDecl _ _ _ _ _ _ d)      = d
-declDoc (HsNewTypeDecl _ _ _ _ _ _ d)   = d
-declDoc (HsClassDecl _ _ _ _ _ _ d)     = d
-declDoc (HsTypeSig _ _ _ d)             = d
-declDoc (HsForeignImport _ _ _ _ _ _ d) = d
-declDoc _ = Nothing
-
--- -----------------------------------------------------------------------------
--- Filename mangling functions stolen from GHC's main/DriverUtil.lhs.
+-- Filename mangling functions stolen from s main/DriverUtil.lhs.
 
 type Suffix = String
 
@@ -280,13 +140,13 @@ isPathSeparator ch =
 
 moduleHtmlFile :: String -> FilePath
 moduleHtmlFile mdl =
-  case Map.lookup (GHC.mkModule mdl) html_xrefs of
+  case Map.lookup (mkModule mdl) html_xrefs of
     Nothing  -> mdl' ++ ".html"
     Just fp0 -> pathJoin [fp0, mdl' ++ ".html"]
   where
    mdl' = map (\c -> if c == '.' then '-' else c) mdl
 
-nameHtmlRef :: String -> GHC.Name -> String	
+nameHtmlRef :: String -> Name -> String	
 nameHtmlRef mdl str = moduleHtmlFile mdl ++ '#':escapeStr (anchorNameStr str)
 
 contentsHtmlFile, indexHtmlFile :: String
@@ -369,120 +229,56 @@ escapeStr = escapeURIString isUnreserved
 -- being I'm going to use a write-once global variable.
 
 {-# NOINLINE html_xrefs_ref #-}
-html_xrefs_ref :: IORef (Map GHC.Module FilePath)
+html_xrefs_ref :: IORef (Map Module FilePath)
 html_xrefs_ref = unsafePerformIO (newIORef (error "module_map"))
 
 {-# NOINLINE html_xrefs #-}
-html_xrefs :: Map GHC.Module FilePath
+html_xrefs :: Map Module FilePath
 html_xrefs = unsafePerformIO (readIORef html_xrefs_ref)
 
 -----------------------------------------------------------------------------
--- Binary instances for stuff
-
-instance Binary Module where
-  put_ bh (Module m) = putString bh m
-  get bh = do m <- getString bh; return $! (Module m)
-
-instance Binary HsQName where
-  put_ bh (Qual m s) = do putByte bh 0; put_ bh m; put_ bh s
-  put_ bh (UnQual s) = do putByte bh 1; put_ bh s
-  get bh = do b <- getByte bh
-	      case b of
-		0 -> do m <- get bh; s <- get bh; return (Qual m s)
-		_ -> do s <- get bh; return (UnQual s)
-
-instance Binary HsName where
-  put_ bh (HsTyClsName s) = do putByte bh 0; put_ bh s
-  put_ bh (HsVarName s)   = do putByte bh 1; put_ bh s
-  get bh = do b <- getByte bh
-	      case b of
-		0 -> do s <- get bh; return (HsTyClsName s)
-		_ -> do s <- get bh; return (HsVarName s)
-
-instance Binary HsIdentifier where
-  put_ bh (HsIdent s)   = do putByte bh 0; putString bh s
-  put_ bh (HsSymbol s)  = do putByte bh 1; putString bh s
-  put_ bh (HsSpecial s) = do putByte bh 2; putString bh s
-  get bh = do b <- getByte bh
-	      case b of
-		0 -> do s <- getString bh; return (HsIdent s)
-		1 -> do s <- getString bh; return (HsSymbol s)
-		_ -> do s <- getString bh; return (HsSpecial s)
-
-instance Binary id => Binary (GenDoc id) where
-   put_ bh DocEmpty = putByte bh 0
-   put_ bh (DocAppend gd1 gd2) = do putByte bh 1;put_ bh gd1;put_ bh gd2
-   put_ bh (DocString s) = do putByte bh 2;putString bh s
-   put_ bh (DocParagraph gd) = do putByte bh 3;put_ bh gd
-   put_ bh (DocIdentifier id) = do putByte bh 4;put_ bh id
-   put_ bh (DocModule s) = do putByte bh 5;putString bh s
-   put_ bh (DocEmphasis gd) = do putByte bh 6;put_ bh gd
-   put_ bh (DocMonospaced gd) = do putByte bh 7;put_ bh gd
-   put_ bh (DocUnorderedList gd) = do putByte bh 8;put_ bh gd
-   put_ bh (DocOrderedList gd) = do putByte bh 9;put_ bh gd
-   put_ bh (DocDefList gd) = do putByte bh 10;put_ bh gd
-   put_ bh (DocCodeBlock gd) = do putByte bh 11;put_ bh gd
-   put_ bh (DocURL s) = do putByte bh 12;putString bh s
-   put_ bh (DocAName s) = do putByte bh 13;putString bh s
-   get bh = do b <- getByte bh
-               case b of
-                  0 -> return DocEmpty
-                  1 -> do gd1 <- get bh;gd2 <- get bh;return (DocAppend gd1 gd2)
-                  2 -> do s <- getString bh;return (DocString s)
-                  3 -> do gd <- get bh;return (DocParagraph gd)
-                  4 -> do id <- get bh;return (DocIdentifier id)
-                  5 -> do s <- getString bh;return (DocModule s)
-                  6 -> do gd <- get bh;return (DocEmphasis gd)
-                  7 -> do gd <- get bh;return (DocMonospaced gd)
-                  8 -> do gd <- get bh;return (DocUnorderedList gd)
-                  9 -> do gd <- get bh;return (DocOrderedList gd)
-                  10 -> do gd <- get bh;return (DocDefList gd)
-                  11 -> do gd <- get bh;return (DocCodeBlock gd)
-                  12 -> do s <- getString bh;return (DocURL s)
-                  13 -> do s <- getString bh;return (DocAName s) 
-                  _ -> error ("Mysterious byte in document in interface" 
-                     ++ show b)
-
-markup :: DocMarkup id a -> GHC.HsDoc id -> a
-markup m GHC.DocEmpty		   = markupEmpty m
-markup m (GHC.DocAppend d1 d2)	   = markupAppend m (markup m d1) (markup m d2)
-markup m (GHC.DocString s)         = markupString m s
-markup m (GHC.DocParagraph d)	   = markupParagraph m (markup m d)
-markup m (GHC.DocIdentifier ids)   = markupIdentifier m ids
-markup m (GHC.DocModule mod0)	   = markupModule m mod0
-markup m (GHC.DocEmphasis d)	   = markupEmphasis m (markup m d)
-markup m (GHC.DocMonospaced d)	   = markupMonospaced m (markup m d)
-markup m (GHC.DocUnorderedList ds) = markupUnorderedList m (map (markup m) ds)
-markup m (GHC.DocOrderedList ds)   = markupOrderedList m (map (markup m) ds)
-markup m (GHC.DocDefList ds)       = markupDefList m (map (markupPair m) ds)
-markup m (GHC.DocCodeBlock d)	   = markupCodeBlock m (markup m d)
-markup m (GHC.DocURL url)          = markupURL m url
-markup m (GHC.DocAName ref)	   = markupAName m ref
-
-markupPair :: DocMarkup id a -> (GHC.HsDoc id, GHC.HsDoc id) -> (a, a)
+-- put here temporarily
+
+markup :: DocMarkup id a -> HsDoc id -> a
+markup m DocEmpty              = markupEmpty m
+markup m (DocAppend d1 d2)     = markupAppend m (markup m d1) (markup m d2)
+markup m (DocString s)         = markupString m s
+markup m (DocParagraph d)      = markupParagraph m (markup m d)
+markup m (DocIdentifier ids)   = markupIdentifier m ids
+markup m (DocModule mod0)      = markupModule m mod0
+markup m (DocEmphasis d)       = markupEmphasis m (markup m d)
+markup m (DocMonospaced d)     = markupMonospaced m (markup m d)
+markup m (DocUnorderedList ds) = markupUnorderedList m (map (markup m) ds)
+markup m (DocOrderedList ds)   = markupOrderedList m (map (markup m) ds)
+markup m (DocDefList ds)       = markupDefList m (map (markupPair m) ds)
+markup m (DocCodeBlock d)      = markupCodeBlock m (markup m d)
+markup m (DocURL url)          = markupURL m url
+markup m (DocAName ref)        = markupAName m ref
+
+markupPair :: DocMarkup id a -> (HsDoc id, HsDoc id) -> (a, a)
 markupPair m (a,b) = (markup m a, markup m b)
 
 -- | The identity markup
-idMarkup :: DocMarkup a (GHC.HsDoc a)
+idMarkup :: DocMarkup a (HsDoc a)
 idMarkup = Markup {
-  markupEmpty         = GHC.DocEmpty,
-  markupString        = GHC.DocString,
-  markupParagraph     = GHC.DocParagraph,
-  markupAppend        = GHC.DocAppend,
-  markupIdentifier    = GHC.DocIdentifier,
-  markupModule        = GHC.DocModule,
-  markupEmphasis      = GHC.DocEmphasis,
-  markupMonospaced    = GHC.DocMonospaced,
-  markupUnorderedList = GHC.DocUnorderedList,
-  markupOrderedList   = GHC.DocOrderedList,
-  markupDefList       = GHC.DocDefList,
-  markupCodeBlock     = GHC.DocCodeBlock,
-  markupURL	      = GHC.DocURL,
-  markupAName	      = GHC.DocAName
+  markupEmpty         = DocEmpty,
+  markupString        = DocString,
+  markupParagraph     = DocParagraph,
+  markupAppend        = DocAppend,
+  markupIdentifier    = DocIdentifier,
+  markupModule        = DocModule,
+  markupEmphasis      = DocEmphasis,
+  markupMonospaced    = DocMonospaced,
+  markupUnorderedList = DocUnorderedList,
+  markupOrderedList   = DocOrderedList,
+  markupDefList       = DocDefList,
+  markupCodeBlock     = DocCodeBlock,
+  markupURL	      = DocURL,
+  markupAName	      = DocAName
   }
 
 -- | Since marking up is just a matter of mapping 'Doc' into some
 -- other type, we can \'rename\' documentation by marking up 'Doc' into
 -- the same thing, modifying only the identifiers embedded in it.
-mapIdent :: ([a] -> GHC.HsDoc b) -> DocMarkup a (GHC.HsDoc b)
+
 mapIdent f = idMarkup { markupIdentifier = f }
diff --git a/src/HsLexer.lhs b/src/HsLexer.lhs
deleted file mode 100644
index 93baa6aa..00000000
--- a/src/HsLexer.lhs
+++ /dev/null
@@ -1,713 +0,0 @@
------------------------------------------------------------------------------
--- $Id: HsLexer.lhs,v 1.18 2005/03/09 08:28:39 wolfgang Exp $
---
--- (c) The GHC Team, 1997-2000
---
--- Lexer for Haskell.
---
------------------------------------------------------------------------------
-
-ToDo: Parsing floats is a *real* hack...
-ToDo: Introduce different tokens for decimal, octal and hexadecimal (?)
-ToDo: FloatTok should have three parts (integer part, fraction, exponent)
-ToDo: Use a lexical analyser generator (lx?)
-
-\begin{code}
-module HsLexer (Token(..), lexer, parseError,isSymbol) where
-
-import HsParseMonad
-import HsParseUtils
-import HsSyn2
-
-import Numeric	( readHex, readOct )
-import Char
-import List     ( isPrefixOf )
-\end{code}
-
-\begin{code}
-data Token 
-        = VarId String
-	| IPVarId String
-        | QVarId (String,String)
-	| ConId String
-        | QConId (String,String)
-        | VarSym String
-        | ConSym String
-        | QVarSym (String,String)
-        | QConSym (String,String)
-
--- Literals
-
-	| IntTok     Integer
-        | FloatTok   String
-	| Character  Char
-        | StringTok  String
-	| PrimChar   Char		-- GHC extension
-	| PrimInt    Integer		-- GHC extension
-        | PrimString String		-- GHC extension
-	| PrimFloat  String		-- GHC extension
-	| PrimDouble String		-- GHC extension
-
--- Symbols
-
-	| LeftParen
-	| RightParen
-	| SemiColon
-        | LeftCurly
-        | RightCurly
-        | VRightCurly			-- a virtual close brace
-        | LeftSquare
-        | RightSquare
-	| Comma
-        | Underscore
-        | BackQuote
-	| LeftUT			-- GHC Extension: (#
-	| RightUT			-- GHC Extension: #)
-	
--- Documentation annotations
-
-	| DocCommentNext  String	-- something beginning '-- |'
-	| DocCommentPrev  String	-- something beginning '-- ^'
-	| DocCommentNamed String	-- something beginning '-- $'
-	| DocSection      Int String	-- a section heading
-	| DocOptions      String	-- attributes '-- #'
-
--- Reserved operators
-
-	| Dot				-- GHC extension
-	| DotDot
-	| DoubleColon
-	| Equals
-	| Backslash
-	| Bar
-	| LeftArrow
-	| RightArrow
-	| At
-	| Tilde
-	| DoubleArrow
-	| Minus
-	| Exclamation
-
--- Reserved Ids
-
-	| KW_As
-	| KW_Case
-	| KW_CCall
-	| KW_Class
-	| KW_Data
-	| KW_Default
-	| KW_Deriving
-	| KW_Do
-	| KW_DotNet
-	| KW_Else
-	| KW_Export
-	| KW_Forall
-	| KW_Foreign
-        | KW_Hiding
-	| KW_If
-	| KW_Import
-	| KW_In
-	| KW_Infix
-	| KW_InfixL
-	| KW_InfixR
-	| KW_Instance
-	| KW_Let
-	| KW_Module
-	| KW_NewType
-	| KW_Of
-	| KW_Safe
-	| KW_StdCall
-	| KW_Then
-	| KW_ThreadSafe
-	| KW_Type
-	| KW_Unsafe
-	| KW_Where    
-	| KW_Qualified
-
-        | EOF
-        deriving (Eq,Show)
-
-reserved_ops :: [(String,Token)]
-reserved_ops = [
- ( ".",  Dot ),				-- GHC extension
- ( "..", DotDot ),    
- ( "::", DoubleColon ),
- ( "=",  Equals ),    
- ( "\\", Backslash ), 
- ( "|",  Bar ),       
- ( "<-", LeftArrow ), 
- ( "->", RightArrow ),
- ( "@",  At ),        
- ( "~",  Tilde ),     
- ( "=>", DoubleArrow ),
- ( "-",  Minus ),			--ToDo: shouldn't be here
- ( "!",  Exclamation )		--ditto
- ]
-
-reserved_ids :: [(String,Token)]
-reserved_ids = [
- ( "_",         Underscore ),
- ( "case",      KW_Case ),     
- ( "ccall",     KW_CCall ),
- ( "class",     KW_Class ),    
- ( "data",      KW_Data ),     
- ( "default",   KW_Default ),  
- ( "deriving",  KW_Deriving ), 
- ( "do",        KW_Do ),       
- ( "dotnet",    KW_DotNet ),       
- ( "else",      KW_Else ),     
- ( "export",    KW_Export ),     
- ( "forall",    KW_Forall ),     
- ( "foreign",   KW_Foreign ),     
- ( "if",    	KW_If ),       
- ( "import",    KW_Import ),   
- ( "in", 	KW_In ),       
- ( "infix", 	KW_Infix ),    
- ( "infixl", 	KW_InfixL ),   
- ( "infixr", 	KW_InfixR ),   
- ( "instance",  KW_Instance ), 
- ( "let", 	KW_Let ),      
- ( "mdo",       KW_Do ),       -- pretend mdo is do, for now.
- ( "module", 	KW_Module ),   
- ( "newtype",   KW_NewType ),  
- ( "of", 	KW_Of ),       
- ( "safe", 	KW_Safe ),     
- ( "then", 	KW_Then ),     
- ( "threadsafe",KW_ThreadSafe ),     
- ( "type", 	KW_Type ),     
- ( "unsafe", 	KW_Unsafe ),
- ( "where", 	KW_Where ),    
- ( "as", 	KW_As ),       
- ( "qualified", KW_Qualified ),
- ( "hiding", 	KW_Hiding ),
- ( "stdcall",   KW_StdCall )
- ]
-
-specialIds = [
-  KW_As,
-  KW_Unsafe,
-  KW_Safe,
-  KW_ThreadSafe,
-  KW_Qualified,
-  KW_Hiding,
-  KW_Export,
-  KW_StdCall,
-  KW_CCall,
-  KW_DotNet
-  ]
-
-isIdent, isSymbol, isWhite :: Char -> Bool
-isIdent  c = isAlpha c || isDigit c || c == '\'' || c == '_'
-isSymbol c = elem c ":!#$%&*+./<=>?@\\^|-~"
-isWhite  c = elem c " \n\r\t\v\f"
-
-isIdentInitial :: Char -> Bool
-isIdentInitial ch = isLower ch || ch == '_'
-
-tAB_LENGTH :: Int
-tAB_LENGTH = 8
-
--- The source location, (y,x), is the coordinates of the previous token.
--- col is the current column in the source file.  If col is 0, we are
--- somewhere at the beginning of the line before the first token.
-
--- Setting col to 0 is used in two places: just after emitting a virtual
--- close brace due to layout, so that next time through we check whether
--- we also need to emit a semi-colon, and at the beginning of the file,
--- to kick off the lexer.
-
-
-lexer :: (Token -> P a) -> P a
-lexer cont input (SrcLoc _ x0 _) y0 col f =
-        if col == 0
-           then tab y0 x0  f True  input
-           else tab y0 col f False input -- throw away old x
-  where
-   	-- move past whitespace and comments
-        tab y x f _ [] = 
-        	cont EOF [] (SrcLoc y x f) y col f
-        tab y x f bol ('\t':s) =
-        	tab y (nextTab x) f bol s
-        tab y _ f _  ('\n':s) =
-                newLine cont s y f
-
-        tab y _ f True ('#':s)
-            | "pragma GCC set_debug_pwd" `isPrefixOf` s
-            = newLine cont (tail $ dropWhile (/= '\n') s) y f
-
-	tab y x f True ('#':' ':s@(d:_))
-	    | isDigit d = parseLinePragma tab y f s
-
-	-- single-line comments
-        tab y x f bol s@('-':'-':' ':c:_) | doc c = 
-	 	is_a_token bol s y x f
-        tab y _ f _ ('-':'-':s) | null s || not (isSymbol (head (dropWhile (== '-') s)))  =
-        	newLine cont (drop 1 (dropWhile (/= '\n') s)) y f
-
-	-- multi-line nested comments and pragmas
-	tab y x f bol ('{':'-':'#':s) = pragma tab y (x+3) f bol s
-	tab y x f bol s@('{':'-':c:_) | doc c = 
-		is_a_token bol s y x f
-	tab y x f bol s@('{':'-':' ':c:_) | doc c = 
-		is_a_token bol s y x f
-        tab y x f bol ('{':'-':s) = nestedComment (\y x -> tab y x f) y (x+2) bol s
-
-        tab y x f bol (c:s)
-        	| isWhite c = tab y (x+1) f bol s
-        	| otherwise = is_a_token bol (c:s) y x f
-
- 	is_a_token bol s y x f
-	   | bol       = lexBOL   cont s (SrcLoc y x f) y x f
-	   | otherwise = lexToken cont s (SrcLoc y x f) y x f
-
-	newLine _ s y f =  tab (y+1) 1 f True s
-
-	doc '|' = True
-	doc '/' = True
-	doc '^' = True
-	doc '*' = True
-	doc '$' = True
-	doc '#' = True
-	doc _ = False
-
-nextTab :: Int -> Int
-nextTab x = x + (tAB_LENGTH - (x-1) `mod` tAB_LENGTH)
-
--- When we are lexing the first token of a line, check whether we need to
--- insert virtual semicolons or close braces due to layout.
-
-lexBOL :: (Token -> P a) -> P a
-lexBOL cont s loc y x f context =
-        if need_close_curly then 
-                -- trace "layout: inserting '}'\n" $
-        	-- Set col to 0, indicating that we're still at the
-        	-- beginning of the line, in case we need a semi-colon too.
-        	-- Also pop the context here, so that we don't insert
-        	-- another close brace before the parser can pop it.
-        	cont VRightCurly s loc y 0 f (tail context)
-        else if need_semi_colon then
-                --trace "layout: inserting ';'\n" $
-        	cont SemiColon s loc y x f context
-        else
-        	lexToken cont s loc y x f context
- where
-        need_close_curly =
-        	case context of
-        		[] -> False
-        		(i:_) -> case i of
-        			    NoLayout -> False
-        			    Layout n -> x < n
-        need_semi_colon =
-        	case context of
-        		[] -> False
-        		(i:_) -> case i of
-        			    NoLayout -> False
-        			    Layout n -> x == n
-
-lexToken :: (Token -> P a) -> P a
---lexToken _    [] loc _ _ =
---    error $ "Internal error: empty input in lexToken at " ++ show loc
-lexToken cont s0 loc y x f =
-   -- trace ("lexer: y="++show y++" x="++show x++"\n") $ 
-   case s0 of
-        []            -> error $ "Internal error: empty input in lexToken at "
-                                 ++ show loc
-	-- First the doc comments
-	'-':'-':' ':s -> do_doc s False
-	'{':'-':' ':s -> do_doc s True
-	'{':'-':s     -> do_doc s True
-
-        -- Next the special symbols
-        '(':'#':s -> forward 2 LeftUT s
-	'(':s 	  -> forward 1 LeftParen s
-	'#':')':s -> forward 2 RightUT s
-        ')':s     -> forward 1 RightParen s
-        ',':s     -> forward 1 Comma s
-        ';':s     -> forward 1 SemiColon s
-        '[':s     -> forward 1 LeftSquare s
-        ']':s     -> forward 1 RightSquare s
-        '`':s     -> forward 1 BackQuote s
-        '{':s     -> \ctxt  -> forward 1 LeftCurly s (NoLayout : ctxt)
-        '}':s     -> \ctxt0 -> case ctxt0 of
-                               (_:ctxt) -> forward 1 RightCurly s ctxt
-						-- pop context on '}'
-                               []       -> error "Internal error: empty context in lexToken"
-
-        '?':s:ss  
-	  | isIdentInitial s -> lexToken ( \ (VarId x) -> cont (IPVarId x)) (s:ss) loc y x f
-        '\'':s -> lexChar cont s loc y (x+1) f
-        '\"':s{-"-} -> lexString cont s loc y (x+1) f
-
-        '0':'x':c:s | isHexDigit c -> 
-	   let (num, rest) = span isHexDigit (c:s)
-	       [(i,_)] = readHex num
-	   in
-	   afterNum cont i rest loc y (x+length num) f
-        '0':'o':c:s | isOctDigit c -> 
-	   let (num, rest) = span isOctDigit (c:s)
-	       [(i,_)] = readOct num
-	   in
-	   afterNum cont i rest loc y (x+length num) f
-
-        c:s | isIdentInitial c ->
-        	let 
-        	    (idtail, rest) = slurpIdent s
-        	    id0 = c:idtail
-        	    l_id = 1 + length idtail
-        	in
-        	case lookup id0 reserved_ids of
-        		Just keyword -> forward l_id keyword rest
-        		Nothing      -> forward l_id (VarId id0) rest
-
-          | isUpper c -> lexCon "" cont (c:s) loc y x f
-          | isSymbol c ->
-        	let
-        	    (symtail, rest) = span isSymbol s
-        	    sym = c : symtail
-        	    l_sym = 1 + length symtail
-        	in
-        	case lookup sym reserved_ops of
-        	    Just t  -> forward l_sym t rest
-        	    Nothing -> case c of
-        			':' -> forward l_sym (ConSym sym) rest
-        			_   -> forward l_sym (VarSym sym) rest
-
-          | isDigit c -> lexNum cont c s loc y x f
-
-          | otherwise ->
-        	parseError ("illegal character \'" ++ show c ++ "\'\n") 
-        		  s loc y x f
-
-  where forward n t str = cont t str loc y (x+n) f
-
-	-- this is all terribly ugly, sorry :(
-	do_doc ('|':s) nested  = multi nested DocCommentNext  cont s loc y x f
-	do_doc ('/':s) nested  = multi nested DocCommentNext  cont s loc y x f
-	do_doc ('^':s) nested  = multi nested DocCommentPrev  cont s loc y x f
-	do_doc ('$':s) nested  = multi nested DocCommentNamed cont s loc y x f
-	do_doc ('#':s) nested  = multi nested DocOptions      cont s loc y x f
-	do_doc ('*':s) nested  = section 1 s
-	  where section n ('*':s1) = section (n+1) s1
-		section n s1 
-		 | nested    = nestedDocComment  (DocSection n) cont s1 loc y x f
-		 | otherwise = oneLineDocComment (DocSection n) cont s1 loc y x f
-	do_doc _       _ = error "Internal error: HsLexer.do_doc"
-        
-
-multi :: Bool -> ([Char] -> b)
-      -> (b -> [Char] -> c -> Int -> Int -> d)
-      -> [Char] -> c -> Int -> Int -> d
-multi True  = nestedDocComment
-multi False = multiLineDocComment
-
-afterNum :: Num a => (Token -> [Char] -> b -> c -> a -> d -> e)
-	 -> Integer -> [Char] -> b -> c -> a -> d -> e
-afterNum cont i ('#':s) loc y x f = cont (PrimInt i) s loc y (x+1) f
-afterNum cont i s loc y x f = cont (IntTok i) s loc y x f
-
-lexNum :: (Token -> [Char] -> a -> b -> Int -> c -> d)
-       -> Char -> [Char] -> a -> b -> Int -> c -> d
-lexNum cont c0 s0 loc y x fname = 
-  let (num, after_num) = span isDigit (c0:s0)
-  in
-  case after_num of
-    '.':c1:s1 | isDigit c1 ->
-	let (frac,after_frac) = span isDigit s1
-	in
-	let float = num ++ '.':frac
-	    (f, after_exp)
-		 = case after_frac of
-		    'E':s -> do_exponent s
-		    'e':s -> do_exponent s
-		    _     -> (float, after_frac)
-
-	    do_exponent s2 =
-		 case s2 of
-		  '-':c:s | isDigit c -> 
-			let (exp0,rest) = span isDigit (c:s) in
-			(float ++ 'e':'-':exp0, rest)
-		  '+':c:s | isDigit c -> 
-			let (exp0,rest) = span isDigit (c:s) in
-			(float ++ 'e':'+':exp0, rest)
-		  c:s | isDigit c -> 
-			let (exp0,rest) = span isDigit (c:s) in
-			(float ++ 'e':exp0, rest)
-		  _ -> (float, after_frac)
-
-	    x' = x + length f
-
-	in case after_exp of -- glasgow exts only
-		'#':'#':s -> cont (PrimDouble f) s loc y x' fname
-		'#':s     -> cont (PrimFloat f)  s loc y x' fname
-		s         -> cont (FloatTok f)   s loc y x' fname
-
-    _ -> afterNum cont (parseInteger 10 num) after_num loc y (x + length num) fname
-
-		
--- GHC extension: allow trailing '#'s in an identifier. 
-slurpIdent :: String -> (String, String)
-slurpIdent s = slurp' s []
- where
-  slurp' [] i = (reverse i, [])
-  slurp' (c:cs) i 
-    | isIdent c = slurp' cs (c:i)
-    | c == '#'  = slurphashes cs (c:i)
-  slurp' cs i = (reverse i, cs)
-
-slurphashes :: String -> String -> (String, String)
-slurphashes [] i = (reverse i, [])
-slurphashes ('#':cs) i = slurphashes cs ('#':i)
-slurphashes s i = (reverse i, s)
-
-lexCon :: [Char] -> (Token -> String -> a -> b -> Int -> c -> d)
-       -> String -> a -> b -> Int -> c -> d
-lexCon qual cont s0 loc y x f =
-  let
-    forward n t s = cont t s loc y (x+n) f
-
-    (con, rest) = slurpIdent s0
-    l_con = length con
-
-    just_a_conid 
-	| null qual = forward l_con (ConId con) rest
-	| otherwise = forward l_con (QConId (qual,con)) rest
-
-    qual' | null qual = con
-	  | otherwise = qual ++ '.':con
-  in
-  case rest of
-    '.':c1:s1 
-     | isIdentInitial c1 ->	-- qualified varid?
-	let
-	    (idtail, rest1) = slurpIdent s1
-	    id0 = c1:idtail
-	    l_id = 1 + length idtail
-	in
-	case lookup id0 reserved_ids of
-	   -- cannot qualify a reserved word
-	   Just id | id `notElem` specialIds  -> just_a_conid
-	   _ -> forward (l_con+1+l_id) (QVarId (qual', id0)) rest1
-
-     | isUpper c1 ->	-- qualified conid?
-	lexCon qual' cont (c1:s1) loc y (x+l_con+1) f
-
-     | isSymbol c1 ->	-- qualified symbol?
-	let
-	    (symtail, rest1) = span isSymbol s1
-	    sym = c1 : symtail
-	    l_sym = 1 + length symtail
-	in
-	case lookup sym reserved_ops of
-	    -- cannot qualify a reserved operator
-	    Just _  -> just_a_conid
-	    Nothing -> 
-		case c1 of
-		  ':' -> forward (l_con+1+l_sym) (QConSym (qual', sym)) rest1
-		  _   -> forward (l_con+1+l_sym) (QVarSym (qual', sym)) rest1
-
-    _ -> just_a_conid -- not a qualified thing
-
-
-lexChar :: (Token -> P a) -> P a
-lexChar cont s0 loc0 y x f = case s0 of
-                    '\\':s1 -> (escapeChar s1 `thenP` \(e,s,i) _ _ _ _ _ ->
-                               charEnd e s loc0 y (x+i) f) s1 loc0 y x f
-                    c:s     -> charEnd c s loc0 y (x+1) f
-                    []      -> char_err [] loc0 y x f
-
-  where charEnd c ('\'':'#':s) = \loc y0 x0 f0 -> cont (PrimChar c) s loc y0 (x0+2) f0
-	charEnd c ('\'':s) = \loc y0 x0 f0 -> cont (Character c) s loc y0 (x0+1) f0
-	charEnd c s = char_err s
-
-	char_err s = parseError "Improperly terminated character constant" s
-
-lexString :: (Token -> P a) -> P a
-lexString cont s0 loc y0 x0 f0 = loop "" s0 x0 y0 f0
-  where
-     loop e s1 x y f = case s1 of
-            '\\':'&':s  -> loop e s (x+2) y f
-            '\\':c:s | isSpace c -> stringGap e s (x+2) y f
-        	     | otherwise -> (escapeChar (c:s) `thenP` \(e',s2,i) _ _ _ _ ->
-        		             loop (e':e) s2 (x+i) y) s loc y x f
-            '\"':'#':s  -> cont (PrimString (reverse e)) s loc y (x+2) f
-            '\"':s{-"-} -> cont (StringTok (reverse e)) s loc y (x+1) f
-            c:s		-> loop (c:e) s (x+1) y f
-            []          -> parseError "Improperly terminated string" s1 loc y x f
-
-     stringGap e s1 x y = case s1 of
-        	'\n':s -> stringGap e s 1 (y+1)
-        	'\\':s -> loop e s (x+1) y
-        	c:s | isSpace c -> stringGap e s (x+1) y
-        	    | otherwise -> 
-        	       parseError "Illegal character in string gap" s1 loc y x
-                []     -> error "Internal error: stringGap"
-
--- ToDo: \o, \x, \<octal> things.
-
-escapeChar :: String -> P (Char,String,Int)
-escapeChar s0 = case s0 of
-
-  'x':c:s | isHexDigit c -> 
-	let (num,rest) = span isHexDigit (c:s) in
-	returnP (chr (fromIntegral (parseInteger 16 num)), rest, length num)
-
-  'o':c:s | isOctDigit c -> 
-	let (num,rest) = span isOctDigit (c:s) in
-	returnP (chr (fromIntegral (parseInteger 8 num)), rest, length num)
-
-  c:s | isDigit c -> let (num,rest) = span isDigit (c:s) in
-		     returnP (chr (read num), rest, length num)
-
--- Production charesc from section B.2 (Note: \& is handled by caller)
-
-  'a':s 	  -> returnP ('\a',s,2)
-  'b':s 	  -> returnP ('\b',s,2)
-  'f':s 	  -> returnP ('\f',s,2)
-  'n':s 	  -> returnP ('\n',s,2)
-  'r':s 	  -> returnP ('\r',s,2)
-  't':s 	  -> returnP ('\t',s,2)
-  'v':s 	  -> returnP ('\v',s,2)
-  '\\':s        -> returnP ('\\',s,2)
-  '"':s         -> returnP ('\"',s,2)
-  '\'':s        -> returnP ('\'',s,2)
-
--- Production ascii from section B.2
-
-  '^':x@(_:_)   -> cntrl x
-  'N':'U':'L':s -> returnP ('\NUL',s,4)
-  'S':'O':'H':s -> returnP ('\SOH',s,4)
-  'S':'T':'X':s -> returnP ('\STX',s,4)
-  'E':'T':'X':s -> returnP ('\ETX',s,4)
-  'E':'O':'T':s -> returnP ('\EOT',s,4)
-  'E':'N':'Q':s -> returnP ('\ENQ',s,4)
-  'A':'C':'K':s -> returnP ('\ACK',s,4)
-  'B':'E':'L':s -> returnP ('\BEL',s,4)
-  'B':'S':s     -> returnP ('\BS', s,3)
-  'H':'T':s  	  -> returnP ('\HT', s,3)
-  'L':'F':s 	  -> returnP ('\LF', s,3)
-  'V':'T':s 	  -> returnP ('\VT', s,3)
-  'F':'F':s 	  -> returnP ('\FF', s,3)
-  'C':'R':s 	  -> returnP ('\CR', s,3)
-  'S':'O':s 	  -> returnP ('\SO', s,3)
-  'S':'I':s 	  -> returnP ('\SI', s,3)
-  'D':'L':'E':s -> returnP ('\DLE',s,4)
-  'D':'C':'1':s -> returnP ('\DC1',s,4)
-  'D':'C':'2':s -> returnP ('\DC2',s,4)
-  'D':'C':'3':s -> returnP ('\DC3',s,4)
-  'D':'C':'4':s -> returnP ('\DC4',s,4)
-  'N':'A':'K':s -> returnP ('\NAK',s,4)
-  'S':'Y':'N':s -> returnP ('\SYN',s,4)
-  'E':'T':'B':s -> returnP ('\ETB',s,4)
-  'C':'A':'N':s -> returnP ('\CAN',s,4)
-  'E':'M':s     -> returnP ('\EM', s,3)
-  'S':'U':'B':s -> returnP ('\SUB',s,4)
-  'E':'S':'C':s -> returnP ('\ESC',s,4)
-  'F':'S':s     -> returnP ('\FS', s,3)
-  'G':'S':s     -> returnP ('\GS', s,3)
-  'R':'S':s     -> returnP ('\RS', s,3)
-  'U':'S':s     -> returnP ('\US', s,3)
-  'S':'P':s     -> returnP ('\SP', s,3)
-  'D':'E':'L':s -> returnP ('\DEL',s,4)
-
-  _             -> parseError "Illegal escape sequence"
-
-
--- Stolen from Hugs's Prelude
-parseInteger :: Integer -> String -> Integer
-parseInteger radix ds =
-	foldl1 (\n d -> n * radix + d) (map (toInteger . digitToInt) ds)
-
--- Production cntrl from section B.2
-
-cntrl :: String -> P (Char,String,Int)
-cntrl (c:s) | c >= '@' && c <= '_' = returnP (chr (ord c - ord '@'), s,2)
-cntrl _                            = parseError "Illegal control character"
-
-
-pragma :: (Int -> Int -> FilePath -> Bool -> [Char] -> b)
-       -> Int -> Int -> FilePath -> Bool -> [Char] -> b
-pragma cont y x f bol s0 =
-   case span (==' ') s0 of
-      (_, 'L':'I':'N':'E':' ':s) -> parseLinePragma cont y f s
-      (_, 'l':'i':'n':'e':' ':s) -> parseLinePragma cont y f s
-      (sp,s) -> nestedComment (\y x -> cont y x f) y (x+length sp) bol s
-
-parseLinePragma :: (Int -> Int -> FilePath -> Bool -> [Char] -> b)
-                -> Int -> FilePath -> [Char] -> b
-parseLinePragma cont y fname s0 =
-		cont y' 1 fname' True (drop 1 (dropWhile (/= '\n') s0))
-
-  where  s1            = dropWhite s0
-         (lineStr, s2) = span isDigit s1
-         y'            = case reads lineStr of
-	                   ((y',_):_) -> y'
-			   _          -> y
-         s3            = dropWhite s2
-	 fnameStr      = takeWhile (\c -> c /= '"' && c/='\n') (tail s3)
-         fname'        | null s3 || head s3 /= '"' = fname
-                       -- try and get more sharing of file name strings
-                       | fnameStr == fname         = fname
-                       | otherwise                 = fnameStr
-         dropWhite = dropWhile (\c -> c == ' ' || c == '\t')
-
-nestedComment :: (Int -> Int -> Bool -> [Char] -> b)
-	      -> Int -> Int -> Bool -> [Char] -> b
-nestedComment cont y x bol s0 =
-   case s0 of
-      '-':'}':s -> cont y (x+2) bol s
-      '{':'-':s -> nestedComment (nestedComment cont) y (x+2) bol s
-      '\t':s    -> nestedComment cont y (nextTab x) bol s
-      '\n':s    -> nestedComment cont (y+1) 1 True s
-      _:s       -> nestedComment cont y (x+1) bol s
-      []        -> error "Internal error: nestedComment"
-
-nestedDocComment :: ([Char] -> b)
-		 -> (b -> [Char] -> c -> Int -> Int -> d)
-                 -> [Char] -> c -> Int -> Int -> d
-nestedDocComment f0 cont0 s0 loc y0 x0 = go f0 cont0 "" y0 x0 s0
- where
-  go f cont acc y1 x1 s1 = 
-   case s1 of
-      '-':'}':s -> cont (f (reverse acc)) s loc y1 (x1+2)
-      '{':'-':s -> nestedComment (\y x _ s2 -> go f cont acc y x s2) 
-			y1 (x1+2) False s
-      '\t':s    -> go f cont ('\t':acc) y1 (nextTab x1) s
-      '\n':s    -> go f cont ('\n':acc) (y1+1) 1 s
-      c:s       -> go f cont (c:acc) y1 (x1+1) s
-      []        -> error "Internal error: nestedComment"
-
-oneLineDocComment :: ([Char] -> a)
-		  -> (a -> [Char] -> b -> c -> d -> e)
-		  -> [Char] -> b -> c -> d -> e
-oneLineDocComment f cont s loc y x
-  = cont (f line) rest loc y x -- continue with the newline char
-  where (line, rest) = break (== '\n') s
-
-multiLineDocComment :: Num a => ([Char] -> b)
-		    -> (b -> [Char] -> c -> a -> d -> e)
-		    -> [Char] -> c -> a -> d -> e
-multiLineDocComment f cont s loc y x 
-  = cont (f comment) s' loc y' x -- continue with the newline char
-  where (s', comment, y') = slurpExtraCommentLines s [] y
-    
-slurpExtraCommentLines :: Num a => [Char] -> [[Char]] -> a 
-                       -> ([Char], [Char], a)
-slurpExtraCommentLines s0 lines0 y
-  = case rest of
-	'\n':nextline -> 
-		case dropWhile nonNewlineSpace nextline of 
-		  -- stop slurping if we see a string of more than two '-';
-		  -- strings of dashes are useful as separators but we don't
-		  -- want them in the doc.
-		  '-':'-':c:s | c /= '-'
-			 -> slurpExtraCommentLines (c:s)
-				((line++"\n"):lines0) (y+1)
-		  _ -> (rest, finished, y)
-	_ -> (rest, finished, y)
-  where
-	(line, rest) = break (== '\n') s0
-	finished = concat (reverse (line:lines0))
-
-nonNewlineSpace :: Char -> Bool
-nonNewlineSpace c = isSpace c && c /= '\n'
-\end{code}
diff --git a/src/HsParseMonad.lhs b/src/HsParseMonad.lhs
deleted file mode 100644
index 27032c37..00000000
--- a/src/HsParseMonad.lhs
+++ /dev/null
@@ -1,73 +0,0 @@
------------------------------------------------------------------------------
--- $Id: HsParseMonad.lhs,v 1.2 2002/07/24 09:42:18 simonmar Exp $
---
--- (c) The GHC Team 1997-2000
---
--- Monad for the Haskell parser.
---
------------------------------------------------------------------------------
-
-\begin{code}
-module HsParseMonad where
-
-import HsSyn2
-\end{code}
-
-\begin{code}
-data ParseResult a = Ok ParseState a | Failed String
-	deriving Show
-
-data LexContext = NoLayout | Layout Int
-	deriving (Eq,Ord,Show)
-
-type ParseState = [LexContext]
-
-type P a
-     =  String			-- input string
-     -> SrcLoc			-- location of last token read
-     -> Int			-- current line
-     -> Int			-- current column
-     -> FilePath		-- current original filename
-     -> ParseState		-- layout info.
-     -> ParseResult a
-
-thenP :: P a -> (a -> P b) -> P b
-m `thenP` k = \i l n c f s0 -> 
-	case m i l n c f s0 of 
-	    Failed s -> Failed s
-	    Ok s' a -> case k a of k' -> k' i l n c f s'
-
-thenP_ :: P a -> P b -> P b
-m `thenP_` k = m `thenP` \_ -> k
-
-mapP :: (a -> P b) -> [a] -> P [b]
-mapP _ [] = returnP []
-mapP f (a:as) = 
-     f a `thenP` \b ->
-     mapP f as `thenP` \bs ->
-     returnP (b:bs)
-
-returnP :: a -> P a
-returnP a = \_ _ _ _ _ s -> Ok s a
-
-failP :: String -> P a
-failP err = \_ _ _ _ _ _ -> Failed err
-
-getSrcLoc :: P SrcLoc
-getSrcLoc = \_ l _ _ _ s -> Ok s l
-
-getContext :: P [LexContext]
-getContext = \_ _ _ _ _ s -> Ok s s
-
-pushContext :: LexContext -> P ()
-pushContext ctxt = 
---trace ("pushing lexical scope: " ++ show ctxt ++"\n") $
-	\_ _ _ _ _ s -> Ok (ctxt:s) ()
-
-popContext :: P ()
-popContext = \_ _ _ _ _ stk ->
-      case stk of
-   	(_:s) -> --trace ("popping lexical scope, context now "++show s ++ "\n") $ 
-            Ok s ()
-        []    -> error "Internal error: empty context in popContext"
-\end{code}
diff --git a/src/Main.hs b/src/Main.hs
index f77ad1f1..6372198a 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -7,7 +7,6 @@
 
 module Main (main) where
 
---import HsSyn2
 import HaddockHtml
 import HaddockHoogle
 import HaddockRename
diff --git a/src/Map.hs b/src/Map.hs
deleted file mode 100644
index 7d4c75df..00000000
--- a/src/Map.hs
+++ /dev/null
@@ -1,62 +0,0 @@
-module Map (
-   Map,
-   member, lookup, findWithDefault,
-   empty,
-   insert, insertWith,
-   union, unionWith, unions,
-   elems,
-   fromList, fromListWith,
-   toAscList
-) where
-
-import Prelude hiding ( lookup )
-
-#if __GLASGOW_HASKELL__ >= 603
-import Data.Map
-#else
-import Data.FiniteMap
-
-type Map k a = FiniteMap k a
-
-instance Functor (FiniteMap k) where
-	fmap f = mapFM (const f)
-
-member :: Ord k => k -> Map k a -> Bool
-member = elemFM
-
-lookup :: Ord k => k -> Map k a -> Maybe a
-lookup = flip lookupFM
-
-findWithDefault :: Ord k => a -> k -> Map k a -> a
-findWithDefault a k m = lookupWithDefaultFM m a k
-
-empty :: Map k a
-empty = emptyFM
-
-insert :: Ord k => k -> a -> Map k a -> Map k a
-insert k a m = addToFM m k a
-
-insertWith :: Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
-insertWith c k a m = addToFM_C (flip c) m k a
-
-union :: Ord k => Map k a -> Map k a -> Map k a
-union = flip plusFM
-
-unionWith :: Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
-unionWith c l r = plusFM_C (flip c) r l
-
-unions :: Ord k => [Map k a] -> Map k a
-unions = foldl (flip plusFM) emptyFM
-
-elems :: Map k a -> [a]
-elems = eltsFM
-
-fromList :: Ord k => [(k,a)] -> Map k a
-fromList = listToFM
-
-fromListWith :: Ord k => (a -> a -> a) -> [(k,a)] -> Map k a 
-fromListWith c = addListToFM_C (flip c) emptyFM
-
-toAscList :: Map k a -> [(k,a)]
-toAscList = fmToList
-#endif
diff --git a/src/Set.hs b/src/Set.hs
deleted file mode 100644
index 383d23f8..00000000
--- a/src/Set.hs
+++ /dev/null
@@ -1,32 +0,0 @@
-module Set (
-   Set,
-   member,
-   empty, singleton, delete,
-   union, unions,
-   elems, fromList
-) where
-
-import Data.Set 
-
-#if __GLASGOW_HASKELL__ < 603
-member :: Ord a => a -> Set a -> Bool
-member = elementOf
-
-empty  :: Set a
-empty = emptySet
-
-singleton :: a -> Set a
-singleton  = unitSet
-
-delete :: Ord a => a -> Set a -> Set a
-delete = flip delFromSet
-
-unions :: Ord a => [Set a] -> Set a
-unions = unionManySets
-
-elems :: Set a -> [a] 
-elems = setToList
-
-fromList :: Ord a => [a] -> Set a 
-fromList = mkSet
-#endif