diff --git a/alex.cabal b/alex.cabal
--- a/alex.cabal
+++ b/alex.cabal
@@ -1,5 +1,5 @@
name: alex
-version: 3.1.0
+version: 3.1.1
license: BSD3
license-file: LICENSE
copyright: (c) Chis Dornan, Simon Marlow
@@ -16,6 +16,10 @@
for scanning text efficiently. It is similar to the tool
lex or flex for C/C++.
.
+ Changes in 3.1.1:
+ .
+ * Bug fixes (#24, #30, #31, #32)
+ .
Changes in 3.1.0:
.
* necessary changes to work with GHC 7.8.1
@@ -57,13 +61,16 @@
templates/GenericTemplate.hs
templates/wrappers.hs
tests/Makefile
- tests/simple.x
- tests/tokens.x
+ tests/simple.x
+ tests/null.x
+ tests/tokens.x
tests/tokens_gscan.x
tests/tokens_posn.x
tests/tokens_bytestring.x
tests/tokens_posn_bytestring.x
tests/tokens_strict_bytestring.x
+ tests/tokens_monad_bytestring.x
+ tests/tokens_monadUserState_bytestring.x
tests/unicode.x
source-repository head
diff --git a/dist/build/alex/alex-tmp/Parser.hs b/dist/build/alex/alex-tmp/Parser.hs
--- a/dist/build/alex/alex-tmp/Parser.hs
+++ b/dist/build/alex/alex-tmp/Parser.hs
@@ -21,7 +21,7 @@
import qualified Data.Array as Happy_Data_Array
import qualified GHC.Exts as Happy_GHC_Exts
--- parser produced by Happy Version 1.18.9
+-- parser produced by Happy Version 1.19.0.1
newtype HappyAbsSyn = HappyAbsSyn HappyAny
#if __GLASGOW_HASKELL__ >= 607
@@ -874,20 +874,35 @@
{-# LINE 1 "templates/GenericTemplate.hs" #-}
-- Id: GenericTemplate.hs,v 1.26 2005/01/14 14:47:22 simonmar Exp
-{-# LINE 30 "templates/GenericTemplate.hs" #-}
+{-# LINE 13 "templates/GenericTemplate.hs" #-}
+
+
+
+#if __GLASGOW_HASKELL__ > 706
+#define LT(n,m) ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.<# m)) :: Bool)
+#define GTE(n,m) ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.>=# m)) :: Bool)
+#define EQ(n,m) ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.==# m)) :: Bool)
+#else
+#define LT(n,m) (n Happy_GHC_Exts.<# m)
+#define GTE(n,m) (n Happy_GHC_Exts.>=# m)
+#define EQ(n,m) (n Happy_GHC_Exts.==# m)
+#endif
+{-# LINE 45 "templates/GenericTemplate.hs" #-}
+
+
data Happy_IntList = HappyCons Happy_GHC_Exts.Int# Happy_IntList
-{-# LINE 51 "templates/GenericTemplate.hs" #-}
+{-# LINE 66 "templates/GenericTemplate.hs" #-}
-{-# LINE 61 "templates/GenericTemplate.hs" #-}
+{-# LINE 76 "templates/GenericTemplate.hs" #-}
-{-# LINE 70 "templates/GenericTemplate.hs" #-}
+{-# LINE 85 "templates/GenericTemplate.hs" #-}
infixr 9 `HappyStk`
data HappyStk a = HappyStk a (HappyStk a)
@@ -904,9 +919,9 @@
-- parse (a %partial parser). We must ignore the saved token on the top of
-- the stack in this case.
happyAccept 0# tk st sts (_ `HappyStk` ans `HappyStk` _) =
- happyReturn1 ans
+ happyReturn1 ans
happyAccept j tk st sts (HappyStk ans _) =
- (happyTcHack j (happyTcHack st)) (happyReturn1 ans)
+ (happyTcHack j (happyTcHack st)) (happyReturn1 ans)
-----------------------------------------------------------------------------
-- Arrays only: do the next action
@@ -914,37 +929,35 @@
happyDoAction i tk st
- = {- nothing -}
+ = {- nothing -}
- case action of
- 0# -> {- nothing -}
- happyFail i tk st
- -1# -> {- nothing -}
- happyAccept i tk st
- n | (n Happy_GHC_Exts.<# (0# :: Happy_GHC_Exts.Int#)) -> {- nothing -}
+ case action of
+ 0# -> {- nothing -}
+ happyFail i tk st
+ -1# -> {- nothing -}
+ happyAccept i tk st
+ n | LT(n,(0# :: Happy_GHC_Exts.Int#)) -> {- nothing -}
- (happyReduceArr Happy_Data_Array.! rule) i tk st
- where rule = (Happy_GHC_Exts.I# ((Happy_GHC_Exts.negateInt# ((n Happy_GHC_Exts.+# (1# :: Happy_GHC_Exts.Int#))))))
- n -> {- nothing -}
+ (happyReduceArr Happy_Data_Array.! rule) i tk st
+ where rule = (Happy_GHC_Exts.I# ((Happy_GHC_Exts.negateInt# ((n Happy_GHC_Exts.+# (1# :: Happy_GHC_Exts.Int#))))))
+ n -> {- nothing -}
- happyShift new_state i tk st
- where (new_state) = (n Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#))
- where (off) = indexShortOffAddr happyActOffsets st
- (off_i) = (off Happy_GHC_Exts.+# i)
- check = if (off_i Happy_GHC_Exts.>=# (0# :: Happy_GHC_Exts.Int#))
- then (indexShortOffAddr happyCheck off_i Happy_GHC_Exts.==# i)
- else False
- (action)
+ happyShift new_state i tk st
+ where new_state = (n Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#))
+ where off = indexShortOffAddr happyActOffsets st
+ off_i = (off Happy_GHC_Exts.+# i)
+ check = if GTE(off_i,(0# :: Happy_GHC_Exts.Int#))
+ then EQ(indexShortOffAddr happyCheck off_i, i)
+ else False
+ action
| check = indexShortOffAddr happyTable off_i
| otherwise = indexShortOffAddr happyDefActions st
-{-# LINE 130 "templates/GenericTemplate.hs" #-}
-
indexShortOffAddr (HappyA# arr) off =
- Happy_GHC_Exts.narrow16Int# i
+ Happy_GHC_Exts.narrow16Int# i
where
i = Happy_GHC_Exts.word2Int# (Happy_GHC_Exts.or# (Happy_GHC_Exts.uncheckedShiftL# high 8#) low)
high = Happy_GHC_Exts.int2Word# (Happy_GHC_Exts.ord# (Happy_GHC_Exts.indexCharOffAddr# arr (off' Happy_GHC_Exts.+# 1#)))
@@ -963,13 +976,13 @@
-----------------------------------------------------------------------------
-- HappyState data type (not arrays)
-{-# LINE 163 "templates/GenericTemplate.hs" #-}
+{-# LINE 169 "templates/GenericTemplate.hs" #-}
-----------------------------------------------------------------------------
-- Shifting a token
happyShift new_state 0# tk st sts stk@(x `HappyStk` _) =
- let (i) = (case Happy_GHC_Exts.unsafeCoerce# x of { (Happy_GHC_Exts.I# (i)) -> i }) in
+ let i = (case Happy_GHC_Exts.unsafeCoerce# x of { (Happy_GHC_Exts.I# (i)) -> i }) in
-- trace "shifting the error token" $
happyDoAction i tk new_state (HappyCons (st) (sts)) (stk)
@@ -1005,30 +1018,33 @@
= happyFail 0# tk st sts stk
happyReduce k nt fn j tk st sts stk
= case happyDrop (k Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#)) sts of
- sts1@((HappyCons (st1@(action)) (_))) ->
- let r = fn stk in -- it doesn't hurt to always seq here...
- happyDoSeq r (happyGoto nt j tk st1 sts1 r)
+ sts1@((HappyCons (st1@(action)) (_))) ->
+ let r = fn stk in -- it doesn't hurt to always seq here...
+ happyDoSeq r (happyGoto nt j tk st1 sts1 r)
happyMonadReduce k nt fn 0# tk st sts stk
= happyFail 0# tk st sts stk
happyMonadReduce k nt fn j tk st sts stk =
- happyThen1 (fn stk tk) (\r -> happyGoto nt j tk st1 sts1 (r `HappyStk` drop_stk))
- where (sts1@((HappyCons (st1@(action)) (_)))) = happyDrop k (HappyCons (st) (sts))
- drop_stk = happyDropStk k stk
+ case happyDrop k (HappyCons (st) (sts)) of
+ sts1@((HappyCons (st1@(action)) (_))) ->
+ let drop_stk = happyDropStk k stk in
+ happyThen1 (fn stk tk) (\r -> happyGoto nt j tk st1 sts1 (r `HappyStk` drop_stk))
happyMonad2Reduce k nt fn 0# tk st sts stk
= happyFail 0# tk st sts stk
happyMonad2Reduce k nt fn j tk st sts stk =
- happyThen1 (fn stk tk) (\r -> happyNewToken new_state sts1 (r `HappyStk` drop_stk))
- where (sts1@((HappyCons (st1@(action)) (_)))) = happyDrop k (HappyCons (st) (sts))
- drop_stk = happyDropStk k stk
+ case happyDrop k (HappyCons (st) (sts)) of
+ sts1@((HappyCons (st1@(action)) (_))) ->
+ let drop_stk = happyDropStk k stk
- (off) = indexShortOffAddr happyGotoOffsets st1
- (off_i) = (off Happy_GHC_Exts.+# nt)
- (new_state) = indexShortOffAddr happyTable off_i
+ off = indexShortOffAddr happyGotoOffsets st1
+ off_i = (off Happy_GHC_Exts.+# nt)
+ new_state = indexShortOffAddr happyTable off_i
+ in
+ happyThen1 (fn stk tk) (\r -> happyNewToken new_state sts1 (r `HappyStk` drop_stk))
happyDrop 0# l = l
happyDrop n (HappyCons (_) (t)) = happyDrop (n Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#)) t
@@ -1043,9 +1059,9 @@
happyGoto nt j tk st =
{- nothing -}
happyDoAction j tk new_state
- where (off) = indexShortOffAddr happyGotoOffsets st
- (off_i) = (off Happy_GHC_Exts.+# nt)
- (new_state) = indexShortOffAddr happyTable off_i
+ where off = indexShortOffAddr happyGotoOffsets st
+ off_i = (off Happy_GHC_Exts.+# nt)
+ new_state = indexShortOffAddr happyTable off_i
@@ -1055,8 +1071,8 @@
-- parse error if we are in recovery and we fail again
happyFail 0# tk old_st _ stk@(x `HappyStk` _) =
- let (i) = (case Happy_GHC_Exts.unsafeCoerce# x of { (Happy_GHC_Exts.I# (i)) -> i }) in
--- trace "failing" $
+ let i = (case Happy_GHC_Exts.unsafeCoerce# x of { (Happy_GHC_Exts.I# (i)) -> i }) in
+-- trace "failing" $
happyError_ i tk
{- We don't need state discarding for our restricted implementation of
@@ -1065,16 +1081,16 @@
-- discard a state
happyFail 0# tk old_st (HappyCons ((action)) (sts))
- (saved_tok `HappyStk` _ `HappyStk` stk) =
--- trace ("discarding state, depth " ++ show (length stk)) $
- happyDoAction 0# tk action sts ((saved_tok`HappyStk`stk))
+ (saved_tok `HappyStk` _ `HappyStk` stk) =
+-- trace ("discarding state, depth " ++ show (length stk)) $
+ happyDoAction 0# tk action sts ((saved_tok`HappyStk`stk))
-}
-- Enter error recovery: generate an error token,
-- save the old token and carry on.
happyFail i tk (action) sts stk =
-- trace "entering error recovery" $
- happyDoAction 0# tk action sts ( (Happy_GHC_Exts.unsafeCoerce# (Happy_GHC_Exts.I# (i))) `HappyStk` stk)
+ happyDoAction 0# tk action sts ( (Happy_GHC_Exts.unsafeCoerce# (Happy_GHC_Exts.I# (i))) `HappyStk` stk)
-- Internal happy errors:
@@ -1092,9 +1108,9 @@
-----------------------------------------------------------------------------
-- Seq-ing. If the --strict flag is given, then Happy emits
--- happySeq = happyDoSeq
+-- happySeq = happyDoSeq
-- otherwise it emits
--- happySeq = happyDontSeq
+-- happySeq = happyDontSeq
happyDoSeq, happyDontSeq :: a -> b -> b
happyDoSeq a b = a `seq` b
diff --git a/dist/build/alex/alex-tmp/Scan.hs b/dist/build/alex/alex-tmp/Scan.hs
--- a/dist/build/alex/alex-tmp/Scan.hs
+++ b/dist/build/alex/alex-tmp/Scan.hs
@@ -225,11 +225,22 @@
-- -----------------------------------------------------------------------------
-- INTERNALS and main scanner engine
-{-# LINE 35 "templates/GenericTemplate.hs" #-}
+{-# LINE 21 "templates/GenericTemplate.hs" #-}
-{-# LINE 45 "templates/GenericTemplate.hs" #-}
+
+
+#if __GLASGOW_HASKELL__ > 706
+#define GTE(n,m) (tagToEnum# (n >=# m))
+#define EQ(n,m) (tagToEnum# (n ==# m))
+#else
+#define GTE(n,m) (n >=# m)
+#define EQ(n,m) (n ==# m)
+#endif
+{-# LINE 50 "templates/GenericTemplate.hs" #-}
+
+
data AlexAddr = AlexA# Addr#
#if __GLASGOW_HASKELL__ < 503
@@ -346,7 +357,7 @@
offset = (base +# ord_c)
check = alexIndexInt16OffAddr alex_check offset
- new_s = if (offset >=# 0#) && (check ==# ord_c)
+ new_s = if GTE(offset,0#) && EQ(check,ord_c)
then alexIndexInt16OffAddr alex_table offset
else alexIndexInt16OffAddr alex_deflt s
in
diff --git a/doc/alex.xml b/doc/alex.xml
--- a/doc/alex.xml
+++ b/doc/alex.xml
@@ -1208,11 +1208,7 @@
:: user -- predicate state
-> AlexInput -- The current input
-> Int -- The "start code"
- -> Maybe ( -- Nothing on error or EOF
- AlexInput, -- The remaining input
- Int, -- Length of this token
- action -- The action (an unknown type)
- )
+ -> AlexReturn action
The extra argument, of some type user,
is passed to each predicate.
@@ -1602,7 +1598,7 @@
import qualified Data.ByteString.Lazy as ByteString
-ata AlexState = AlexState {
+data AlexState = AlexState {
alex_pos :: !AlexPosn, -- position at current input location
alex_inp :: ByteString.ByteString, -- the current input
alex_chr :: !Char, -- the character before the input
diff --git a/src/CharSet.hs b/src/CharSet.hs
--- a/src/CharSet.hs
+++ b/src/CharSet.hs
@@ -126,7 +126,9 @@
charRangeToCharSpan :: Bool -> Range Char -> Maybe (Span Char)
charRangeToCharSpan _ (Range BoundaryAboveAll _) = Nothing
+charRangeToCharSpan _ (Range (BoundaryAbove c) _) | c == maxBound = Nothing
charRangeToCharSpan _ (Range _ BoundaryBelowAll) = Nothing
+charRangeToCharSpan _ (Range _ (BoundaryBelow c)) | c == minBound = Nothing
charRangeToCharSpan uni (Range x y) = Just (Span (l x) (h y))
where l b = case b of
BoundaryBelowAll -> '\0'
diff --git a/templates/wrappers.hs b/templates/wrappers.hs
--- a/templates/wrappers.hs
+++ b/templates/wrappers.hs
@@ -75,6 +75,9 @@
Char, -- previous char
ByteString.ByteString) -- current input string
+ignorePendingBytes :: AlexInput -> AlexInput
+ignorePendingBytes i = i -- no pending bytes when lexing bytestrings
+
alexInputPrevChar :: AlexInput -> Char
alexInputPrevChar (p,c,s) = c
@@ -293,7 +296,7 @@
alexSetStartCode sc = Alex $ \s -> Right (s{alex_scd=sc}, ())
alexMonadScan = do
- inp <- alexGetInput
+ inp@(_,_,str) <- alexGetInput
sc <- alexGetStartCode
case alexScan inp sc of
AlexEOF -> alexEOF
@@ -301,9 +304,11 @@
AlexSkip inp' len -> do
alexSetInput inp'
alexMonadScan
- AlexToken inp' len action -> do
+ AlexToken inp'@(_,_,str') len action -> do
alexSetInput inp'
action (ignorePendingBytes inp) len
+ where
+ len = ByteString.length str - ByteString.length str'
-- -----------------------------------------------------------------------------
-- Useful token actions
@@ -366,8 +371,8 @@
AlexEOF -> []
AlexError _ -> error "lexical error"
AlexSkip inp' len -> go inp'
- AlexToken inp' len act -> act (ByteString.take (fromIntegral len) str) : go inp'
-
+ AlexToken inp'@(_,str') _ act -> act (ByteString.take len str) : go inp'
+ where len = ByteString.length str - ByteString.length str'
#endif
@@ -380,7 +385,8 @@
AlexEOF -> []
AlexError _ -> error "lexical error"
AlexSkip inp' len -> go inp'
- AlexToken inp' len act -> act (ByteString.unsafeTake len str) : go inp'
+ AlexToken inp'@(AlexInput _ str') _ act -> act (ByteString.unsafeTake len str) : go inp'
+ where len = ByteString.length str - ByteString.length str'
#endif
diff --git a/tests/Makefile b/tests/Makefile
--- a/tests/Makefile
+++ b/tests/Makefile
@@ -10,7 +10,7 @@
HS_PROG_EXT = .bin
endif
-TESTS = unicode.x simple.x tokens.x tokens_posn.x tokens_gscan.x tokens_bytestring.x tokens_posn_bytestring.x tokens_strict_bytestring.x
+TESTS = unicode.x simple.x tokens.x tokens_posn.x tokens_gscan.x tokens_bytestring.x tokens_posn_bytestring.x tokens_strict_bytestring.x tokens_monad_bytestring.x tokens_monadUserState_bytestring.x null.x tokens_bytestring_unicode.x
TEST_ALEX_OPTS = --template=..
@@ -20,9 +20,6 @@
%.g.hs : %.x
$(ALEX) $(TEST_ALEX_OPTS) -g $< -o $@
-%.o : %.hs
- $(HC) $(HC_OPTS) -c -o $@ $<
-
CLEAN_FILES += *.n.hs *.g.hs *.info *.hi *.o *.bin *.exe
ALL_TEST_HS = $(shell echo $(TESTS) | sed -e 's/\([^\. ]*\)\.\(l\)\{0,1\}x/\1.n.hs \1.g.hs/g')
@@ -32,7 +29,7 @@
%.run : %$(HS_PROG_EXT)
./$<
-%$(HS_PROG_EXT) : %.o
+%$(HS_PROG_EXT) : %.hs
$(HC) $(HC_OPTS) -package array -package bytestring $($*_LD_OPTS) $< -o $@
all :: $(ALL_TESTS)
diff --git a/tests/null.x b/tests/null.x
new file mode 100644
--- /dev/null
+++ b/tests/null.x
@@ -0,0 +1,71 @@
+{
+-- Tests the basic operation.
+module Main where
+
+import Data.Char (toUpper)
+import Control.Monad
+import System.Exit
+import System.IO
+import Prelude hiding (null)
+}
+
+%wrapper "monad"
+
+@word = [A-Za-z]+
+@null = \0
+
+$escchars = [abfnrtv\\"\'&]
+@escape = \\ ($escchars | \0)
+@gap = \\ $white+ \\
+@string = $printable # [\"] | " " | @escape | @gap
+
+@inComment = ([^\*] | $white)+ | ([\*]+ ([\x00-\xff] # [\/]))
+
+tokens :-
+
+$white+ ;
+
+<0> {
+ @null { null }
+ @word { word }
+ \" @string \" { string }
+ "--" @inComment \n { word }
+}
+
+{
+{- we can now have comments in source code? -}
+word (p,_,_,input) len = return (take len input)
+
+null (p,_,_,input) len = return "\0"
+
+string (p,_,_,input) len = return (drop 1 (reverse (drop 1 (reverse input))))
+
+alexEOF = return "stopped."
+
+scanner str = runAlex str $ do
+ let loop = do tok <- alexMonadScan
+ if tok == "stopped." || tok == "error."
+ then return [tok]
+ else do toks <- loop
+ return (tok:toks)
+ loop
+
+main = do
+ let test1 = scanner str1
+ when (test1 /= out1) $
+ do hPutStrLn stderr "Test 1 failed:"
+ print test1
+ exitFailure
+
+ let test2 = scanner str2
+ when (test2 /= out2) $
+ do hPutStrLn stderr "Test 2 failed:"
+ print test2
+ exitFailure
+
+str1 = "a\0bb\0ccc\0\0\"\\\0\""
+out1 = Right ["a","\NUL","bb","\NUL","ccc","\NUL","\NUL","\\\NUL", "stopped."]
+
+str2 = "."
+out2 = Left "lexical error at line 1, column 1"
+}
diff --git a/tests/tokens_monadUserState_bytestring.x b/tests/tokens_monadUserState_bytestring.x
new file mode 100644
--- /dev/null
+++ b/tests/tokens_monadUserState_bytestring.x
@@ -0,0 +1,63 @@
+{
+{-# LANGUAGE OverloadedStrings #-}
+module Main (main) where
+import System.Exit
+import qualified Data.ByteString.Lazy.Char8 as B
+}
+
+%wrapper "monadUserState-bytestring"
+
+$digit = 0-9 -- digits
+$alpha = [a-zA-Z] -- alphabetic characters
+
+tokens :-
+
+ $white+ ;
+ "--".* ;
+ let { tok (\p s -> Let p) }
+ in { tok (\p s -> In p) }
+ $digit+ { tok (\p s -> Int p (read (B.unpack s))) }
+ [\=\+\-\*\/\(\)] { tok (\p s -> Sym p (head (B.unpack s))) }
+ $alpha [$alpha $digit \_ \']* { tok (\p s -> Var p (B.unpack s)) }
+
+{
+-- Each right-hand side has type :: AlexPosn -> String -> Token
+
+-- Some action helpers:
+tok f (p,_,input) len = return (f p (B.take (fromIntegral len) input))
+
+-- The token type:
+data Token =
+ Let AlexPosn |
+ In AlexPosn |
+ Sym AlexPosn Char |
+ Var AlexPosn String |
+ Int AlexPosn Int |
+ Err AlexPosn |
+ EOF
+ deriving (Eq,Show)
+
+alexEOF = return EOF
+
+main = if test1 /= result1 then do print test1; exitFailure
+ else exitWith ExitSuccess
+
+type AlexUserState = ()
+alexInitUserState = ()
+
+scanner str = runAlex str $ do
+ let loop = do tok <- alexMonadScan
+ if tok == EOF
+ then return [tok]
+ else do toks <- loop
+ return (tok:toks)
+ loop
+
+test1 = case scanner " let in 012334\n=+*foo bar__'" of
+ Left err -> error err
+ Right toks -> toks
+
+result1 = [Let (AlexPn 2 1 3),In (AlexPn 6 1 7),Int (AlexPn 9 1 10) 12334,Sym (AlexPn 16 2 1) '=',Sym (AlexPn 17 2 2) '+',Sym (AlexPn 18 2 3) '*',Var (AlexPn 19 2 4) "foo",Var (AlexPn 23 2 8) "bar__'", EOF]
+
+
+}
diff --git a/tests/tokens_monad_bytestring.x b/tests/tokens_monad_bytestring.x
new file mode 100644
--- /dev/null
+++ b/tests/tokens_monad_bytestring.x
@@ -0,0 +1,60 @@
+{
+{-# LANGUAGE OverloadedStrings #-}
+module Main (main) where
+import System.Exit
+import qualified Data.ByteString.Lazy.Char8 as B
+}
+
+%wrapper "monad-bytestring"
+
+$digit = 0-9 -- digits
+$alpha = [a-zA-Z] -- alphabetic characters
+
+tokens :-
+
+ $white+ ;
+ "--".* ;
+ let { tok (\p s -> Let p) }
+ in { tok (\p s -> In p) }
+ $digit+ { tok (\p s -> Int p (read (B.unpack s))) }
+ [\=\+\-\*\/\(\)] { tok (\p s -> Sym p (head (B.unpack s))) }
+ $alpha [$alpha $digit \_ \']* { tok (\p s -> Var p (B.unpack s)) }
+
+{
+-- Each right-hand side has type :: AlexPosn -> String -> Token
+
+-- Some action helpers:
+tok f (p,_,input) len = return (f p (B.take (fromIntegral len) input))
+
+-- The token type:
+data Token =
+ Let AlexPosn |
+ In AlexPosn |
+ Sym AlexPosn Char |
+ Var AlexPosn String |
+ Int AlexPosn Int |
+ Err AlexPosn |
+ EOF
+ deriving (Eq,Show)
+
+alexEOF = return EOF
+
+main = if test1 /= result1 then do print test1; exitFailure
+ else exitWith ExitSuccess
+
+scanner str = runAlex str $ do
+ let loop = do tok <- alexMonadScan
+ if tok == EOF
+ then return [tok]
+ else do toks <- loop
+ return (tok:toks)
+ loop
+
+test1 = case scanner " let in 012334\n=+*foo bar__'" of
+ Left err -> error err
+ Right toks -> toks
+
+result1 = [Let (AlexPn 2 1 3),In (AlexPn 6 1 7),Int (AlexPn 9 1 10) 12334,Sym (AlexPn 16 2 1) '=',Sym (AlexPn 17 2 2) '+',Sym (AlexPn 18 2 3) '*',Var (AlexPn 19 2 4) "foo",Var (AlexPn 23 2 8) "bar__'", EOF]
+
+
+}