remove Haddock-lexing/parsing/renaming from GHC

6 files changed, 33 insertions, 495 deletions

diff --git a/compiler/parser/HaddockLex.hs-boot b/compiler/parser/HaddockLex.hs-boot
deleted file mode 100644
index 3e232c067f..0000000000
--- a/compiler/parser/HaddockLex.hs-boot
+++ /dev/null
@@ -1,20 +0,0 @@
-module HaddockLex ( Token(..), tokenise ) where
-
-import RdrName
-
-tokenise :: String -> [Token]
-
-data Token
-  = TokPara
-  | TokNumber
-  | TokBullet
-  | TokDefStart
-  | TokDefEnd
-  | TokSpecial Char
-  | TokIdent [RdrName]
-  | TokString String
-  | TokURL String
-  | TokPic String
-  | TokEmphasis String
-  | TokAName String
-  | TokBirdTrack String
diff --git a/compiler/parser/HaddockLex.x b/compiler/parser/HaddockLex.x
deleted file mode 100644
index da6dbd3706..0000000000
--- a/compiler/parser/HaddockLex.x
+++ /dev/null
@@ -1,171 +0,0 @@
---
--- Haddock - A Haskell Documentation Tool
---
--- (c) Simon Marlow 2002
---
--- This file was modified and integrated into GHC by David Waern 2006
---
-
-{
-{-# OPTIONS -Wwarn -w #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and fix
--- any warnings in the module. See
---     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
--- for details
-
-module HaddockLex (
-	Token(..),
-	tokenise
- ) where
-
-import Lexer hiding (Token)
-import Parser ( parseIdentifier )
-import StringBuffer
-import RdrName
-import SrcLoc
-import DynFlags
-
-import Data.Char
-import Numeric
-import System.IO.Unsafe
-}
-
-$ws    = $white # \n
-$digit = [0-9]
-$hexdigit = [0-9a-fA-F]
-$special =  [\"\@]
-$alphanum = [A-Za-z0-9]
-$ident    = [$alphanum \'\_\.\!\#\$\%\&\*\+\/\<\=\>\?\@\\\\\^\|\-\~]
-
-:-
-
--- beginning of a paragraph
-<0,para> {
- $ws* \n		;
- $ws* \>		{ begin birdtrack }
- $ws* [\*\-]		{ token TokBullet `andBegin` string }
- $ws* \[		{ token TokDefStart `andBegin` def }
- $ws* \( $digit+ \) 	{ token TokNumber `andBegin` string }
- $ws*			{ begin string }		
-}
-
--- beginning of a line
-<line> {
-  $ws* \>		{ begin birdtrack }
-  $ws* \n		{ token TokPara `andBegin` para }
-  -- Here, we really want to be able to say
-  -- $ws* (\n | <eof>) 	{ token TokPara `andBegin` para}
-  -- because otherwise a trailing line of whitespace will result in 
-  -- a spurious TokString at the end of a docstring.  We don't have <eof>,
-  -- though (NOW I realise what it was for :-).  To get around this, we always
-  -- append \n to the end of a docstring.
-  () 			{ begin string }
-}
-
-<birdtrack> .*	\n?	{ strtokenNL TokBirdTrack `andBegin` line }
-
-<string,def> {
-  $special			{ strtoken $ \s -> TokSpecial (head s) }
-  \<\<.*\>\>                    { strtoken $ \s -> TokPic (init $ init $ tail $ tail s) }
-  \<.*\>			{ strtoken $ \s -> TokURL (init (tail s)) }
-  \#.*\#			{ strtoken $ \s -> TokAName (init (tail s)) }
-  \/ [^\/]* \/                  { strtoken $ \s -> TokEmphasis (init (tail s)) }
-  [\'\`] $ident+ [\'\`]		{ ident }
-  \\ .				{ strtoken (TokString . tail) }
-  "&#" $digit+ \;		{ strtoken $ \s -> TokString [chr (read (init (drop 2 s)))] }
-  "&#" [xX] $hexdigit+ \;	{ strtoken $ \s -> case readHex (init (drop 3 s)) of [(n,_)] -> TokString [chr n] }
-  -- allow special characters through if they don't fit one of the previous
-  -- patterns.
-  [\/\'\`\<\#\&\\]			{ strtoken TokString }
-  [^ $special \/ \< \# \n \'\` \& \\ \]]* \n { strtokenNL TokString `andBegin` line }
-  [^ $special \/ \< \# \n \'\` \& \\ \]]+    { strtoken TokString }
-}
-
-<def> {
-  \]				{ token TokDefEnd `andBegin` string }
-}
-
--- ']' doesn't have any special meaning outside of the [...] at the beginning
--- of a definition paragraph.
-<string> {
-  \]				{ strtoken TokString }
-}
-
-{
-data Token
-  = TokPara
-  | TokNumber
-  | TokBullet
-  | TokDefStart
-  | TokDefEnd
-  | TokSpecial Char
-  | TokIdent [RdrName]
-  | TokString String
-  | TokURL String
-  | TokPic String
-  | TokEmphasis String
-  | TokAName String
-  | TokBirdTrack String
---  deriving Show
-
--- -----------------------------------------------------------------------------
--- Alex support stuff
-
-type StartCode = Int
-type Action = String -> StartCode -> (StartCode -> [Token]) -> [Token]
-
-type AlexInput = (Char,String)
-
-alexGetChar (_, [])   = Nothing
-alexGetChar (_, c:cs) = Just (c, (c,cs))
-
-alexInputPrevChar (c,_) = c
-
-tokenise :: String -> [Token]
-tokenise str = let toks = go ('\n', eofHack str) para in {-trace (show toks)-} toks
-  where go inp@(_,str) sc =
-	  case alexScan inp sc of
-		AlexEOF -> []
-		AlexError _ -> error "lexical error"
-		AlexSkip  inp' _       -> go inp' sc
-		AlexToken inp' len act -> act (take len str) sc (\sc -> go inp' sc)
-
--- NB. we add a final \n to the string, (see comment in the beginning of line
--- production above).
-eofHack str = str++"\n"
-
-andBegin  :: Action -> StartCode -> Action
-andBegin act new_sc = \str _ cont -> act str new_sc cont
-
-token :: Token -> Action
-token t = \_ sc cont -> t : cont sc
-
-strtoken, strtokenNL :: (String -> Token) -> Action
-strtoken t = \str sc cont -> t str : cont sc
-strtokenNL t = \str sc cont -> t (filter (/= '\r') str) : cont sc
--- ^ We only want LF line endings in our internal doc string format, so we
--- filter out all CRs.
-
-begin :: StartCode -> Action
-begin sc = \_ _ cont -> cont sc
-
--- -----------------------------------------------------------------------------
--- Lex a string as a Haskell identifier
-
-ident :: Action
-ident str sc cont = 
-  case strToHsQNames id of
-	Just names -> TokIdent names : cont sc
-	Nothing -> TokString str : cont sc
- where id = init (tail str)
-
-strToHsQNames :: String -> Maybe [RdrName]
-strToHsQNames str0 = 
-  let buffer = unsafePerformIO (stringToStringBuffer str0)
-      pstate = mkPState buffer noSrcLoc defaultDynFlags
-      result = unP parseIdentifier pstate 
-  in case result of 
-       POk _ name -> Just [unLoc name] 
-       _ -> Nothing
-}
diff --git a/compiler/parser/HaddockParse.y b/compiler/parser/HaddockParse.y
deleted file mode 100644
index c0f64d45ad..0000000000
--- a/compiler/parser/HaddockParse.y
+++ /dev/null
@@ -1,119 +0,0 @@
-{
-{-# OPTIONS -Wwarn -w #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and fix
--- any warnings in the module. See
---     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
--- for details
-
-module HaddockParse (
-  parseHaddockParagraphs, 
-  parseHaddockString, 
-  EitherString(..)
-) where
-
-import {-# SOURCE #-} HaddockLex
-import HsSyn
-import RdrName
-}
-
-%expect 0
-
-%tokentype { Token }
-
-%token	'/'	{ TokSpecial '/' }
-	'@'	{ TokSpecial '@' }
-	'['     { TokDefStart }
-	']'     { TokDefEnd }
-	DQUO 	{ TokSpecial '\"' }
-	URL	{ TokURL $$ }
-	PIC     { TokPic $$ }
-	ANAME	{ TokAName $$ }
-	'/../'  { TokEmphasis $$ }
-	'-'	{ TokBullet }
-	'(n)'	{ TokNumber }
-	'>..'	{ TokBirdTrack $$ }
-	IDENT   { TokIdent $$ }
-	PARA    { TokPara }
-	STRING	{ TokString $$ }
-
-%monad { EitherString }
-
-%name parseHaddockParagraphs  doc
-%name parseHaddockString seq
-
-%%
-
-doc	:: { HsDoc RdrName }
-	: apara PARA doc	{ docAppend $1 $3 }
-	| PARA doc 		{ $2 }
-	| apara			{ $1 }
-	| {- empty -}		{ DocEmpty }
-
-apara	:: { HsDoc RdrName }
-	: ulpara		{ DocUnorderedList [$1] }
-	| olpara		{ DocOrderedList [$1] }
-        | defpara               { DocDefList [$1] }
-	| para			{ $1 }
-
-ulpara  :: { HsDoc RdrName }
-	: '-' para		{ $2 }
-
-olpara  :: { HsDoc RdrName } 
-	: '(n)' para		{ $2 }
-
-defpara :: { (HsDoc RdrName, HsDoc RdrName) }
-	: '[' seq ']' seq	{ ($2, $4) }
-
-para    :: { HsDoc RdrName }
-	: seq			{ docParagraph $1 }
-	| codepara		{ DocCodeBlock $1 }
-
-codepara :: { HsDoc RdrName }
-	: '>..' codepara	{ docAppend (DocString $1) $2 }
-	| '>..'			{ DocString $1 }
-
-seq	:: { HsDoc RdrName }
-	: elem seq		{ docAppend $1 $2 }
-	| elem			{ $1 }
-
-elem	:: { HsDoc RdrName }
-	: elem1			{ $1 }
-	| '@' seq1 '@'		{ DocMonospaced $2 }
-
-seq1	:: { HsDoc RdrName }
-	: PARA seq1             { docAppend (DocString "\n") $2 }
-	| elem1 seq1            { docAppend $1 $2 }
-	| elem1			{ $1 }
-
-elem1	:: { HsDoc RdrName }
-	: STRING		{ DocString $1 }
-	| '/../'                { DocEmphasis (DocString $1) }
-	| URL			{ DocURL $1 }
-	| PIC                   { DocPic $1 }
-	| ANAME			{ DocAName $1 }
-	| IDENT			{ DocIdentifier $1 }
-	| DQUO strings DQUO	{ DocModule $2 }
-
-strings  :: { String }
-	: STRING		{ $1 }
-	| STRING strings	{ $1 ++ $2 }
-
-{
-happyError :: [Token] -> EitherString a
-happyError toks = MyLeft ("parse error in doc string")
-
--- We don't want to make an instance for Either String,
--- since every user of the GHC API would get that instance
-
--- But why use non-Haskell98 instances when MyEither String
--- is the only MyEither we're intending to use anyway? --Isaac Dupree
---data MyEither a b = MyLeft a | MyRight b
-data EitherString b = MyLeft String | MyRight b
-
-instance Monad EitherString where
-	return          = MyRight
-	MyLeft  l >>= _ = MyLeft l
-	MyRight r >>= k = k r
-	fail msg        = MyLeft msg
-}
diff --git a/compiler/parser/HaddockUtils.hs b/compiler/parser/HaddockUtils.hs
index b84692a6b1..e09f497e48 100644
--- a/compiler/parser/HaddockUtils.hs
+++ b/compiler/parser/HaddockUtils.hs
@@ -2,168 +2,33 @@
 module HaddockUtils where
 
 import HsSyn
-import {-# SOURCE #-} HaddockLex
-import HaddockParse
 import SrcLoc
 import RdrName
 
+import FastString
+
 import Control.Monad
 import Data.Char
 
 -- -----------------------------------------------------------------------------
--- Parsing module headers
-
--- NB.  The headers must be given in the order Module, Description,
--- Copyright, License, Maintainer, Stability, Portability, except that
--- any or all may be omitted.
-parseModuleHeader :: String -> Either String (String, HaddockModInfo RdrName)
-parseModuleHeader str0 =
-   let
-      getKey :: String -> String -> (Maybe String,String)
-      getKey key str = case parseKey key str of
-         Nothing -> (Nothing,str)
-         Just (value,rest) -> (Just value,rest)
-
-      (_moduleOpt,str1) = getKey "Module" str0
-      (descriptionOpt,str2) = getKey "Description" str1
-      (_copyrightOpt,str3) = getKey "Copyright" str2
-      (_licenseOpt,str4) = getKey "License" str3
-      (_licenceOpt,str5) = getKey "Licence" str4
-      (maintainerOpt,str6) = getKey "Maintainer" str5
-      (stabilityOpt,str7) = getKey "Stability" str6
-      (portabilityOpt,str8) = getKey "Portability" str7
-
-      description1 :: Either String (Maybe (HsDoc RdrName))
-      description1 = case descriptionOpt of
-         Nothing -> Right Nothing
-         Just description -> case parseHaddockString . tokenise $ description of
-
-            MyLeft mess -> Left ("Cannot parse Description: " ++ mess)
-            MyRight doc -> Right (Just doc)
-   in
-      case description1 of
-         Left mess -> Left mess
-         Right docOpt -> Right (str8,HaddockModInfo {
-            hmi_description = docOpt,
-            hmi_portability = portabilityOpt,
-            hmi_stability = stabilityOpt,
-            hmi_maintainer = maintainerOpt
-            })
-
--- | This function is how we read keys.
---
--- all fields in the header are optional and have the form
---
--- [spaces1][field name][spaces] ":"
---    [text]"\n" ([spaces2][space][text]"\n" | [spaces]"\n")*
--- where each [spaces2] should have [spaces1] as a prefix.
---
--- Thus for the key "Description",
---
--- > Description : this is a
--- >    rather long
--- >
--- >    description
--- >
--- > The module comment starts here
---
--- the value will be "this is a .. description" and the rest will begin
--- at "The module comment".
-parseKey :: String -> String -> Maybe (String,String)
-parseKey key toParse0 =
-   do
-      let
-         (spaces0,toParse1) = extractLeadingSpaces toParse0
-
-         indentation = spaces0
-      afterKey0 <- extractPrefix key toParse1
-      let
-         afterKey1 = extractLeadingSpaces afterKey0
-      afterColon0 <- case snd afterKey1 of
-         ':':afterColon -> return afterColon
-         _ -> Nothing
-      let
-         (_,afterColon1) = extractLeadingSpaces afterColon0
-
-      return (scanKey True indentation afterColon1)
-   where
-      scanKey :: Bool -> String -> String -> (String,String)
-      scanKey _       _           [] = ([],[])
-      scanKey isFirst indentation str =
-         let
-            (nextLine,rest1) = extractNextLine str
-
-            accept = isFirst || sufficientIndentation || allSpaces
-
-            sufficientIndentation = case extractPrefix indentation nextLine of
-               Just (c:_) | isSpace c -> True
-               _ -> False
-
-            allSpaces = case extractLeadingSpaces nextLine of
-               (_,[]) -> True
-               _ -> False
-         in
-            if accept
-               then
-                  let
-                     (scanned1,rest2) = scanKey False indentation rest1
-
-                     scanned2 = case scanned1 of
-                        "" -> if allSpaces then "" else nextLine
-                        _ -> nextLine ++ "\n" ++ scanned1
-                  in
-                     (scanned2,rest2)
-               else
-                  ([],str)
-
-      extractLeadingSpaces :: String -> (String,String)
-      extractLeadingSpaces [] = ([],[])
-      extractLeadingSpaces (s@(c:cs))
-         | isSpace c =
-            let
-               (spaces1,cs1) = extractLeadingSpaces cs
-            in
-               (c:spaces1,cs1)
-         | True = ([],s)
-
-      extractNextLine :: String -> (String,String)
-      extractNextLine [] = ([],[])
-      extractNextLine (c:cs)
-         | c == '\n' =
-            ([],cs)
-         | True =
-            let
-               (line,rest) = extractNextLine cs
-            in
-               (c:line,rest)
-
-      -- comparison is case-insensitive.
-      extractPrefix :: String -> String -> Maybe String
-      extractPrefix [] s = Just s
-      extractPrefix _ [] = Nothing
-      extractPrefix (c1:cs1) (c2:cs2)
-         | toUpper c1 == toUpper c2 = extractPrefix cs1 cs2
-         | True = Nothing
-
--- -----------------------------------------------------------------------------
 -- Adding documentation to record fields (used in parsing).
 
-addFieldDoc :: ConDeclField a -> Maybe (LHsDoc a) -> ConDeclField a
+addFieldDoc :: ConDeclField a -> Maybe LHsDocString -> ConDeclField a
 addFieldDoc fld doc = fld { cd_fld_doc = cd_fld_doc fld `mplus` doc }
 
-addFieldDocs :: [ConDeclField a] -> Maybe (LHsDoc a) -> [ConDeclField a]
+addFieldDocs :: [ConDeclField a] -> Maybe LHsDocString -> [ConDeclField a]
 addFieldDocs [] _ = []
 addFieldDocs (x:xs) doc = addFieldDoc x doc : xs
 
-addConDoc :: LConDecl a -> Maybe (LHsDoc a) -> LConDecl a
+addConDoc :: LConDecl a -> Maybe LHsDocString -> LConDecl a
 addConDoc decl    Nothing = decl
 addConDoc (L p c) doc     = L p ( c { con_doc = con_doc c `mplus` doc } )
 
-addConDocs :: [LConDecl a] -> Maybe (LHsDoc a) -> [LConDecl a]
+addConDocs :: [LConDecl a] -> Maybe LHsDocString -> [LConDecl a]
 addConDocs [] _ = []
 addConDocs [x] doc = [addConDoc x doc]
 addConDocs (x:xs) doc = x : addConDocs xs doc
 
-addConDocFirst :: [LConDecl a] -> Maybe (LHsDoc a) -> [LConDecl a]
+addConDocFirst :: [LConDecl a] -> Maybe LHsDocString -> [LConDecl a]
 addConDocFirst [] _ = []
 addConDocFirst (x:xs) doc = addConDoc x doc : xs
diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp
index 9f3dd27bda..f051726b76 100644
--- a/compiler/parser/Parser.y.pp
+++ b/compiler/parser/Parser.y.pp
@@ -51,8 +51,6 @@ import BasicTypes	( Boxity(..), Fixity(..), FixityDirection(..), IPName(..),
 			  Activation(..), RuleMatchInfo(..), defaultInlineSpec )
 import DynFlags
 import OrdList
-import HaddockParse
-import {-# SOURCE #-} HaddockLex hiding ( Token )
 import HaddockUtils
 
 import FastString
@@ -382,18 +380,18 @@ identifier :: { Located RdrName }
 
 module 	:: { Located (HsModule RdrName) }
  	: maybedocheader 'module' modid maybemodwarning maybeexports 'where' body
-		{% fileSrcSpan >>= \ loc -> case $1 of { (info, doc) ->
-		   return (L loc (HsModule (Just $3) $5 (fst $7) (snd $7) $4
-                          info doc) )}}
+		{% fileSrcSpan >>= \ loc ->
+		   return (L loc (HsModule (Just $3) $5 (fst $7) (snd $7) $4 $1
+                          ) )}
         | body2
 		{% fileSrcSpan >>= \ loc ->
 		   return (L loc (HsModule Nothing Nothing
-                          (fst $1) (snd $1) Nothing emptyHaddockModInfo
-                          Nothing)) }
+                          (fst $1) (snd $1) Nothing Nothing
+                          )) }
 
-maybedocheader :: { (HaddockModInfo RdrName, Maybe (HsDoc RdrName)) }
+maybedocheader :: { Maybe LHsDocString }
         : moduleheader            { $1 }
-        | {- empty -}             { (emptyHaddockModInfo, Nothing) }
+        | {- empty -}             { Nothing }
 
 missing_module_keyword :: { () }
 	: {- empty -}				{% pushCurrentContext }
@@ -424,13 +422,13 @@ cvtopdecls :: { [LHsDecl RdrName] }
 
 header 	:: { Located (HsModule RdrName) }
  	: maybedocheader 'module' modid maybemodwarning maybeexports 'where' header_body
-		{% fileSrcSpan >>= \ loc -> case $1 of { (info, doc) ->
-		   return (L loc (HsModule (Just $3) $5 $7 [] $4
-                   info doc))}}
+		{% fileSrcSpan >>= \ loc ->
+		   return (L loc (HsModule (Just $3) $5 $7 [] $4 $1
+                          ))}
 	| missing_module_keyword importdecls
 		{% fileSrcSpan >>= \ loc ->
 		   return (L loc (HsModule Nothing Nothing $2 [] Nothing
-                   emptyHaddockModInfo Nothing)) }
+                          Nothing)) }
 
 header_body :: { [LImportDecl RdrName] }
 	:  '{'            importdecls		{ $2 }
@@ -1192,7 +1190,7 @@ deriving :: { Located (Maybe [LHsType RdrName]) }
 docdecl :: { LHsDecl RdrName }
         : docdecld { L1 (DocD (unLoc $1)) }
 
-docdecld :: { LDocDecl RdrName }
+docdecld :: { LDocDecl }
         : docnext                               { L1 (DocCommentNext (unLoc $1)) }
         | docprev                               { L1 (DocCommentPrev (unLoc $1)) }
         | docnamed                              { L1 (case (unLoc $1) of (n, doc) -> DocCommentNamed n doc) }
@@ -1926,46 +1924,31 @@ commas :: { Int }
 -----------------------------------------------------------------------------
 -- Documentation comments
 
-docnext :: { LHsDoc RdrName }
-  : DOCNEXT {% case parseHaddockParagraphs (tokenise (getDOCNEXT $1)) of {
-      MyLeft  err -> parseError (getLoc $1) err;
-      MyRight doc -> return (L1 doc) } }
+docnext :: { LHsDocString }
+  : DOCNEXT {% return (L1 (HsDocString (mkFastString (getDOCNEXT $1)))) }
 
-docprev :: { LHsDoc RdrName }
-  : DOCPREV {% case parseHaddockParagraphs (tokenise (getDOCPREV $1)) of {
-      MyLeft  err -> parseError (getLoc $1) err;
-      MyRight doc -> return (L1 doc) } }
+docprev :: { LHsDocString }
+  : DOCPREV {% return (L1 (HsDocString (mkFastString (getDOCPREV $1)))) }
 
-docnamed :: { Located (String, (HsDoc RdrName)) }
+docnamed :: { Located (String, HsDocString) }
   : DOCNAMED {%
       let string = getDOCNAMED $1 
           (name, rest) = break isSpace string
-      in case parseHaddockParagraphs (tokenise rest) of {
-        MyLeft  err -> parseError (getLoc $1) err;
-        MyRight doc -> return (L1 (name, doc)) } }
+      in return (L1 (name, HsDocString (mkFastString rest))) }
 
-docsection :: { Located (Int, HsDoc RdrName) }
+docsection :: { Located (Int, HsDocString) }
   : DOCSECTION {% let (n, doc) = getDOCSECTION $1 in
-        case parseHaddockString (tokenise doc) of {
-      MyLeft  err -> parseError (getLoc $1) err;
-      MyRight doc -> return (L1 (n, doc)) } }
+        return (L1 (n, HsDocString (mkFastString doc))) }
 
-moduleheader :: { (HaddockModInfo RdrName, Maybe (HsDoc RdrName)) }                                    
+moduleheader :: { Maybe LHsDocString }
         : DOCNEXT {% let string = getDOCNEXT $1 in
-               case parseModuleHeader string of {                       
-                 Right (str, info) ->                                  
-                   case parseHaddockParagraphs (tokenise str) of {               
-                     MyLeft err -> parseError (getLoc $1) err;                    
-                     MyRight doc -> return (info, Just doc);          
-                   };                                             
-                 Left err -> parseError (getLoc $1) err
-            }  }                                                  
-
-maybe_docprev :: { Maybe (LHsDoc RdrName) }
+                     return (Just (L1 (HsDocString (mkFastString string)))) }
+
+maybe_docprev :: { Maybe LHsDocString }
 	: docprev                       { Just $1 }
 	| {- empty -}                   { Nothing }
 
-maybe_docnext :: { Maybe (LHsDoc RdrName) }
+maybe_docnext :: { Maybe LHsDocString }
 	: docnext                       { Just $1 }
 	| {- empty -}                   { Nothing }
 
diff --git a/compiler/parser/RdrHsSyn.lhs b/compiler/parser/RdrHsSyn.lhs
index a299dc5f3c..cacd14c27b 100644
--- a/compiler/parser/RdrHsSyn.lhs
+++ b/compiler/parser/RdrHsSyn.lhs
@@ -255,7 +255,7 @@ cvBindGroup binding
       	    	  	         ValBindsIn mbs sigs
 
 cvBindsAndSigs :: OrdList (LHsDecl RdrName)
-  -> (Bag (LHsBind RdrName), [LSig RdrName], [LTyClDecl RdrName], [LDocDecl RdrName])
+  -> (Bag (LHsBind RdrName), [LSig RdrName], [LTyClDecl RdrName], [LDocDecl])
 -- Input decls contain just value bindings and signatures
 -- and in case of class or instance declarations also
 -- associated type declarations. They might also contain Haddock comments.