aboutsummaryrefslogtreecommitdiff
path: root/src/Haddock/Lex.x
diff options
context:
space:
mode:
authorSimon Marlow <marlowsd@gmail.com>2011-08-11 12:08:15 +0100
committerDavid Waern <david.waern@gmail.com>2011-10-04 00:15:04 +0200
commit9331d3a35c2d370a974dced5515d2e4357ec0d6f (patch)
tree7b936d178d436766b238b71909478b50f6695d11 /src/Haddock/Lex.x
parent2b948f6297befc463493f78fdfdd995b2cbabe10 (diff)
Hack this to make it work with both Alex 2.x and Alex 3.x. Unicode in
documentation strings is (still) mangled. I don't think it's possible to make it so that we get the current behaviour with Alex 2.x but magic Unicode support if you use Alex 3.x. At some point we have to decide that Alex 3.x is a requirement, then we can do Unicode.
Diffstat (limited to 'src/Haddock/Lex.x')
-rw-r--r--src/Haddock/Lex.x34
1 files changed, 32 insertions, 2 deletions
diff --git a/src/Haddock/Lex.x b/src/Haddock/Lex.x
index 17267656..e41c9461 100644
--- a/src/Haddock/Lex.x
+++ b/src/Haddock/Lex.x
@@ -31,12 +31,11 @@ import DynFlags
import FastString
import Data.Char
+import Data.Word (Word8)
import Numeric
import System.IO.Unsafe
}
-%wrapper "posn"
-
$ws = $white # \n
$digit = [0-9]
$hexdigit = [0-9a-fA-F]
@@ -140,6 +139,37 @@ tokenPos t = let AlexPn _ line col = snd t in (line, col)
-- -----------------------------------------------------------------------------
-- Alex support stuff
+-- XXX: copied the posn wrapper code from Alex to make this lexer work
+-- with both Alex 2.x and Alex 3.x. However, we are not using the
+-- Unicode/UTF-8 support in Alex 3.x, and Unicode documentation will
+-- probably get mangled.
+
+type AlexInput = (AlexPosn, -- current position,
+ Char, -- previous char
+ String) -- current input string
+
+alexInputPrevChar :: AlexInput -> Char
+alexInputPrevChar (p,c,s) = c
+
+alexGetByte :: AlexInput -> Maybe (Word8,AlexInput)
+alexGetByte (p,c,[]) = Nothing
+alexGetByte (p,_,(c:s)) = let p' = alexMove p c
+ in p' `seq` Just (fromIntegral (ord c), (p', c, s))
+
+-- for compat with Alex 2.x:
+alexGetChar :: AlexInput -> Maybe (Char,AlexInput)
+alexGetChar i = case alexGetByte i of
+ Nothing -> Nothing
+ Just (b,i') -> Just (chr (fromIntegral b), i')
+
+alexMove :: AlexPosn -> Char -> AlexPosn
+alexMove (AlexPn a l c) '\t' = AlexPn (a+1) l (((c+7) `div` 8)*8+1)
+alexMove (AlexPn a l c) '\n' = AlexPn (a+1) (l+1) 1
+alexMove (AlexPn a l c) _ = AlexPn (a+1) l (c+1)
+
+data AlexPosn = AlexPn !Int !Int !Int
+ deriving (Eq,Show)
+
type StartCode = Int
type Action = AlexPosn -> String -> StartCode -> (StartCode -> [LToken]) -> DynFlags -> [LToken]