alex 3.3.0.0 → 3.4.0.0
raw patch · 18 files changed
+555/−125 lines, 18 files
Files
- CHANGELOG.md +10/−0
- alex.cabal +7/−4
- data/AlexWrappers.hs +191/−29
- src/AbsSyn.hs +32/−23
- src/DFA.hs +13/−13
- src/DFAMin.hs +1/−1
- src/DFS.hs +1/−1
- src/Info.hs +3/−3
- src/Main.hs +21/−12
- src/Map.hs +1/−1
- src/NFA.hs +16/−16
- src/Output.hs +18/−18
- src/Set.hs +1/−1
- src/UTF8.hs +1/−1
- tests/Makefile +17/−2
- tests/posn_typeclass_strict_text.x +79/−0
- tests/strict_text_typeclass.x +79/−0
- tests/tokens_monadUserState_strict_text.x +64/−0
CHANGELOG.md view
@@ -1,3 +1,13 @@+## Changes in 3.4.0.0++ * New wrappers to lex strict `Text`:+ `strict-text`, `posn-strict-text`, `monad-strict-text` and `monadUserState-strict-text`+ (PR [#240](https://github.com/haskell/alex/pull/240)).+ These complement the existing wrappers for `String` and `ByteString`.+ * Tested with GHC 7.0 - 9.6.2.++_Andreas Abel, 2023-06-20_+ ## Changes in 3.3.0.0 * Add an `Ord` instance to `AlexPosn` (Issue [#233](https://github.com/haskell/alex/issues/233)).
alex.cabal view
@@ -1,12 +1,12 @@ cabal-version: >= 1.10 name: alex-version: 3.3.0.0+version: 3.4.0.0 -- don't forget updating changelog.md! license: BSD3 license-file: LICENSE copyright: (c) Chis Dornan, Simon Marlow author: Chris Dornan and Simon Marlow-maintainer: Simon Marlow <marlowsd@gmail.com>+maintainer: https://github.com/haskell/alex bug-reports: https://github.com/haskell/alex/issues stability: stable homepage: http://www.haskell.org/alex/@@ -22,9 +22,9 @@ build-type: Simple tested-with:- GHC == 9.6.1+ GHC == 9.6.2 GHC == 9.4.5- GHC == 9.2.7+ GHC == 9.2.8 GHC == 9.0.2 GHC == 8.10.7 GHC == 8.8.4@@ -92,6 +92,9 @@ tests/issue_119.x tests/issue_141.x tests/issue_197.x+ tests/strict_text_typeclass.x+ tests/posn_typeclass_strict_text.x+ tests/tokens_monadUserState_strict_text.x source-repository head type: git
data/AlexWrappers.hs view
@@ -4,11 +4,16 @@ -- This code is in the PUBLIC DOMAIN; you may copy it freely and use -- it for any purpose whatsoever. -#if defined(ALEX_MONAD) || defined(ALEX_MONAD_BYTESTRING)+#if defined(ALEX_MONAD) || defined(ALEX_MONAD_BYTESTRING) || defined(ALEX_MONAD_STRICT_TEXT) import Control.Applicative as App (Applicative (..)) #endif +#if defined(ALEX_STRICT_TEXT) || defined (ALEX_POSN_STRICT_TEXT) || defined(ALEX_MONAD_STRICT_TEXT)+import qualified Data.Text+#endif+ import Data.Word (Word8)+ #if defined(ALEX_BASIC_BYTESTRING) || defined(ALEX_POSN_BYTESTRING) || defined(ALEX_MONAD_BYTESTRING) import Data.Int (Int64)@@ -82,6 +87,50 @@ (b, bs) -> p' `seq` Just (b, (p', c, bs, s)) #endif +#if defined (ALEX_STRICT_TEXT)+type AlexInput = (Char, -- previous char+ [Byte], -- pending bytes on current char+ Data.Text.Text) -- current input string++ignorePendingBytes :: AlexInput -> AlexInput+ignorePendingBytes (c,_ps,s) = (c,[],s)++alexInputPrevChar :: AlexInput -> Char+alexInputPrevChar (c,_bs,_s) = c++alexGetByte :: AlexInput -> Maybe (Byte,AlexInput)+alexGetByte (c,(b:bs),s) = Just (b,(c,bs,s))+alexGetByte (_,[],s) = case Data.Text.uncons s of+ Just (c, cs) ->+ case utf8Encode' c of+ (b, bs) -> Just (b, (c, bs, cs))+ Nothing ->+ Nothing+#endif++#if defined (ALEX_POSN_STRICT_TEXT) || defined(ALEX_MONAD_STRICT_TEXT)+type AlexInput = (AlexPosn, -- current position,+ Char, -- previous char+ [Byte], -- pending bytes on current char+ Data.Text.Text) -- current input string++ignorePendingBytes :: AlexInput -> AlexInput+ignorePendingBytes (p,c,_ps,s) = (p,c,[],s)++alexInputPrevChar :: AlexInput -> Char+alexInputPrevChar (_p,c,_bs,_s) = c++alexGetByte :: AlexInput -> Maybe (Byte,AlexInput)+alexGetByte (p,c,(b:bs),s) = Just (b,(p,c,bs,s))+alexGetByte (p,_,[],s) = case Data.Text.uncons s of+ Just (c, cs) ->+ let p' = alexMove p c+ in case utf8Encode' c of+ (b, bs) -> p' `seq` Just (b, (p', c, bs, cs))+ Nothing ->+ Nothing+#endif+ #if defined(ALEX_POSN_BYTESTRING) || defined(ALEX_MONAD_BYTESTRING) type AlexInput = (AlexPosn, -- current position, Char, -- previous char@@ -151,7 +200,7 @@ -- `move_pos' calculates the new position after traversing a given character, -- assuming the usual eight character tab stops. -#if defined(ALEX_POSN) || defined(ALEX_MONAD) || defined(ALEX_POSN_BYTESTRING) || defined(ALEX_MONAD_BYTESTRING) || defined(ALEX_GSCAN)+#if defined(ALEX_POSN) || defined(ALEX_MONAD) || defined(ALEX_POSN_BYTESTRING) || defined(ALEX_MONAD_BYTESTRING) || defined(ALEX_GSCAN) || defined (ALEX_POSN_STRICT_TEXT) || defined(ALEX_MONAD_STRICT_TEXT) data AlexPosn = AlexPn !Int !Int !Int deriving (Eq, Show, Ord) @@ -167,14 +216,20 @@ -- ----------------------------------------------------------------------------- -- Monad (default and with ByteString input) -#if defined(ALEX_MONAD) || defined(ALEX_MONAD_BYTESTRING)+#if defined(ALEX_MONAD) || defined(ALEX_MONAD_BYTESTRING) || defined(ALEX_MONAD_STRICT_TEXT) data AlexState = AlexState { alex_pos :: !AlexPosn, -- position at current input location-#ifndef ALEX_MONAD_BYTESTRING+#ifdef ALEX_MONAD_STRICT_TEXT+ alex_inp :: Data.Text.Text,+ alex_chr :: !Char,+ alex_bytes :: [Byte],+#endif /* ALEX_MONAD_STRICT_TEXT */+#ifdef ALEX_MONAD alex_inp :: String, -- the current input alex_chr :: !Char, -- the character before the input alex_bytes :: [Byte],-#else /* ALEX_MONAD_BYTESTRING */+#endif /* ALEX_MONAD */+#ifdef ALEX_MONAD_BYTESTRING alex_bpos:: !Int64, -- bytes consumed so far alex_inp :: ByteString.ByteString, -- the current input alex_chr :: !Char, -- the character before the input@@ -187,15 +242,24 @@ -- Compile with -funbox-strict-fields for best results! -#ifndef ALEX_MONAD_BYTESTRING+#ifdef ALEX_MONAD runAlex :: String -> Alex a -> Either String a runAlex input__ (Alex f) = case f (AlexState {alex_bytes = [],-#else /* ALEX_MONAD_BYTESTRING */+ alex_pos = alexStartPos,+ alex_inp = input__,+ alex_chr = '\n',+#ifdef ALEX_MONAD_USER_STATE+ alex_ust = alexInitUserState,+#endif+ alex_scd = 0}) of Left msg -> Left msg+ Right ( _, a ) -> Right a+#endif++#ifdef ALEX_MONAD_BYTESTRING runAlex :: ByteString.ByteString -> Alex a -> Either String a runAlex input__ (Alex f) = case f (AlexState {alex_bpos = 0,-#endif /* ALEX_MONAD_BYTESTRING */ alex_pos = alexStartPos, alex_inp = input__, alex_chr = '\n',@@ -204,7 +268,22 @@ #endif alex_scd = 0}) of Left msg -> Left msg Right ( _, a ) -> Right a+#endif +#ifdef ALEX_MONAD_STRICT_TEXT+runAlex :: Data.Text.Text -> Alex a -> Either String a+runAlex input__ (Alex f)+ = case f (AlexState {alex_bytes = [],+ alex_pos = alexStartPos,+ alex_inp = input__,+ alex_chr = '\n',+#ifdef ALEX_MONAD_USER_STATE+ alex_ust = alexInitUserState,+#endif+ alex_scd = 0}) of Left msg -> Left msg+ Right ( _, a ) -> Right a+#endif+ newtype Alex a = Alex { unAlex :: AlexState -> Either String (AlexState, a) } instance Functor Alex where@@ -226,29 +305,52 @@ Right (s',a) -> unAlex (k a) s' return = App.pure ++#ifdef ALEX_MONAD alexGetInput :: Alex AlexInput alexGetInput-#ifndef ALEX_MONAD_BYTESTRING = Alex $ \s@AlexState{alex_pos=pos,alex_chr=c,alex_bytes=bs,alex_inp=inp__} -> Right (s, (pos,c,bs,inp__))-#else /* ALEX_MONAD_BYTESTRING */+#endif++#ifdef ALEX_MONAD_BYTESTRING+alexGetInput :: Alex AlexInput+alexGetInput = Alex $ \s@AlexState{alex_pos=pos,alex_bpos=bpos,alex_chr=c,alex_inp=inp__} -> Right (s, (pos,c,inp__,bpos))-#endif /* ALEX_MONAD_BYTESTRING */+#endif +#ifdef ALEX_MONAD_STRICT_TEXT+alexGetInput :: Alex AlexInput+alexGetInput+ = Alex $ \s@AlexState{alex_pos=pos,alex_chr=c,alex_bytes=bs,alex_inp=inp__} ->+ Right (s, (pos,c,bs,inp__))+#endif++#ifdef ALEX_MONAD alexSetInput :: AlexInput -> Alex ()-#ifndef ALEX_MONAD_BYTESTRING alexSetInput (pos,c,bs,inp__) = Alex $ \s -> case s{alex_pos=pos,alex_chr=c,alex_bytes=bs,alex_inp=inp__} of-#else /* ALEX_MONAD_BYTESTRING */+ state__@(AlexState{}) -> Right (state__, ())+#endif++#ifdef ALEX_MONAD_BYTESTRING+alexSetInput :: AlexInput -> Alex () alexSetInput (pos,c,inp__,bpos) = Alex $ \s -> case s{alex_pos=pos, alex_bpos=bpos, alex_chr=c, alex_inp=inp__} of-#endif /* ALEX_MONAD_BYTESTRING */- state__@(AlexState{}) -> Right (state__, ())+ state__@(AlexState{}) -> Right (state__, ())+#endif +#ifdef ALEX_MONAD_STRICT_TEXT+alexSetInput :: AlexInput -> Alex ()+alexSetInput (pos,c,bs,inp__)+ = Alex $ \s -> case s{alex_pos=pos,alex_chr=c,alex_bytes=bs,alex_inp=inp__} of+ state__@(AlexState{}) -> Right (state__, ())+#endif+ alexError :: String -> Alex a alexError message = Alex $ const $ Left message @@ -266,12 +368,9 @@ alexSetUserState ss = Alex $ \s -> Right (s{alex_ust=ss}, ()) #endif /* !defined(ALEX_MONAD_BYTESTRING) && defined(ALEX_MONAD_USER_STATE) */ +#ifdef ALEX_MONAD alexMonadScan = do-#ifndef ALEX_MONAD_BYTESTRING inp__ <- alexGetInput-#else /* ALEX_MONAD_BYTESTRING */- inp__@(_,_,_,n) <- alexGetInput-#endif /* ALEX_MONAD_BYTESTRING */ sc <- alexGetStartCode case alexScan inp__ sc of AlexEOF -> alexEOF@@ -279,23 +378,56 @@ AlexSkip inp__' _len -> do alexSetInput inp__' alexMonadScan-#ifndef ALEX_MONAD_BYTESTRING AlexToken inp__' len action -> do-#else /* ALEX_MONAD_BYTESTRING */+ alexSetInput inp__'+ action (ignorePendingBytes inp__) len+#endif++#ifdef ALEX_MONAD_BYTESTRING+alexMonadScan = do+ inp__@(_,_,_,n) <- alexGetInput+ sc <- alexGetStartCode+ case alexScan inp__ sc of+ AlexEOF -> alexEOF+ AlexError ((AlexPn _ line column),_,_,_) -> alexError $ "lexical error at line " ++ (show line) ++ ", column " ++ (show column)+ AlexSkip inp__' _len -> do+ alexSetInput inp__'+ alexMonadScan AlexToken inp__'@(_,_,_,n') _ action -> let len = n'-n in do-#endif /* ALEX_MONAD_BYTESTRING */ alexSetInput inp__' action (ignorePendingBytes inp__) len+#endif +#ifdef ALEX_MONAD_STRICT_TEXT+alexMonadScan = do+ inp__ <- alexGetInput+ sc <- alexGetStartCode+ case alexScan inp__ sc of+ AlexEOF -> alexEOF+ AlexError ((AlexPn _ line column),_,_,_) -> alexError $ "lexical error at line " ++ (show line) ++ ", column " ++ (show column)+ AlexSkip inp__' _len -> do+ alexSetInput inp__'+ alexMonadScan+ AlexToken inp__' len action -> do+ alexSetInput inp__'+ action (ignorePendingBytes inp__) len+#endif+ -- ----------------------------------------------------------------------------- -- Useful token actions -#ifndef ALEX_MONAD_BYTESTRING+#ifdef ALEX_MONAD type AlexAction result = AlexInput -> Int -> Alex result-#else /* ALEX_MONAD_BYTESTRING */+#endif++#ifdef ALEX_MONAD_BYTESTRING type AlexAction result = AlexInput -> Int64 -> Alex result-#endif /* ALEX_MONAD_BYTESTRING */+#endif +#ifdef ALEX_MONAD_STRICT_TEXT+type AlexAction result = AlexInput -> Int -> Alex result+#endif+ -- just ignore this token and scan another one -- skip :: AlexAction result skip _input _len = alexMonadScan@@ -310,15 +442,23 @@ alexSetStartCode code action input__ len -#ifndef ALEX_MONAD_BYTESTRING+#ifdef ALEX_MONAD token :: (AlexInput -> Int -> token) -> AlexAction token-#else /* ALEX_MONAD_BYTESTRING */+token t input__ len = return (t input__ len)+#endif++#ifdef ALEX_MONAD_BYTESTRING token :: (AlexInput -> Int64 -> token) -> AlexAction token-#endif /* ALEX_MONAD_BYTESTRING */ token t input__ len = return (t input__ len)-#endif /* defined(ALEX_MONAD) || defined(ALEX_MONAD_BYTESTRING) */+#endif +#ifdef ALEX_MONAD_STRICT_TEXT+token :: (AlexInput -> Int -> token) -> AlexAction token+token t input__ len = return (t input__ len)+#endif +#endif /* defined(ALEX_MONAD) || defined(ALEX_MONAD_BYTESTRING) || defined(ALEX_MONAD_STRICT_TEXT) */+ -- ----------------------------------------------------------------------------- -- Basic wrapper @@ -376,6 +516,28 @@ let len = alexBytePos inp__' - alexBytePos inp__ in act (ByteString.take len (alexStr inp__)) : go inp__' +#endif++#ifdef ALEX_STRICT_TEXT+-- alexScanTokens :: Data.Text.Text -> [token]+alexScanTokens str = go ('\n',[],str)+ where go inp__@(_,_bs,s) =+ case alexScan inp__ 0 of+ AlexEOF -> []+ AlexError _ -> error "lexical error"+ AlexSkip inp__' _len -> go inp__'+ AlexToken inp__' len act -> act (Data.Text.take len s) : go inp__'+#endif++#ifdef ALEX_POSN_STRICT_TEXT+-- alexScanTokens :: Data.Text.Text -> [token]+alexScanTokens str = go (alexStartPos,'\n',[],str)+ where go inp__@(pos,_,_bs,s) =+ case alexScan inp__ 0 of+ AlexEOF -> []+ AlexError ((AlexPn _ line column),_,_,_) -> error $ "lexical error at line " ++ (show line) ++ ", column " ++ (show column)+ AlexSkip inp__' _len -> go inp__'+ AlexToken inp__' len act -> act pos (Data.Text.take len s) : go inp__' #endif
src/AbsSyn.hs view
@@ -16,7 +16,7 @@ RECtx(..), RExp(..), nullable, DFA(..), State(..), SNum, StartCode, Accept(..),- RightContext(..), showRCtx, strtype,+ RightContext(..), showRCtx, encodeStartCodes, extractActions, Target(..), UsesPreds(..), usesPreds,@@ -49,44 +49,53 @@ | TokenType String deriving Show -data StrType = Str | Lazy | Strict+data StrType = Str | Lazy | Strict | StrictText+ deriving Eq instance Show StrType where show Str = "String" show Lazy = "ByteString.ByteString" show Strict = "ByteString.ByteString"+ show StrictText = "Data.Text.Text" data Scheme = Default { defaultTypeInfo :: Maybe (Maybe String, String) } | GScan { gscanTypeInfo :: Maybe (Maybe String, String) } | Basic { basicStrType :: StrType, basicTypeInfo :: Maybe (Maybe String, String) }- | Posn { posnByteString :: Bool,+ | Posn { posnStrType :: StrType, posnTypeInfo :: Maybe (Maybe String, String) }- | Monad { monadByteString :: Bool, monadUserState :: Bool,+ | Monad { monadStrType :: StrType,+ monadUserState :: Bool, monadTypeInfo :: Maybe (Maybe String, String) } -strtype :: Bool -> String-strtype True = "ByteString.ByteString"-strtype False = "String"-- wrapperCppDefs :: Scheme -> Maybe [String] wrapperCppDefs Default {} = Nothing wrapperCppDefs GScan {} = Just ["ALEX_GSCAN"] wrapperCppDefs Basic { basicStrType = Str } = Just ["ALEX_BASIC"] wrapperCppDefs Basic { basicStrType = Lazy } = Just ["ALEX_BASIC_BYTESTRING"] wrapperCppDefs Basic { basicStrType = Strict } = Just ["ALEX_STRICT_BYTESTRING"]-wrapperCppDefs Posn { posnByteString = False } = Just ["ALEX_POSN"]-wrapperCppDefs Posn { posnByteString = True } = Just ["ALEX_POSN_BYTESTRING"]-wrapperCppDefs Monad { monadByteString = False,+wrapperCppDefs Basic { basicStrType = StrictText } = Just ["ALEX_STRICT_TEXT"]+wrapperCppDefs Posn { posnStrType = Str } = Just ["ALEX_POSN"]+wrapperCppDefs Posn { posnStrType = Lazy } = Just ["ALEX_POSN_BYTESTRING"]+wrapperCppDefs Posn { posnStrType = Strict } = Just ["ALEX_POSN_BYTESTRING"]+wrapperCppDefs Posn { posnStrType = StrictText } = Just ["ALEX_POSN_STRICT_TEXT"]+wrapperCppDefs Monad { monadStrType = Str, monadUserState = False } = Just ["ALEX_MONAD"]-wrapperCppDefs Monad { monadByteString = True,+wrapperCppDefs Monad { monadStrType = Strict, monadUserState = False } = Just ["ALEX_MONAD_BYTESTRING"]-wrapperCppDefs Monad { monadByteString = False,+wrapperCppDefs Monad { monadStrType = Lazy,+ monadUserState = False } = Just ["ALEX_MONAD_BYTESTRING"]+wrapperCppDefs Monad { monadStrType = StrictText,+ monadUserState = False } = Just ["ALEX_MONAD_STRICT_TEXT"]+wrapperCppDefs Monad { monadStrType = Str, monadUserState = True } = Just ["ALEX_MONAD", "ALEX_MONAD_USER_STATE"]-wrapperCppDefs Monad { monadByteString = True,+wrapperCppDefs Monad { monadStrType = Strict, monadUserState = True } = Just ["ALEX_MONAD_BYTESTRING", "ALEX_MONAD_USER_STATE"]+wrapperCppDefs Monad { monadStrType = Lazy,+ monadUserState = True } = Just ["ALEX_MONAD_BYTESTRING", "ALEX_MONAD_USER_STATE"]+wrapperCppDefs Monad { monadStrType = StrictText,+ monadUserState = True } = Just ["ALEX_MONAD_STRICT_TEXT", "ALEX_MONAD_USER_STATE"] -- TODO: update this comment --@@ -369,25 +378,25 @@ basicTypeInfo = Just (Just tyclasses, tokenty) } -> nl . str fun . str " :: (" . str tyclasses . str ") => " . str (show strty) . str " -> " . str tokenty . nl- Posn { posnByteString = isByteString,+ Posn { posnStrType = strty, posnTypeInfo = Just (Nothing, tokenty) } -> nl .- str fun . str " :: AlexPosn -> " . str (strtype isByteString) . str " -> "+ str fun . str " :: AlexPosn -> " . str (show strty) . str " -> " . str tokenty . nl- Posn { posnByteString = isByteString,+ Posn { posnStrType = strty, posnTypeInfo = Just (Just tyclasses, tokenty) } -> nl . str fun . str " :: (" . str tyclasses . str ") => AlexPosn -> " .- str (strtype isByteString) . str " -> " . str tokenty . nl- Monad { monadByteString = isByteString,+ str (show strty) . str " -> " . str tokenty . nl+ Monad { monadStrType = strty, monadTypeInfo = Just (Nothing, tokenty) } -> nl . let- actintty = if isByteString then "Int64" else "Int"+ actintty = if strty == Lazy then "Int64" else "Int" in str fun . str " :: AlexInput -> " . str actintty . str " -> Alex (" . str tokenty . str ")" . nl- Monad { monadByteString = isByteString,+ Monad { monadStrType = strty, monadTypeInfo = Just (Just tyclasses, tokenty) } -> nl . let- actintty = if isByteString then "Int64" else "Int"+ actintty = if strty == Lazy then "Int64" else "Int" in str fun . str " :: (" . str tyclasses . str ") =>" . str " AlexInput -> " . str actintty
src/DFA.hs view
@@ -1,12 +1,12 @@ -- -------------------------------------------------------------------------------- +-- -- DFA.hs, part of Alex -- -- (c) Chris Dornan 1995-2000, Simon Marlow 2003 -- -- This module generates a DFA from a scanner by first converting it -- to an NFA and then converting the NFA with the subset construction.--- +-- -- See the chapter on `Finite Automata and Lexical Analysis' in the -- dragon book for an excellent overview of the algorithms in this -- module.@@ -29,31 +29,31 @@ -- (This section should logically belong to the DFA module but it has been -- placed here to make this module self-contained.)--- +-- -- `DFA' provides an alternative to `Scanner' (described in the RExp module); -- it can be used directly to scan text efficiently. Additionally it has an -- extra place holder for holding action functions for generating -- application-specific tokens. When this place holder is not being used, the -- unit type will be used.--- +-- -- Each state in the automaton consist of a list of `Accept' values, descending -- in priority, and an array mapping characters to new states. As the array -- may only cover a sub-range of the characters, a default state number is -- given in the third field. By convention, all transitions to the -1 state -- represent invalid transitions.--- +-- -- A list of accept states is provided for as the original specification may -- have been ambiguous, in which case the highest priority token should be -- taken (the one appearing earliest in the specification); this can not be -- calculated when the DFA is generated in all cases as some of the tokens may -- be associated with leading or trailing context or start codes.--- +-- -- `scan_token' (see above) can deal with unconditional accept states more -- efficiently than those associated with context; to save it testing each time -- whether the list of accept states contains an unconditional state, the flag -- in the first field of `St' is set to true whenever the list contains an -- unconditional state.--- +-- -- The `Accept' structure contains the priority of the token being accepted -- (lower numbers => higher priorities), the name of the token, a place holder -- that can be used for storing the `action' function for constructing the@@ -61,7 +61,7 @@ -- (listing the start codes that the scanner must be in for the token to be -- accepted; empty => no restriction), the leading and trailing context (both -- `Nothing' if there is none).--- +-- -- The leading context consists simply of a character predicate that will -- return true if the last character read is acceptable. The trailing context -- consists of an alternative starting state within the DFA; if this `sub-dfa'@@ -185,10 +185,10 @@ mk_int_dfa:: NFA -> DFA StateSet a -> DFA SNum a mk_int_dfa nfa (DFA start_states mp)- = DFA [0 .. length start_states-1] + = DFA [0 .. length start_states-1] (Map.fromList [ (lookup' st, cnv pds) | (st, pds) <- Map.toAscList mp ]) where- mp' = Map.fromList (zip (start_states ++ + mp' = Map.fromList (zip (start_states ++ (map fst . Map.toAscList) (foldr Map.delete mp start_states)) [0..]) lookup' = fromJust . flip Map.lookup mp'@@ -200,9 +200,9 @@ accs' = map cnv_acc accs cnv_acc (Acc p a lctx rctx) = Acc p a lctx rctx'- where rctx' = + where rctx' = case rctx of- RightContextRExp s -> + RightContextRExp s -> RightContextRExp (lookup' (mk_ss nfa [s])) other -> other @@ -221,7 +221,7 @@ -- some initial segment of the array may be omitted) or the value that 255 maps -- to (in which case a final segment of the array may be omitted), hence the -- calculation of `(df,bds)'.--- +-- -- Note that empty arrays are avoided as they can cause severe problems for -- some popular Haskell compilers.
src/DFAMin.hs view
@@ -62,7 +62,7 @@ -- -- % The second for loop that iterates over R mutates Q, -- % but it does not affect the third for loop that iterates over Q.--- % Because once X refines Y into Y1 and Y2, Y1 and Y2 can't be more refined by X. +-- % Because once X refines Y into Y1 and Y2, Y1 and Y2 can't be more refined by X. minimizeDFA :: forall a. Ord a => DFA Int a -> DFA Int a minimizeDFA dfa@(DFA { dfa_start_states = starts,
src/DFS.hs view
@@ -91,7 +91,7 @@ scc g = dff' (reverse (top_sort (reverse_graph g))) g top_sort:: Graph -> [Int]-top_sort = postorder . dff +top_sort = postorder . dff -- `dff' computes the depth-first forest. It works by unrolling the
src/Info.hs view
@@ -1,5 +1,5 @@ -- -------------------------------------------------------------------------------- +-- -- Info.hs, part of Alex -- -- (c) Simon Marlow 2003@@ -23,7 +23,7 @@ = str "Scanner : " . str func_nm . nl . str "States : " . shows (length dfa_list) . nl . nl . infoDFA'- where + where dfa_list = Map.toAscList (dfa_states dfa) infoDFA' = interleave_shows nl (map infoStateN dfa_list)@@ -47,7 +47,7 @@ Nothing -> id Just code -> str " { " . str code . str " }") . nl- + infoTransition (char',state) = str (ljustify 8 (show char')) . str " -> "
src/Main.hs view
@@ -290,12 +290,13 @@ (Just _, Nothing, Nothing) -> dieAlex "%typeclass directive without %token directive" | single == "basic" || single == "basic-bytestring" ||- single == "strict-bytestring" ->+ single == "strict-bytestring" || single == "strict-text" -> let strty = case single of "basic" -> Str "basic-bytestring" -> Lazy "strict-bytestring" -> Strict+ "strict-text" -> StrictText _ -> error "Impossible case" in case (typeclass, token, action) of (Nothing, Nothing, Nothing) ->@@ -311,42 +312,50 @@ dieAlex "%action directive not allowed with a wrapper" (Just _, Nothing, Nothing) -> dieAlex "%typeclass directive without %token directive"- | single == "posn" || single == "posn-bytestring" ->+ | single == "posn" || single == "posn-bytestring" || single == "posn-strict-text" -> let- isByteString = single == "posn-bytestring"+ strty = case single of+ "posn" -> Str+ "posn-bytestring" -> Strict+ "posn-strict-text" -> StrictText+ _ -> error "invalid str type for posn" in case (typeclass, token, action) of (Nothing, Nothing, Nothing) ->- return Posn { posnByteString = isByteString,+ return Posn { posnStrType = strty, posnTypeInfo = Nothing } (Nothing, Just tokenty, Nothing) ->- return Posn { posnByteString = isByteString,+ return Posn { posnStrType = strty, posnTypeInfo = Just (Nothing, tokenty) } (Just _, Just tokenty, Nothing) ->- return Posn { posnByteString = isByteString,+ return Posn { posnStrType = strty, posnTypeInfo = Just (typeclass, tokenty) } (_, _, Just _) -> dieAlex "%action directive not allowed with a wrapper" (Just _, Nothing, Nothing) -> dieAlex "%typeclass directive without %token directive"- | single == "monad" || single == "monad-bytestring" ||+ | single == "monad" || single == "monad-bytestring" || single == "monad-strict-text" || single == "monadUserState" ||- single == "monadUserState-bytestring" ->+ single == "monadUserState-bytestring" ||+ single == "monadUserState-strict-text" -> let+ isText = single == "monad-strict-text" ||+ single == "monadUserState-strict-text" isByteString = single == "monad-bytestring" || single == "monadUserState-bytestring" userState = single == "monadUserState" ||- single == "monadUserState-bytestring"+ single == "monadUserState-bytestring" ||+ single == "monadUserState-strict-text" in case (typeclass, token, action) of (Nothing, Nothing, Nothing) ->- return Monad { monadByteString = isByteString,+ return Monad { monadStrType = if isByteString then Lazy else if isText then StrictText else Str, monadUserState = userState, monadTypeInfo = Nothing } (Nothing, Just tokenty, Nothing) ->- return Monad { monadByteString = isByteString,+ return Monad { monadStrType = if isByteString then Lazy else if isText then StrictText else Str, monadUserState = userState, monadTypeInfo = Just (Nothing, tokenty) } (Just _, Just tokenty, Nothing) ->- return Monad { monadByteString = isByteString,+ return Monad { monadStrType = if isByteString then Lazy else if isText then StrictText else Str, monadUserState = userState, monadTypeInfo = Just (typeclass, tokenty) } (_, _, Just _) ->
src/Map.hs view
@@ -60,7 +60,7 @@ fromList :: Ord k => [(k,a)] -> Map k a fromList = listToFM -fromListWith :: Ord k => (a -> a -> a) -> [(k,a)] -> Map k a +fromListWith :: Ord k => (a -> a -> a) -> [(k,a)] -> Map k a fromListWith c = addListToFM_C (flip c) emptyFM toAscList :: Map k a -> [(k,a)]
src/NFA.hs view
@@ -1,5 +1,5 @@ -- -------------------------------------------------------------------------------- +-- -- NFA.hs, part of Alex -- -- (c) Chris Dornan 1995-2000, Simon Marlow 2003@@ -7,7 +7,7 @@ -- The `scanner2nfa' takes a `Scanner' (see the `RExp' module) and -- generates its equivalent nondeterministic finite automaton. NFAs -- are turned into DFAs in the DFA module.--- +-- -- See the chapter on `Finite Automata and Lexical Analysis' in the -- dragon book for an excellent overview of the algorithms in this -- module.@@ -61,7 +61,7 @@ -- (listing the start codes that the scanner must be in for the token to be -- accepted; empty => no restriction), the leading and trailing context (both -- `Nothing' if there is none).--- +-- -- The leading context consists simply of a character predicate that will -- return true if the last character read is acceptable. The trailing context -- consists of an alternative starting state within the DFA; if this `sub-dfa'@@ -84,13 +84,13 @@ -- make a start state for each start code (these will be -- numbered from zero). start_states <- sequence (replicate (length startcodes) newState)- + -- construct the NFA for each token tok_states <- zipWithM do_token toks [0..] -- make an epsilon edge from each state state to each -- token that is acceptable in that state- zipWithM_ (tok_transitions (zip toks tok_states)) + zipWithM_ (tok_transitions (zip toks tok_states)) startcodes start_states where@@ -104,7 +104,7 @@ return NoRightContext RightContextCode code' -> return (RightContextCode code')- RightContextRExp re' -> do + RightContextRExp re' -> do r_b <- newState r_e <- newState rexp2nfa r_b r_e re'@@ -123,7 +123,7 @@ -- NFA creation from a regular expression -- rexp2nfa B E R generates an NFA that begins in state B, recognises--- R, and ends in state E only if R has been recognised. +-- R, and ends in state E only if R has been recognised. rexp2nfa :: SNum -> SNum -> RExp -> NFAM () rexp2nfa b e Eps = epsilonEdge b e@@ -176,7 +176,7 @@ runNFA :: Encoding -> NFAM () -> NFA runNFA e m = case unN m 0 Map.empty e of- (s, nfa_map, ()) -> -- trace ("runNfa.." ++ show (Map.toAscList nfa_map)) $ + (s, nfa_map, ()) -> -- trace ("runNfa.." ++ show (Map.toAscList nfa_map)) $ e_close (array (0,s-1) (Map.toAscList nfa_map)) e_close:: Array Int NState -> NFA@@ -202,8 +202,8 @@ bytesEdge :: SNum -> [Byte] -> [Byte] -> SNum -> NFAM () bytesEdge from [] [] to = epsilonEdge from to bytesEdge from [x] [y] to = byteEdge from (byteSetRange x y) to -- (OPTIMISATION)-bytesEdge from (x:xs) (y:ys) to - | x == y = do +bytesEdge from (x:xs) (y:ys) to+ | x == y = do s <- newState byteEdge from (byteSetSingleton x) s bytesEdge s xs ys to@@ -216,7 +216,7 @@ byteEdge from (byteSetSingleton y) t bytesEdge t (fmap (const 0x00) xs) ys to - when ((x+1) <= (y-1)) $ do + when ((x+1) <= (y-1)) $ do u <- newState byteEdge from (byteSetRange (x+1) (y-1)) u anyBytes u (length xs) to@@ -224,25 +224,25 @@ charEdge :: SNum -> CharSet -> SNum -> NFAM () charEdge from charset to = do- -- trace ("charEdge: " ++ (show $ charset) ++ " => " ++ show (byteRanges charset)) $ + -- trace ("charEdge: " ++ (show $ charset) ++ " => " ++ show (byteRanges charset)) $ e <- getEncoding forM_ (byteRanges e charset) $ \(xs,ys) -> do bytesEdge from xs ys to- + byteEdge :: SNum -> ByteSet -> SNum -> NFAM () byteEdge from charset to = N $ \s n _ -> (s, addEdge n, ()) where addEdge n = case Map.lookup from n of- Nothing -> + Nothing -> Map.insert from (NSt [] [] [(charset,to)]) n Just (NSt acc eps trans) -> Map.insert from (NSt acc eps ((charset,to):trans)) n epsilonEdge :: SNum -> SNum -> NFAM ()-epsilonEdge from to +epsilonEdge from to | from == to = return () | otherwise = N $ \s n _ -> let n' = addEdge n in n' `seq` (s, n', ()) where@@ -254,7 +254,7 @@ accept :: SNum -> Accept Code -> NFAM () accept state new_acc = N $ \s n _ -> (s, addAccept n, ()) where- addAccept n = + addAccept n = case Map.lookup state n of Nothing -> Map.insert state (NSt [new_acc] [] []) n
src/Output.hs view
@@ -122,28 +122,28 @@ . str ") => Array Int (" . str (show strty) . str " -> " . str toktype . str ")\n"- Posn { posnByteString = isByteString,+ Posn { posnStrType = strty, posnTypeInfo = Just (Nothing, toktype) } -> str actions_nm . str " :: Array Int (AlexPosn -> "- . str (strtype isByteString) . str " -> " . str toktype+ . str (show strty) . str " -> " . str toktype . str ")\n"- Posn { posnByteString = isByteString,+ Posn { posnStrType = strty, posnTypeInfo = Just (Just tyclasses, toktype) } -> str actions_nm . str " :: (" . str tyclasses . str ") => Array Int (AlexPosn -> "- . str (strtype isByteString) . str " -> " . str toktype+ . str (show strty) . str " -> " . str toktype . str ")\n"- Monad { monadByteString = isByteString,+ Monad { monadStrType = strty, monadTypeInfo = Just (Nothing, toktype) } -> let- actintty = if isByteString then "Int64" else "Int"+ actintty = if strty == Lazy then "Int64" else "Int" in str actions_nm . str " :: Array Int (AlexInput -> " . str actintty . str " -> Alex(" . str toktype . str "))\n"- Monad { monadByteString = isByteString,+ Monad { monadStrType = strty, monadTypeInfo = Just (Just tyclasses, toktype) } -> let- actintty = if isByteString then "Int64" else "Int"+ actintty = if strty == Lazy then "Int64" else "Int" in str actions_nm . str " :: (" . str tyclasses . str ") => Array Int (AlexInput -> "@@ -212,31 +212,31 @@ . str "alexScan :: (" . str tyclasses . str ") => AlexInput -> Int -> AlexReturn (" . str (show strty) . str " -> " . str toktype . str ")\n"- Posn { posnByteString = isByteString,+ Posn { posnStrType = strty, posnTypeInfo = Just (Nothing, toktype) } -> str "alex_scan_tkn :: () -> AlexInput -> " . str intty . str " -> " . str "AlexInput -> " . str intty . str " -> AlexLastAcc -> (AlexLastAcc, AlexInput)\n" . str "alexScanUser :: () -> AlexInput -> Int -> AlexReturn (AlexPosn -> "- . str (strtype isByteString) . str " -> " . str toktype . str ")\n"+ . str (show strty) . str " -> " . str toktype . str ")\n" . str "alexScan :: AlexInput -> Int -> AlexReturn (AlexPosn -> "- . str (strtype isByteString) . str " -> " . str toktype . str ")\n"- Posn { posnByteString = isByteString,+ . str (show strty) . str " -> " . str toktype . str ")\n"+ Posn { posnStrType = strty, posnTypeInfo = Just (Just tyclasses, toktype) } -> str "alex_scan_tkn :: () -> AlexInput -> " . str intty . str " -> " . str "AlexInput -> " . str intty . str " -> AlexLastAcc -> (AlexLastAcc, AlexInput)\n" . str "alexScanUser :: (" . str tyclasses . str ") => () -> AlexInput -> Int -> AlexReturn (AlexPosn -> "- . str (strtype isByteString) . str " -> " . str toktype . str ")\n"+ . str (show strty) . str " -> " . str toktype . str ")\n" . str "alexScan :: (" . str tyclasses . str ") => AlexInput -> Int -> AlexReturn (AlexPosn -> "- . str (strtype isByteString) . str " -> " . str toktype . str ")\n"+ . str (show strty) . str " -> " . str toktype . str ")\n" Monad { monadTypeInfo = Just (Nothing, toktype),- monadByteString = isByteString,+ monadStrType = strty, monadUserState = userState } -> let- actintty = if isByteString then "Int64" else "Int"+ actintty = if strty == Lazy then "Int64" else "Int" userStateTy | userState = "AlexUserState" | otherwise = "()" in@@ -253,10 +253,10 @@ . str " -> Alex (" . str toktype . str "))\n" . str "alexMonadScan :: Alex (" . str toktype . str ")\n" Monad { monadTypeInfo = Just (Just tyclasses, toktype),- monadByteString = isByteString,+ monadStrType = strty, monadUserState = userState } -> let- actintty = if isByteString then "Int64" else "Int"+ actintty = if strty == Lazy then "Int64" else "Int" userStateTy | userState = "AlexUserState" | otherwise = "()" in
src/Set.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE CPP #-} module Set ( Set, member, empty, insert ) where -import Data.Set +import Data.Set #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 603 member :: Ord a => a -> Set a -> Bool
src/UTF8.hs view
@@ -8,7 +8,7 @@ -- Could also be imported: import Codec.Binary.UTF8.Light as UTF8- + encode :: Char -> [Word8] encode c = head (UTF8.encodeUTF8' [UTF8.c2w c])
tests/Makefile view
@@ -32,6 +32,8 @@ GHC_VERSION_WORDS=$(subst ., ,$(GHC_VERSION)) GHC_MAJOR_VERSION=$(word 1,$(GHC_VERSION_WORDS)) GHC_MINOR_VERSION=$(word 2,$(GHC_VERSION_WORDS))+# Text dependency comes with GHC from 8.4 onwards+GHC_SHIPS_WITH_TEXT:=$(shell if [ $(GHC_MAJOR_VERSION) -gt 8 -o $(GHC_MAJOR_VERSION) -ge 8 -a $(GHC_MINOR_VERSION) -ge 4 ]; then echo "yes"; else echo "no"; fi) # -fwarn-incomplete-uni-patterns only from 7.4 WARNS_FOR_GHC_GTEQ_7_4=-fwarn-incomplete-uni-patterns WARNS_FOR_GHC_LT_7_4=-fno-warn-lazy-unlifted-bindings@@ -77,6 +79,19 @@ tokens_strict_bytestring.x \ unicode.x +ifeq "$(GHC_SHIPS_WITH_TEXT)" "yes"+TEXT_DEP = -package text++TEXT_TESTS = \+ strict_text_typeclass.x \+ posn_typeclass_strict_text.x \+ tokens_monadUserState_strict_text.x+else+TEXT_DEP =++TEXT_TESTS =+endif+ # NOTE: `cabal` will set the `alex_datadir` env-var accordingly before invoking the test-suite #TEST_ALEX_OPTS = --template=../data/ TEST_ALEX_OPTS=@@ -89,7 +104,7 @@ 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')+ALL_TEST_HS = $(shell echo $(TESTS) $(TEXT_TESTS) | sed -e 's/\([^\. ]*\)\.\(l\)\{0,1\}x/\1.n.hs \1.g.hs/g') ALL_TESTS = $(patsubst %.hs, %.run, $(ALL_TEST_HS)) @@ -97,7 +112,7 @@ ./$< %$(HS_PROG_EXT) : %.hs- $(HC) $(HC_OPTS) -package array -package bytestring $($*_LD_OPTS) $< -o $@+ $(HC) $(HC_OPTS) -package array -package bytestring $(TEXT_DEP) $($*_LD_OPTS) $< -o $@ all :: $(ALL_TESTS)
+ tests/posn_typeclass_strict_text.x view
@@ -0,0 +1,79 @@+{++{-# LANGUAGE OverloadedStrings #-}++module Main (main) where+import System.Exit+import Prelude hiding (lex)++import qualified Data.Text as Text++}++%wrapper "posn-strict-text"+%token "Token s"+%typeclass "Read s"++tokens :-++[a-b]+$ { idtoken 0 }+[c-d]+/"." { idtoken 1 }+[e-f]+/{ tokpred } { idtoken 2 }+^[g-h]+$ { idtoken 3 }+^[i-j]+/"." { idtoken 4 }+^[k-l]+/{ tokpred } { idtoken 5 }+[m-n]+$ { idtoken 6 }+[o-p]+/"." { idtoken 7 }+[q-r]+/{ tokpred } { idtoken 8 }+[0-1]^[s-t]+$ { idtoken 9 }+[2-3]^[u-v]+/"." { idtoken 10 }+[4-5]^[w-x]+/{ tokpred } { idtoken 11 }+[y-z]+ { idtoken 12 }+[A-B]+$ ;+[C-D]+/"." ;+[E-F]+/{ tokpred } ;+^[G-H]+$ ;+^[I-J]+/"." ;+^[K-L]+/{ tokpred } ;+[M-N]+$ ;+[O-P]+/"." ;+[Q-R]+/{ tokpred } ;+[0-1]^[S-T]+$ ;+[2-3]^[U-V]+/"." ;+[4-5]^[W-X]+/{ tokpred } ;+[Y-Z]+ ;+\. ;+[ \n\t\r]+ ;+[0-9] ;++{++tokpred :: () -> AlexInput -> Int -> AlexInput -> Bool+tokpred _ _ _ _ = True++idtoken :: Read s => Int -> AlexPosn -> Text.Text -> Token s+idtoken n _ s = Id n (read ("\"" ++ (Text.unpack s) ++ "\""))++data Token s = Id Int s+ deriving (Show, Ord, Eq)++lex :: Read s => Text.Text -> [Token s]+lex = alexScanTokens++input = "abab\ndddc.fff\ngh\nijji.\nllmnm\noop.rq0tsst\n3uuvu.5xxw"++tokens = [ Id 0 "abab", Id 1 "dddc", Id 2 "fff", Id 3 "gh", Id 4 "ijji",+ Id 5 "ll", Id 6 "mnm", Id 7 "oop", Id 8 "rq", Id 9 "tsst",+ Id 10 "uuvu", Id 11 "xxw"]++main :: IO ()+main =+ let+ result :: [Token String]+ result = lex input+ in do+ if result /= tokens+ then exitFailure+ else exitWith ExitSuccess++}
+ tests/strict_text_typeclass.x view
@@ -0,0 +1,79 @@+{++{-# LANGUAGE OverloadedStrings #-}++module Main (main) where+import System.Exit+import Prelude hiding (lex)++import qualified Data.Text as Text++}++%wrapper "strict-text"+%token "Token s"+%typeclass "Read s"++tokens :-++[a-b]+$ { idtoken 0 }+[c-d]+/"." { idtoken 1 }+[e-f]+/{ tokpred } { idtoken 2 }+^[g-h]+$ { idtoken 3 }+^[i-j]+/"." { idtoken 4 }+^[k-l]+/{ tokpred } { idtoken 5 }+[m-n]+$ { idtoken 6 }+[o-p]+/"." { idtoken 7 }+[q-r]+/{ tokpred } { idtoken 8 }+[0-1]^[s-t]+$ { idtoken 9 }+[2-3]^[u-v]+/"." { idtoken 10 }+[4-5]^[w-x]+/{ tokpred } { idtoken 11 }+[y-z]+ { idtoken 12 }+[A-B]+$ ;+[C-D]+/"." ;+[E-F]+/{ tokpred } ;+^[G-H]+$ ;+^[I-J]+/"." ;+^[K-L]+/{ tokpred } ;+[M-N]+$ ;+[O-P]+/"." ;+[Q-R]+/{ tokpred } ;+[0-1]^[S-T]+$ ;+[2-3]^[U-V]+/"." ;+[4-5]^[W-X]+/{ tokpred } ;+[Y-Z]+ ;+\. ;+[ \n\t\r]+ ;+[0-9] ;++{++tokpred :: () -> AlexInput -> Int -> AlexInput -> Bool+tokpred _ _ _ _ = True++idtoken :: Read s => Int -> Text.Text -> Token s+idtoken n s = Id n (read ("\"" ++ (Text.unpack s) ++ "\""))++data Token s = Id Int s+ deriving (Show, Ord, Eq)++lex :: Read s => Text.Text -> [Token s]+lex = alexScanTokens++input = "abab\ndddc.fff\ngh\nijji.\nllmnm\noop.rq0tsst\n3uuvu.5xxw"++tokens = [ Id 0 "abab", Id 1 "dddc", Id 2 "fff", Id 3 "gh", Id 4 "ijji",+ Id 5 "ll", Id 6 "mnm", Id 7 "oop", Id 8 "rq", Id 9 "tsst",+ Id 10 "uuvu", Id 11 "xxw"]++main :: IO ()+main =+ let+ result :: [Token String]+ result = lex input+ in do+ if result /= tokens+ then exitFailure+ else exitWith ExitSuccess++}
+ tests/tokens_monadUserState_strict_text.x view
@@ -0,0 +1,64 @@+{+{-# LANGUAGE OverloadedStrings #-}+module Main (main) where+import System.Exit+import qualified Data.Text+}++%wrapper "monadUserState-strict-text"+%encoding "iso-8859-1"++$digit = 0-9 -- digits+$alpha = [a-zA-Z] -- alphabetic characters++tokens :-++ $white+ ;+ "--".* ;+ let { tok (\p _ -> Let p) }+ in { tok (\p _ -> In p) }+ $digit+ { tok (\p s -> Int p (read (Data.Text.unpack s))) }+ [\=\+\-\*\/\(\)] { tok (\p s -> Sym p (head (Data.Text.unpack s))) }+ $alpha [$alpha $digit \_ \']* { tok (\p s -> Var p (Data.Text.unpack s)) }++{+-- Each right-hand side has type :: AlexPosn -> Data.Text.Text -> Token++-- Some action helpers:+tok f (p,_,_,input) len = return (f p (Data.Text.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 tk <- alexMonadScan+ if tk == EOF+ then return [tk]+ else do toks <- loop+ return (tk: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]+++}