compiler/parser/HaddockLex.x

   1 --
   2 -- Haddock - A Haskell Documentation Tool
   3 --
   4 -- (c) Simon Marlow 2002
   5 --
   6 -- This file was modified and integrated into GHC by David Waern 2006
   7 --
   8
   9 {
  10 module HaddockLex (
  11         Token(..),
  12         tokenise
  13  ) where
  14
  15 import HsSyn
  16 import Lexer hiding (Token)
  17 import Parser ( parseIdentifier )
  18 import StringBuffer
  19 import OccName
  20 import RdrName
  21 import SrcLoc
  22 import DynFlags
  23 import DynFlags
  24
  25 import Char
  26 import Numeric
  27 import System.IO.Unsafe
  28 }
  29
  30 $ws    = $white # \n
  31 $digit = [0-9]
  32 $hexdigit = [0-9a-fA-F]
  33 $special =  [\"\@\/]
  34 $alphanum = [A-Za-z0-9]
  35 $ident    = [$alphanum \'\_\.\!\#\$\%\&\*\+\/\<\=\>\?\@\\\\\^\|\-\~]
  36
  37 :-
  38
  39 -- beginning of a paragraph
  40 <0,para> {
  41  $ws* \n                ;
  42  $ws* \>                { begin birdtrack }
  43  $ws* [\*\-]            { token TokBullet `andBegin` string }
  44  $ws* \[                { token TokDefStart `andBegin` def }
  45  $ws* \( $digit+ \)     { token TokNumber `andBegin` string }
  46  $ws*                   { begin string }
  47 }
  48
  49 -- beginning of a line
  50 <line> {
  51   $ws* \>               { begin birdtrack }
  52   $ws* \n               { token TokPara `andBegin` para }
  53   -- Here, we really want to be able to say
  54   -- $ws* (\n | <eof>)  { token TokPara `andBegin` para}
  55   -- because otherwise a trailing line of whitespace will result in
  56   -- a spurious TokString at the end of a docstring.  We don't have <eof>,
  57   -- though (NOW I realise what it was for :-).  To get around this, we always
  58   -- append \n to the end of a docstring.
  59   ()                    { begin string }
  60 }
  61
  62 <birdtrack> .*  \n?     { strtoken TokBirdTrack `andBegin` line }
  63
  64 <string,def> {
  65   $special                      { strtoken $ \s -> TokSpecial (head s) }
  66   \<.*\>                        { strtoken $ \s -> TokURL (init (tail s)) }
  67   \#.*\#                        { strtoken $ \s -> TokAName (init (tail s)) }
  68   [\'\`] $ident+ [\'\`]         { ident }
  69   \\ .                          { strtoken (TokString . tail) }
  70   "&#" $digit+ \;               { strtoken $ \s -> TokString [chr (read (init (drop 2 s)))] }
  71   "&#" [xX] $hexdigit+ \;       { strtoken $ \s -> case readHex (init (drop 3 s)) of [(n,_)] -> TokString [chr n] }
  72   -- allow special characters through if they don't fit one of the previous
  73   -- patterns.
  74   [\'\`\<\#\&\\]                        { strtoken TokString }
  75   [^ $special \< \# \n \'\` \& \\ \]]* \n { strtoken TokString `andBegin` line }
  76   [^ $special \< \# \n \'\` \& \\ \]]+    { strtoken TokString }
  77 }
  78
  79 <def> {
  80   \]                            { token TokDefEnd `andBegin` string }
  81 }
  82
  83 -- ']' doesn't have any special meaning outside of the [...] at the beginning
  84 -- of a definition paragraph.
  85 <string> {
  86   \]                            { strtoken TokString }
  87 }
  88
  89 {
  90 data Token
  91   = TokPara
  92   | TokNumber
  93   | TokBullet
  94   | TokDefStart
  95   | TokDefEnd
  96   | TokSpecial Char
  97   | TokIdent [RdrName]
  98   | TokString String
  99   | TokURL String
 100   | TokAName String
 101   | TokBirdTrack String
 102 --  deriving Show
 103
 104 -- -----------------------------------------------------------------------------
 105 -- Alex support stuff
 106
 107 type StartCode = Int
 108 type Action = String -> StartCode -> (StartCode -> [Token]) -> [Token]
 109
 110 type AlexInput = (Char,String)
 111
 112 alexGetChar (_, [])   = Nothing
 113 alexGetChar (_, c:cs) = Just (c, (c,cs))
 114
 115 alexInputPrevChar (c,_) = c
 116
 117 tokenise :: String -> [Token]
 118 tokenise str = let toks = go ('\n', eofHack str) para in {-trace (show toks)-} toks
 119   where go inp@(_,str) sc =
 120           case alexScan inp sc of
 121                 AlexEOF -> []
 122                 AlexError _ -> error "lexical error"
 123                 AlexSkip  inp' len     -> go inp' sc
 124                 AlexToken inp' len act -> act (take len str) sc (\sc -> go inp' sc)
 125
 126 -- NB. we add a final \n to the string, (see comment in the beginning of line
 127 -- production above).
 128 eofHack str = str++"\n"
 129
 130 andBegin  :: Action -> StartCode -> Action
 131 andBegin act new_sc = \str sc cont -> act str new_sc cont
 132
 133 token :: Token -> Action
 134 token t = \str sc cont -> t : cont sc
 135
 136 strtoken :: (String -> Token) -> Action
 137 strtoken t = \str sc cont -> t str : cont sc
 138
 139 begin :: StartCode -> Action
 140 begin sc = \str _ cont -> cont sc
 141
 142 -- -----------------------------------------------------------------------------
 143 -- Lex a string as a Haskell identifier
 144
 145 ident :: Action
 146 ident str sc cont =
 147   case strToHsQNames id of
 148         Just names -> TokIdent names : cont sc
 149         Nothing -> TokString str : cont sc
 150  where id = init (tail str)
 151
 152 strToHsQNames :: String -> Maybe [RdrName]
 153 strToHsQNames str0 =
 154   let buffer = unsafePerformIO (stringToStringBuffer str0)
 155       pstate = mkPState buffer noSrcLoc defaultDynFlags
 156       lex = lexer (\t -> return t)
 157       result = unP parseIdentifier pstate
 158   in case result of
 159        POk _ name -> Just [unLoc name]
 160        _ -> Nothing
 161 }