alex 3.2.0 → 3.2.1
raw patch · 19 files changed
+1291/−43 lines, 19 files
Files
- CHANGELOG.md +11/−0
- alex.cabal +13/−2
- examples/Makefile +15/−16
- examples/tkns.hs +0/−5
- src/Output.hs +4/−8
- templates/GenericTemplate.hs +11/−11
- tests/Makefile +25/−1
- tests/basic_typeclass.x +75/−0
- tests/basic_typeclass_bytestring.x +79/−0
- tests/default_typeclass.x +311/−0
- tests/gscan_typeclass.x +75/−0
- tests/monadUserState_typeclass.x +96/−0
- tests/monadUserState_typeclass_bytestring.x +103/−0
- tests/monad_typeclass.x +92/−0
- tests/monad_typeclass_bytestring.x +99/−0
- tests/posn_typeclass.x +75/−0
- tests/posn_typeclass_bytestring.x +79/−0
- tests/strict_typeclass.x +78/−0
- tests/tokens_scan_user.x +50/−0
CHANGELOG.md view
@@ -1,3 +1,14 @@+## Changes in 3.2.1:++ * Fix build problem with GHC; add new test tokens_scan_user.x++## Changes in 3.2.0:++ * Allow the token type and productions to be overloaded, and add new+ directives: %token, %typeclass, %action. See "Type Signatures and+ Typeclasses" in the manual.+ * Some small space leak fixes+ ## Changes in 3.1.7: * Add support for `%encoding` directive
alex.cabal view
@@ -1,5 +1,5 @@ name: alex-version: 3.2.0+version: 3.2.1 -- don't forget updating changelog.md! license: BSD3 license-file: LICENSE@@ -44,7 +44,6 @@ examples/pp.x examples/state.x examples/tiny.y- examples/tkns.hs examples/words.x examples/words_monad.x examples/words_posn.x@@ -61,10 +60,22 @@ tests/tokens_posn.x tests/tokens_bytestring.x tests/tokens_posn_bytestring.x+ tests/tokens_scan_user.x tests/tokens_strict_bytestring.x tests/tokens_monad_bytestring.x tests/tokens_monadUserState_bytestring.x tests/tokens_bytestring_unicode.x+ tests/basic_typeclass.x+ tests/basic_typeclass_bytestring.x+ tests/default_typeclass.x+ tests/gscan_typeclass.x+ tests/posn_typeclass.x+ tests/monad_typeclass.x+ tests/monad_typeclass_bytestring.x+ tests/monadUserState_typeclass.x+ tests/monadUserState_typeclass_bytestring.x+ tests/posn_typeclass_bytestring.x+ tests/strict_typeclass.x tests/unicode.x source-repository head
examples/Makefile view
@@ -7,7 +7,7 @@ ifeq "$(TARGETPLATFORM)" "i386-unknown-mingw32" exeext=.exe else-exeext=+exeext=.bin endif PROGS = lit Tokens Tokens_gscan words words_posn words_monad tiny haskell tiger@@ -15,10 +15,10 @@ ALEX_OPTS = --template=.. -g # ALEX_OPTS = --template=.. -%.hs : %.x+%.alex.hs : %.x $(ALEX) $(ALEX_OPTS) $< -o $@ -%.hs : %.y+%.happy.hs : %.y $(HAPPY) $(HAPPY_OPTS) $< -o $@ %.o : %.hs@@ -26,37 +26,36 @@ CLEAN_FILES += *.info *.hi *.o *.bin *.exe -all : $(addsuffix $(HS_PROG_EXT),$(PROGS))+all : $(addsuffix $(exeext),$(PROGS)) -tiny$(exeext) : tiny.hs Tokens_posn.hs+tiny$(exeext) : tiny.happy.hs Tokens_posn.alex.hs $(HC) $(HC_OPTS) -o $@ $^ -lit$(exeext) : lit.hs+lit$(exeext) : lit.alex.hs $(HC) $(HC_OPTS) -o $@ $^ -Tokens$(exeext) : Tokens.hs+Tokens$(exeext) : Tokens.alex.hs $(HC) $(HC_OPTS) -o $@ $^ -Tokens_gscan$(exeext) : Tokens_gscan.hs+Tokens_gscan$(exeext) : Tokens_gscan.alex.hs $(HC) $(HC_OPTS) -o $@ $^ -words$(exeext) : words.hs+words$(exeext) : words.alex.hs $(HC) $(HC_OPTS) -o $@ $^ -words_posn$(exeext) : words_posn.hs+words_posn$(exeext) : words_posn.alex.hs $(HC) $(HC_OPTS) -o $@ $^ -words_monad$(exeext) : words_monad.hs+words_monad$(exeext) : words_monad.alex.hs $(HC) $(HC_OPTS) -o $@ $^ -haskell$(exeext) : haskell.hs+haskell$(exeext) : haskell.alex.hs $(HC) $(HC_OPTS) -o $@ $^ -tiger$(exeext) : tiger.hs+tiger$(exeext) : tiger.alex.hs $(HC) $(HC_OPTS) -main-is TigerLexer -o $@ $^ .PHONY: clean clean:- rm -f *.o *.hi *.bin $(addsuffix $(exeext),$(PROGS)) \- $(addsuffix .hs,$(PROGS)) Tokens_posn.hs-+ rm -f *.o *.hi $(addsuffix $(exeext),$(PROGS)) \+ *.alex.hs *.happy.hs
− examples/tkns.hs
@@ -1,5 +0,0 @@-import Alex-import Tokens--main:: IO ()-main = interact (show.tokens)
src/Output.hs view
@@ -71,14 +71,10 @@ . str "]\n" outputAccept =- let- userStateTy = case scheme of- Monad { monadUserState = True } -> "AlexUserState"- _ -> "()"- in- str accept_nm . str " :: Array Int (AlexAcc " . str userStateTy- . str ")\n" . str accept_nm- . str " = listArray (0::Int," . shows n_states . str ") ["+ -- Don't emit explicit type signature as it contains unknown user type,+ -- see: https://github.com/simonmar/alex/issues/98+ -- str accept_nm . str " :: Array Int (AlexAcc " . str userStateTy . str ")\n"+ str accept_nm . str " = listArray (0::Int," . shows n_states . str ") [" . interleave_shows (char ',') (snd (mapAccumR outputAccs 0 accept)) . str "]\n"
templates/GenericTemplate.hs view
@@ -120,30 +120,30 @@ alexScanUser user input IBOX(sc) = case alex_scan_tkn user input ILIT(0) input sc AlexNone of- (AlexNone, input') ->- case alexGetByte input of- Nothing ->+ (AlexNone, input') ->+ case alexGetByte input of+ Nothing -> #ifdef ALEX_DEBUG trace ("End of input.") $ #endif AlexEOF- Just _ ->+ Just _ -> #ifdef ALEX_DEBUG trace ("Error.") $ #endif AlexError input' - (AlexLastSkip input'' len, _) ->+ (AlexLastSkip input'' len, _) -> #ifdef ALEX_DEBUG- trace ("Skipping.") $+ trace ("Skipping.") $ #endif- AlexSkip input'' len+ AlexSkip input'' len - (AlexLastAcc k input''' len, _) ->+ (AlexLastAcc k input''' len, _) -> #ifdef ALEX_DEBUG- trace ("Accept.") $+ trace ("Accept.") $ #endif- AlexToken input''' len (alex_actions ! k)+ AlexToken input''' len (alex_actions ! k) -- Push the input through the DFA, remembering the most recent accepting@@ -152,7 +152,7 @@ alex_scan_tkn user orig_input len input s last_acc = input `seq` -- strict in the input let- new_acc = (check_accs (alex_accept `quickIndex` IBOX(s)))+ new_acc = (check_accs (alex_accept `quickIndex` IBOX(s))) in new_acc `seq` case alexGetByte input of
tests/Makefile view
@@ -10,7 +10,31 @@ 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 tokens_monad_bytestring.x tokens_monadUserState_bytestring.x null.x tokens_bytestring_unicode.x basic_typeclass.x basic_typeclass_bytestring.x strict_typeclass.x posn_typeclass.x posn_typeclass_bytestring.x gscan_typeclass.x monad_typeclass.x monad_typeclass_bytestring.x monadUserState_typeclass.x monadUserState_typeclass_bytestring.x default_typeclass.x+TESTS = \+ basic_typeclass.x \+ basic_typeclass_bytestring.x \+ default_typeclass.x \+ gscan_typeclass.x \+ monad_typeclass.x \+ monad_typeclass_bytestring.x \+ monadUserState_typeclass.x \+ monadUserState_typeclass_bytestring.x \+ null.x \+ posn_typeclass.x \+ posn_typeclass_bytestring.x \+ strict_typeclass.x \+ simple.x \+ tokens.x \+ tokens_bytestring.x \+ tokens_bytestring_unicode.x \+ tokens_gscan.x \+ tokens_monad_bytestring.x \+ tokens_monadUserState_bytestring.x \+ tokens_posn.x \+ tokens_posn_bytestring.x \+ tokens_scan_user.x \+ tokens_strict_bytestring.x \+ unicode.x TEST_ALEX_OPTS = --template=..
+ tests/basic_typeclass.x view
@@ -0,0 +1,75 @@+{++module Main (main) where+import System.Exit+import Prelude hiding (lex)++}++%wrapper "basic"+%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 -> String -> Token s+idtoken n s = Id n (read ("\"" ++ s ++ "\""))++data Token s = Id Int s+ deriving (Show, Ord, Eq)++lex :: Read s => String -> [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/basic_typeclass_bytestring.x view
@@ -0,0 +1,79 @@+{++{-# LANGUAGE OverloadedStrings #-}++module Main (main) where+import System.Exit+import Prelude hiding (lex)++import Data.ByteString.Lazy.Char8 as Lazy++}++%wrapper "basic-bytestring"+%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 -> Lazy.ByteString -> Token s+idtoken n s = Id n (read ("\"" ++ (Lazy.unpack s) ++ "\""))++data Token s = Id Int s+ deriving (Show, Ord, Eq)++lex :: Read s => Lazy.ByteString -> [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/default_typeclass.x view
@@ -0,0 +1,311 @@+{+{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses, FunctionalDependencies,+ FlexibleInstances #-}++module Main (main) where+import System.Exit+import Prelude hiding (lex)+import qualified Data.Bits+import Control.Applicative+import Control.Monad+import Data.Word+import Data.Char++}++%action "AlexInput -> Int -> m (Token s)"+%typeclass "Read s, MonadState AlexState m"++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] ;++{++-- | Encode a Haskell String to a list of Word8 values, in UTF8 format.+utf8Encode :: Char -> [Word8]+utf8Encode = map fromIntegral . go . ord+ where+ go oc+ | oc <= 0x7f = [oc]++ | oc <= 0x7ff = [ 0xc0 + (oc `Data.Bits.shiftR` 6)+ , 0x80 + oc Data.Bits..&. 0x3f+ ]++ | oc <= 0xffff = [ 0xe0 + (oc `Data.Bits.shiftR` 12)+ , 0x80 + ((oc `Data.Bits.shiftR` 6) Data.Bits..&. 0x3f)+ , 0x80 + oc Data.Bits..&. 0x3f+ ]+ | otherwise = [ 0xf0 + (oc `Data.Bits.shiftR` 18)+ , 0x80 + ((oc `Data.Bits.shiftR` 12) Data.Bits..&. 0x3f)+ , 0x80 + ((oc `Data.Bits.shiftR` 6) Data.Bits..&. 0x3f)+ , 0x80 + oc Data.Bits..&. 0x3f+ ]++type Byte = Word8++data AlexState = AlexState {+ alex_pos :: !AlexPosn, -- position at current input location+ alex_inp :: String, -- the current input+ alex_chr :: !Char, -- the character before the input+ alex_bytes :: [Byte],+ alex_scd :: !Int, -- the current startcode+ alex_errs :: [String]+++ }++type AlexInput = (AlexPosn, -- current position,+ Char, -- previous char+ [Byte], -- pending bytes on current char+ String) -- current input string++ignorePendingBytes :: AlexInput -> AlexInput+ignorePendingBytes (p,c,_,s) = (p,c,[],s)++alexInputPrevChar :: AlexInput -> Char+alexInputPrevChar (_,c,_,_) = c++alexGetByte :: AlexInput -> Maybe (Byte,AlexInput)+alexGetByte (p,c,(b:bs),s) = Just (b,(p,c,bs,s))+alexGetByte (_,_,[],[]) = Nothing+alexGetByte (p,_,[],(c:s)) = let p' = alexMove p c+ (b:bs) = utf8Encode c+ in p' `seq` Just (b, (p', c, bs, s))++data AlexPosn = AlexPn !Int !Int !Int+ deriving (Eq,Show)++alexStartPos :: AlexPosn+alexStartPos = AlexPn 0 1 1++alexMove :: AlexPosn -> Char -> AlexPosn+alexMove (AlexPn a l c) '\t' = AlexPn (a+1) l (((c+7) `div` 8)*8+1)+alexMove (AlexPn a l _) '\n' = AlexPn (a+1) (l+1) 1+alexMove (AlexPn a l c) _ = AlexPn (a+1) l (c+1)++alexGetInput :: MonadState AlexState m => m AlexInput+alexGetInput =+ do+ AlexState { alex_pos = pos, alex_chr = c,+ alex_bytes = bs, alex_inp = inp } <- get+ return (pos, c, bs, inp)++alexSetInput :: MonadState AlexState m => AlexInput -> m ()+alexSetInput (pos, c, bs, inp) =+ do+ s <- get+ put s { alex_pos = pos, alex_chr = c,+ alex_bytes = bs, alex_inp = inp }++alexError :: (MonadState AlexState m, Read s) => String -> m (Token s)+alexError message =+ do+ s @ AlexState { alex_errs = errs } <- get+ put s { alex_errs = message : errs }+ alexMonadScan++alexGetStartCode :: MonadState AlexState m => m Int+alexGetStartCode =+ do+ AlexState{ alex_scd = sc } <- get+ return sc++alexSetStartCode :: MonadState AlexState m => Int -> m ()+alexSetStartCode sc =+ do+ s <- get+ put s { alex_scd = sc }++alexMonadScan :: (MonadState AlexState m, Read s) => m (Token s)+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' _ -> do+ alexSetInput inp'+ alexMonadScan+ AlexToken inp' len action -> do+ alexSetInput inp'+ action (ignorePendingBytes inp) len++alexEOF :: MonadState AlexState m => m (Token s)+alexEOF = return EOF++tokpred :: () -> AlexInput -> Int -> AlexInput -> Bool+tokpred _ _ _ _ = True++idtoken :: (Read s, MonadState AlexState m) =>+ Int -> AlexInput -> Int -> m (Token s)+idtoken n (_, _, _, s) len = return (Id n (read ("\"" ++ take len s ++ "\"")))++data Token s = Id Int s | EOF deriving Eq++lex :: (MonadState AlexState m, Read s) => m [Token s]+lex =+ do+ res <- alexMonadScan+ case res of+ EOF -> return []+ tok ->+ do+ rest <- lex+ return (tok : rest)++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 =+ do+ (result, _) <- runStateT lex AlexState { alex_pos = alexStartPos,+ alex_inp = input,+ alex_chr = '\n',+ alex_bytes = [],+ alex_scd = 0,+ alex_errs= [] }+ if result /= tokens+ then exitFailure+ else exitWith ExitSuccess++-- | Minimal definition is either both of @get@ and @put@ or just @state@+class Monad m => MonadState s m | m -> s where+ -- | Return the state from the internals of the monad.+ get :: m s+ get = state (\s -> (s, s))++ -- | Replace the state inside the monad.+ put :: s -> m ()+ put s = state (\_ -> ((), s))++ -- | Embed a simple state action into the monad.+ state :: (s -> (a, s)) -> m a+ state f = do+ s <- get+ let ~(a, s') = f s+ put s'+ return a++-- | Construct a state monad computation from a function.+-- (The inverse of 'runState'.)+state' :: Monad m+ => (s -> (a, s)) -- ^pure state transformer+ -> StateT s m a -- ^equivalent state-passing computation+state' f = StateT (return . f)++-- ---------------------------------------------------------------------------+-- | A state transformer monad parameterized by:+--+-- * @s@ - The state.+--+-- * @m@ - The inner monad.+--+-- The 'return' function leaves the state unchanged, while @>>=@ uses+-- the final state of the first computation as the initial state of+-- the second.+newtype StateT s m a = StateT { runStateT :: s -> m (a,s) }++-- | Evaluate a state computation with the given initial state+-- and return the final value, discarding the final state.+--+-- * @'evalStateT' m s = 'liftM' 'fst' ('runStateT' m s)@+evalStateT :: (Monad m) => StateT s m a -> s -> m a+evalStateT m s = do+ (a, _) <- runStateT m s+ return a++-- | Evaluate a state computation with the given initial state+-- and return the final state, discarding the final value.+--+-- * @'execStateT' m s = 'liftM' 'snd' ('runStateT' m s)@+execStateT :: (Monad m) => StateT s m a -> s -> m s+execStateT m s = do+ (_, s') <- runStateT m s+ return s'++-- | Map both the return value and final state of a computation using+-- the given function.+--+-- * @'runStateT' ('mapStateT' f m) = f . 'runStateT' m@+mapStateT :: (m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b+mapStateT f m = StateT $ f . runStateT m++-- | @'withStateT' f m@ executes action @m@ on a state modified by+-- applying @f@.+--+-- * @'withStateT' f m = 'modify' f >> m@+withStateT :: (s -> s) -> StateT s m a -> StateT s m a+withStateT f m = StateT $ runStateT m . f++instance (Functor m) => Functor (StateT s m) where+ fmap f m = StateT $ \ s ->+ fmap (\ (a, s') -> (f a, s')) $ runStateT m s++instance (Monad m) => Monad (StateT s m) where+ return a = state $ \s -> (a, s)+ m >>= k = StateT $ \s -> do+ (a, s') <- runStateT m s+ runStateT (k a) s'+ fail str = StateT $ \_ -> fail str++-- | Fetch the current value of the state within the monad.+get' :: (Monad m) => StateT s m s+get' = state $ \s -> (s, s)++-- | @'put' s@ sets the state within the monad to @s@.+put' :: (Monad m) => s -> StateT s m ()+put' s = state $ \_ -> ((), s)++-- | @'modify' f@ is an action that updates the state to the result of+-- applying @f@ to the current state.+--+-- * @'modify' f = 'get' >>= ('put' . f)@+modify' :: (Monad m) => (s -> s) -> StateT s m ()+modify' f = state $ \s -> ((), f s)++instance Monad m => MonadState s (StateT s m) where+ get = get'+ put = put'+ state = state'++instance (Functor m, Monad m) => Applicative (StateT s m) where+ pure = return+ (<*>) = ap++}
+ tests/gscan_typeclass.x view
@@ -0,0 +1,75 @@+{++module Main (main) where+import System.Exit+import Prelude hiding (lex)++}++%wrapper "gscan"+%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 -> Char -> String -> Int ->+ ((Int,state) -> [Token s]) -> (Int,state) -> [Token s]+idtoken n _ _ s len cont st = Id n (read ("\"" ++ take len s ++ "\"")) : cont st++data Token s = Id Int s deriving Eq++lex :: Read s => String -> [Token s]+lex str = alexGScan (\_ _ _ _ -> []) (0 :: Int) str++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/monadUserState_typeclass.x view
@@ -0,0 +1,96 @@+{++module Main (main) where+import System.Exit+import Prelude hiding (lex)++}++%wrapper "monadUserState"+%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] ;++{++type AlexUserState = Int++alexInitUserState = 0++alexEOF :: Alex (Token s)+alexEOF = return EOF++tokpred :: AlexUserState -> AlexInput -> Int -> AlexInput -> Bool+tokpred _ _ _ _ = True++idtoken :: Read s => Int -> AlexInput -> Int -> Alex (Token s)+idtoken n (_, _, _, s) len = return (Id n (read ("\"" ++ take len s ++ "\"")))++data Token s = Id Int s | EOF deriving Eq++lex :: Read s => String -> Either String [Token s]+lex input =+ let+ lexAll =+ do+ res <- alexMonadScan+ case res of+ EOF -> return []+ tok ->+ do+ rest <- lexAll+ return (tok : rest)+ in+ runAlex input lexAll++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 = lex input+ in do+ case result of+ Left _ -> exitFailure+ Right toks ->+ do+ if toks /= tokens+ then exitFailure+ else exitWith ExitSuccess++}
+ tests/monadUserState_typeclass_bytestring.x view
@@ -0,0 +1,103 @@+{++{-# LANGUAGE OverloadedStrings #-}++module Main (main) where+import System.Exit+import Prelude hiding (lex)++import qualified Data.ByteString.Lazy.Char8 as Lazy++}++%wrapper "monadUserState-bytestring"+%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] ;++{++type AlexUserState = Int++alexInitUserState = 0++alexEOF :: Alex (Token s)+alexEOF = return EOF++tokpred :: AlexUserState -> AlexInput -> Int -> AlexInput -> Bool+tokpred _ _ _ _ = True++idtoken :: Read s => Int -> AlexInput -> Int64 -> Alex (Token s)+idtoken n (_, _, s, _) len =+ return (Id n (read ("\"" ++ Lazy.unpack (Lazy.take (fromIntegral len) s) +++ "\"")))++data Token s = Id Int s | EOF deriving Eq++lex :: Read s => Lazy.ByteString -> Either String [Token s]+lex input =+ let+ lexAll =+ do+ res <- alexMonadScan+ case res of+ EOF -> return []+ tok ->+ do+ rest <- lexAll+ return (tok : rest)+ in+ runAlex input lexAll++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 :: Either String [Token String]+ result = lex input+ in do+ case result of+ Left _ -> exitFailure+ Right toks ->+ do+ if toks /= tokens+ then exitFailure+ else exitWith ExitSuccess++}
+ tests/monad_typeclass.x view
@@ -0,0 +1,92 @@+{++module Main (main) where+import System.Exit+import Prelude hiding (lex)++}++%wrapper "monad"+%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] ;++{++alexEOF :: Alex (Token s)+alexEOF = return EOF++tokpred :: () -> AlexInput -> Int -> AlexInput -> Bool+tokpred _ _ _ _ = True++idtoken :: Read s => Int -> AlexInput -> Int -> Alex (Token s)+idtoken n (_, _, _, s) len = return (Id n (read ("\"" ++ take len s ++ "\"")))++data Token s = Id Int s | EOF deriving Eq++lex :: Read s => String -> Either String [Token s]+lex input =+ let+ lexAll =+ do+ res <- alexMonadScan+ case res of+ EOF -> return []+ tok ->+ do+ rest <- lexAll+ return (tok : rest)+ in+ runAlex input lexAll++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 = lex input+ in do+ case result of+ Left _ -> exitFailure+ Right toks ->+ do+ if toks /= tokens+ then exitFailure+ else exitWith ExitSuccess++}
+ tests/monad_typeclass_bytestring.x view
@@ -0,0 +1,99 @@+{++{-# LANGUAGE OverloadedStrings #-}++module Main (main) where+import System.Exit+import Prelude hiding (lex)++import qualified Data.ByteString.Lazy.Char8 as Lazy++}++%wrapper "monad-bytestring"+%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] ;++{++alexEOF :: Alex (Token s)+alexEOF = return EOF++tokpred :: () -> AlexInput -> Int -> AlexInput -> Bool+tokpred _ _ _ _ = True++idtoken :: Read s => Int -> AlexInput -> Int64 -> Alex (Token s)+idtoken n (_, _, s, _) len =+ return (Id n (read ("\"" ++ Lazy.unpack (Lazy.take (fromIntegral len) s) +++ "\"")))++data Token s = Id Int s | EOF deriving Eq++lex :: Read s => Lazy.ByteString -> Either String [Token s]+lex input =+ let+ lexAll =+ do+ res <- alexMonadScan+ case res of+ EOF -> return []+ tok ->+ do+ rest <- lexAll+ return (tok : rest)+ in+ runAlex input lexAll++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 :: Either String [Token String]+ result = lex input+ in do+ case result of+ Left _ -> exitFailure+ Right toks ->+ do+ if toks /= tokens+ then exitFailure+ else exitWith ExitSuccess++}
+ tests/posn_typeclass.x view
@@ -0,0 +1,75 @@+{++module Main (main) where+import System.Exit+import Prelude hiding (lex)++}++%wrapper "posn"+%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 -> String -> Token s+idtoken n _ s = Id n (read ("\"" ++ s ++ "\""))++data Token s = Id Int s+ deriving (Show, Ord, Eq)++lex :: Read s => String -> [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/posn_typeclass_bytestring.x view
@@ -0,0 +1,79 @@+{++{-# LANGUAGE OverloadedStrings #-}++module Main (main) where+import System.Exit+import Prelude hiding (lex)++import Data.ByteString.Lazy.Char8 as Lazy++}++%wrapper "posn-bytestring"+%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 -> Lazy.ByteString -> Token s+idtoken n _ s = Id n (read ("\"" ++ (Lazy.unpack s) ++ "\""))++data Token s = Id Int s+ deriving (Show, Ord, Eq)++lex :: Read s => Lazy.ByteString -> [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_typeclass.x view
@@ -0,0 +1,78 @@+{++{-# LANGUAGE OverloadedStrings #-}++module Main (main) where+import System.Exit+import Prelude hiding (lex)++import Data.ByteString.Char8 as Strict++}++%wrapper "strict-bytestring"+%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 -> Strict.ByteString -> Token s+idtoken n s = Id n (read ("\"" ++ (Strict.unpack s) ++ "\""))++data Token s = Id Int s deriving Eq++lex :: Read s => Strict.ByteString -> [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_scan_user.x view
@@ -0,0 +1,50 @@+{+module Main (main) where+import System.Exit+}++%wrapper "basic" -- Defines: AlexInput, alexGetByte, alexPrevChar++$digit = 0-9+$alpha = [a-zA-Z]+$ws = [\ \t\n]++tokens :-++ 5 / {\u _ibt _l _iat -> u == FiveIsMagic} { \s -> TFive (head s) }+ $digit { \s -> TDigit (head s) }+ $alpha { \s -> TAlpha (head s) }+ $ws { \s -> TWSpace (head s) }++{++data Token = TDigit Char+ | TAlpha Char+ | TWSpace Char+ | TFive Char -- Predicated only+ | TLexError+ deriving (Eq,Show)++data UserLexerMode = NormalMode+ | FiveIsMagic+ deriving Eq++main | test1 /= result1 = exitFailure+ | test2 /= result2 = exitFailure+ -- all succeeded+ | otherwise = exitWith ExitSuccess++run_lexer :: UserLexerMode -> String -> [Token]+run_lexer m s = go ('\n', [], s)+ where go i@(_,_,s') = case alexScanUser m i 0 of+ AlexEOF -> []+ AlexError _i -> [TLexError]+ AlexSkip i' _len -> go i'+ AlexToken i' len t -> t (take len s') : go i'++test1 = run_lexer FiveIsMagic "5 x"+result1 = [TFive '5',TWSpace ' ',TAlpha 'x']++test2 = run_lexer NormalMode "5 x"+result2 = [TDigit '5',TWSpace ' ',TAlpha 'x']+}