alex 3.1.0 → 3.1.1
raw patch · 10 files changed
+304/−75 lines, 10 filesdep ~base
Dependency ranges changed: base
Files
- alex.cabal +10/−3
- dist/build/alex/alex-tmp/Parser.hs +69/−53
- dist/build/alex/alex-tmp/Scan.hs +14/−3
- doc/alex.xml +2/−6
- src/CharSet.hs +2/−0
- templates/wrappers.hs +11/−5
- tests/Makefile +2/−5
- tests/null.x +71/−0
- tests/tokens_monadUserState_bytestring.x +63/−0
- tests/tokens_monad_bytestring.x +60/−0
alex.cabal view
@@ -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
dist/build/alex/alex-tmp/Parser.hs view
@@ -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
dist/build/alex/alex-tmp/Scan.hs view
@@ -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
doc/alex.xml view
@@ -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)- )</programlisting>+ -> AlexReturn action</programlisting> <para>The extra argument, of some type <literal>user</literal>, is passed to each predicate.</para>@@ -1602,7 +1598,7 @@ <programlisting> 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
src/CharSet.hs view
@@ -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'
templates/wrappers.hs view
@@ -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
tests/Makefile view
@@ -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)
+ tests/null.x view
@@ -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"+}
+ tests/tokens_monadUserState_bytestring.x view
@@ -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]+++}
+ tests/tokens_monad_bytestring.x view
@@ -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]+++}