alex 3.2.2 → 3.2.3
raw patch · 12 files changed
+135/−170 lines, 12 files
Files
- CHANGELOG.md +4/−0
- alex.cabal +1/−1
- src/Output.hs +10/−52
- templates/GenericTemplate.hs +30/−30
- templates/wrappers.hs +73/−70
- tests/Makefile +1/−1
- tests/monadUserState_typeclass.x +2/−2
- tests/monadUserState_typeclass_bytestring.x +2/−2
- tests/monad_typeclass.x +2/−2
- tests/monad_typeclass_bytestring.x +2/−2
- tests/tokens_monadUserState_bytestring.x +4/−4
- tests/tokens_monad_bytestring.x +4/−4
CHANGELOG.md view
@@ -1,3 +1,7 @@+## Changes in 3.2.3:++ * fix issue when using ccphs (#116)+ ## Changes in 3.2.2: * Manage line length in generated files [GH-84]
alex.cabal view
@@ -1,5 +1,5 @@ name: alex-version: 3.2.2+version: 3.2.3 -- don't forget updating changelog.md! license: BSD3 license-file: LICENSE
src/Output.hs view
@@ -24,7 +24,7 @@ import Data.Maybe (isJust) import Data.Bits import Data.Char ( ord, chr )-import Data.List ( maximumBy, sortBy, groupBy, mapAccumR, intercalate )+import Data.List ( maximumBy, sortBy, groupBy, mapAccumR ) -- ----------------------------------------------------------------------------- -- Printing the output@@ -534,69 +534,27 @@ -- Convert an integer to a 16-bit number encoded in \xNN\xNN format suitable -- for placing in a string (copied from Happy's ProduceCode.lhs) --- | Lay out string literal consisting of hexadecimal characters into columns--- of specified width.-concatInChunks :: Int -> [HexChar] -> String-concatInChunks width =- -- The string literal is laid out using preprocessor continuation lines.- -- This way the string literal will be reassembled by the preprocessor- -- into a single-line literal and that's what ghc will see.- --- -- E.g. string "foobar" with width 2 will be laid out as:- -- "fo\- -- ob\- -- ar"- --- -- NB Take care to not use split string syntax, e.g.- -- x = "foo\- -- \bar"- -- because it does not play well with the preprocessor, which is always- -- enabled in the generated file.- intercalate "\\\n" .- map (concatMap unHexChar) .- takeBy width--chunkSize :: Int-chunkSize = 19- hexChars16 :: [Int] -> String-hexChars16 acts =- concatInChunks chunkSize $ concatMap conv16 acts+hexChars16 acts = concat (map conv16 acts) where- conv16 :: Int -> [HexChar] conv16 i | i > 0x7fff || i < -0x8000 = error ("Internal error: hexChars16: out of range: " ++ show i) | otherwise = hexChar16 i hexChars32 :: [Int] -> String-hexChars32 acts =- concatInChunks chunkSize $ concatMap conv32 acts+hexChars32 acts = concat (map conv32 acts) where- conv32 :: Int -> [HexChar]- conv32 i =- hexChar16 (i .&. 0xffff) ++- hexChar16 ((i `shiftR` 16) .&. 0xffff)--hexChar16 :: Int -> [HexChar]-hexChar16 i =- [ toHex (i .&. 0xff)- , toHex ((i `shiftR` 8) .&. 0xff) -- force little-endian- ]+ conv32 i = hexChar16 (i .&. 0xffff) +++ hexChar16 ((i `shiftR` 16) .&. 0xffff) -newtype HexChar = HexChar { unHexChar :: String }+hexChar16 :: Int -> String+hexChar16 i = toHex (i .&. 0xff)+ ++ toHex ((i `shiftR` 8) .&. 0xff) -- force little-endian -toHex :: Int -> HexChar-toHex i = HexChar ['\\','x', hexDig (i `div` 16), hexDig (i `mod` 16)]+toHex :: Int -> String+toHex i = ['\\','x', hexDig (i `div` 16), hexDig (i `mod` 16)] hexDig :: Int -> Char hexDig i | i <= 9 = chr (i + ord '0') | otherwise = chr (i - 10 + ord 'a')--takeBy :: Int -> [a] -> [[a]]-takeBy n = go- where- go [] = []- go xs = ys : go ys'- where- (ys, ys') = splitAt n xs
templates/GenericTemplate.hs view
@@ -115,13 +115,13 @@ | AlexToken !AlexInput !Int a -- alexScan :: AlexInput -> StartCode -> AlexReturn a-alexScan input IBOX(sc)- = alexScanUser undefined input IBOX(sc)+alexScan input__ IBOX(sc)+ = alexScanUser undefined input__ IBOX(sc) -alexScanUser user input IBOX(sc)- = case alex_scan_tkn user input ILIT(0) input sc AlexNone of- (AlexNone, input') ->- case alexGetByte input of+alexScanUser user__ input__ IBOX(sc)+ = case alex_scan_tkn user__ input__ ILIT(0) input__ sc AlexNone of+ (AlexNone, input__') ->+ case alexGetByte input__ of Nothing -> #ifdef ALEX_DEBUG trace ("End of input.") $@@ -131,32 +131,32 @@ #ifdef ALEX_DEBUG trace ("Error.") $ #endif- AlexError input'+ AlexError input__' - (AlexLastSkip input'' len, _) ->+ (AlexLastSkip input__'' len, _) -> #ifdef ALEX_DEBUG trace ("Skipping.") $ #endif- AlexSkip input'' len+ AlexSkip input__'' len - (AlexLastAcc k input''' len, _) ->+ (AlexLastAcc k input__''' len, _) -> #ifdef ALEX_DEBUG 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 -- state it encountered. -alex_scan_tkn user orig_input len input s last_acc =- input `seq` -- strict in the input+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))) in new_acc `seq`- case alexGetByte input of- Nothing -> (new_acc, input)+ case alexGetByte input__ of+ Nothing -> (new_acc, input__) Just (c, new_input) -> #ifdef ALEX_DEBUG trace ("State: " ++ show IBOX(s) ++ ", char: " ++ show c) $@@ -172,26 +172,26 @@ else alexIndexInt16OffAddr alex_deflt s in case new_s of- ILIT(-1) -> (new_acc, input)+ ILIT(-1) -> (new_acc, input__) -- on an error, we want to keep the input *before* the -- character that failed, not after.- _ -> alex_scan_tkn user orig_input (if c < 0x80 || c >= 0xC0 then PLUS(len,ILIT(1)) else len)+ _ -> alex_scan_tkn user__ orig_input (if c < 0x80 || c >= 0xC0 then PLUS(len,ILIT(1)) else len) -- note that the length is increased ONLY if this is the 1st byte in a char encoding) new_input new_s new_acc } where check_accs (AlexAccNone) = last_acc- check_accs (AlexAcc a ) = AlexLastAcc a input IBOX(len)- check_accs (AlexAccSkip) = AlexLastSkip input IBOX(len)+ check_accs (AlexAcc a ) = AlexLastAcc a input__ IBOX(len)+ check_accs (AlexAccSkip) = AlexLastSkip input__ IBOX(len) #ifndef ALEX_NOPRED check_accs (AlexAccPred a predx rest)- | predx user orig_input IBOX(len) input- = AlexLastAcc a input IBOX(len)+ | predx user__ orig_input IBOX(len) input__+ = AlexLastAcc a input__ IBOX(len) | otherwise = check_accs rest check_accs (AlexAccSkipPred predx rest)- | predx user orig_input IBOX(len) input- = AlexLastSkip input IBOX(len)+ | predx user__ orig_input IBOX(len) input__+ = AlexLastSkip input__ IBOX(len) | otherwise = check_accs rest #endif@@ -214,20 +214,20 @@ -- ----------------------------------------------------------------------------- -- Predicates on a rule -alexAndPred p1 p2 user in1 len in2- = p1 user in1 len in2 && p2 user in1 len in2+alexAndPred p1 p2 user__ in1 len in2+ = p1 user__ in1 len in2 && p2 user__ in1 len in2 --alexPrevCharIsPred :: Char -> AlexAccPred _-alexPrevCharIs c _ input _ _ = c == alexInputPrevChar input+alexPrevCharIs c _ input__ _ _ = c == alexInputPrevChar input__ -alexPrevCharMatches f _ input _ _ = f (alexInputPrevChar input)+alexPrevCharMatches f _ input__ _ _ = f (alexInputPrevChar input__) --alexPrevCharIsOneOfPred :: Array Char Bool -> AlexAccPred _-alexPrevCharIsOneOf arr _ input _ _ = arr ! alexInputPrevChar input+alexPrevCharIsOneOf arr _ input__ _ _ = arr ! alexInputPrevChar input__ --alexRightContext :: Int -> AlexAccPred _-alexRightContext IBOX(sc) user _ _ input =- case alex_scan_tkn user input ILIT(0) input sc AlexNone of+alexRightContext IBOX(sc) user__ _ _ input__ =+ case alex_scan_tkn user__ input__ ILIT(0) input__ sc AlexNone of (AlexNone, _) -> False _ -> True -- TODO: there's no need to find the longest
templates/wrappers.hs view
@@ -177,9 +177,9 @@ -- Compile with -funbox-strict-fields for best results! runAlex :: String -> Alex a -> Either String a-runAlex input (Alex f)+runAlex input__ (Alex f) = case f (AlexState {alex_pos = alexStartPos,- alex_inp = input,+ alex_inp = input__, alex_chr = '\n', alex_bytes = [], #ifdef ALEX_MONAD_USER_STATE@@ -211,13 +211,13 @@ 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))+ = Alex $ \s@AlexState{alex_pos=pos,alex_chr=c,alex_bytes=bs,alex_inp=inp__} ->+ Right (s, (pos,c,bs,inp__)) 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- s@(AlexState{}) -> Right (s, ())+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__, ()) alexError :: String -> Alex a alexError message = Alex $ const $ Left message@@ -237,17 +237,17 @@ #endif alexMonadScan = do- inp <- alexGetInput+ inp__ <- alexGetInput sc <- alexGetStartCode- case alexScan inp sc of+ 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'+ AlexSkip inp__' _len -> do+ alexSetInput inp__' alexMonadScan- AlexToken inp' len action -> do- alexSetInput inp'- action (ignorePendingBytes inp) len+ AlexToken inp__' len action -> do+ alexSetInput inp__'+ action (ignorePendingBytes inp__) len -- ----------------------------------------------------------------------------- -- Useful token actions@@ -264,10 +264,12 @@ -- perform an action for this token, and set the start code to a new value andBegin :: AlexAction result -> Int -> AlexAction result-(action `andBegin` code) input len = do alexSetStartCode code; action input len+(action `andBegin` code) input__ len = do+ alexSetStartCode code+ action input__ len token :: (AlexInput -> Int -> token) -> AlexAction token-token t input len = return (t input len)+token t input__ len = return (t input__ len) #endif /* ALEX_MONAD */ @@ -289,10 +291,10 @@ -- Compile with -funbox-strict-fields for best results! runAlex :: ByteString.ByteString -> Alex a -> Either String a-runAlex input (Alex f)+runAlex input__ (Alex f) = case f (AlexState {alex_pos = alexStartPos, alex_bpos = 0,- alex_inp = input,+ alex_inp = input__, alex_chr = '\n', #ifdef ALEX_MONAD_USER_STATE alex_ust = alexInitUserState,@@ -317,16 +319,16 @@ 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))+ = Alex $ \s@AlexState{alex_pos=pos,alex_bpos=bpos,alex_chr=c,alex_inp=inp__} ->+ Right (s, (pos,c,inp__,bpos)) alexSetInput :: AlexInput -> Alex ()-alexSetInput (pos,c,inp,bpos)+alexSetInput (pos,c,inp__,bpos) = Alex $ \s -> case s{alex_pos=pos, alex_bpos=bpos, alex_chr=c,- alex_inp=inp} of- s@(AlexState{}) -> Right (s, ())+ alex_inp=inp__} of+ state__@(AlexState{}) -> Right (state__, ()) alexError :: String -> Alex a alexError message = Alex $ const $ Left message@@ -338,17 +340,17 @@ alexSetStartCode sc = Alex $ \s -> Right (s{alex_scd=sc}, ()) alexMonadScan = do- inp@(_,_,_,n) <- alexGetInput+ inp__@(_,_,_,n) <- alexGetInput sc <- alexGetStartCode- case alexScan inp sc of+ 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'+ AlexSkip inp__' _len -> do+ alexSetInput inp__' alexMonadScan- AlexToken inp'@(_,_,_,n') _ action -> do- alexSetInput inp'- action (ignorePendingBytes inp) len+ AlexToken inp__'@(_,_,_,n') _ action -> do+ alexSetInput inp__'+ action (ignorePendingBytes inp__) len where len = n'-n @@ -367,10 +369,12 @@ -- perform an action for this token, and set the start code to a new value andBegin :: AlexAction result -> Int -> AlexAction result-(action `andBegin` code) input len = do alexSetStartCode code; action input len+(action `andBegin` code) input__ len = do+ alexSetStartCode code+ action input__ len token :: (AlexInput -> Int64 -> token) -> AlexAction token-token t input len = return (t input len)+token t input__ len = return (t input__ len) #endif /* ALEX_MONAD_BYTESTRING */ @@ -385,12 +389,12 @@ -- alexScanTokens :: String -> [token] alexScanTokens str = go ('\n',[],str)- where go inp@(_,_bs,s) =- case alexScan inp 0 of+ where go inp__@(_,_bs,s) =+ case alexScan inp__ 0 of AlexEOF -> [] AlexError _ -> error "lexical error"- AlexSkip inp' _ln -> go inp'- AlexToken inp' len act -> act (take len s) : go inp'+ AlexSkip inp__' _ln -> go inp__'+ AlexToken inp__' len act -> act (take len s) : go inp__' alexGetByte :: AlexInput -> Maybe (Byte,AlexInput) alexGetByte (c,(b:bs),s) = Just (b,(c,bs,s))@@ -408,15 +412,14 @@ -- alexScanTokens :: ByteString.ByteString -> [token] alexScanTokens str = go (AlexInput '\n' str 0)- where go inp =- case alexScan inp 0 of+ where go inp__ =+ case alexScan inp__ 0 of AlexEOF -> [] AlexError _ -> error "lexical error"- AlexSkip inp' _len -> go inp'- AlexToken inp' _ act ->- let str = alexStr inp- len = alexBytePos inp' - alexBytePos inp in- act (ByteString.take len str) : go inp'+ AlexSkip inp__' _len -> go inp__'+ AlexToken inp__' _ act ->+ let len = alexBytePos inp__' - alexBytePos inp__ in+ act (ByteString.take len (alexStr inp__)) : go inp__' #endif @@ -424,15 +427,14 @@ -- alexScanTokens :: ByteString.ByteString -> [token] alexScanTokens str = go (AlexInput '\n' str 0)- where go inp =- case alexScan inp 0 of+ where go inp__ =+ case alexScan inp__ 0 of AlexEOF -> [] AlexError _ -> error "lexical error"- AlexSkip inp' _len -> go inp'- AlexToken inp' _ act ->- let str = alexStr inp- len = alexBytePos inp' - alexBytePos inp in- act (ByteString.take len str) : go inp'+ AlexSkip inp__' _len -> go inp__'+ AlexToken inp__' _ act ->+ let len = alexBytePos inp__' - alexBytePos inp__ in+ act (ByteString.take len (alexStr inp__)) : go inp__' #endif @@ -444,13 +446,13 @@ #ifdef ALEX_POSN --alexScanTokens :: String -> [token]-alexScanTokens str = go (alexStartPos,'\n',[],str)- where go inp@(pos,_,_,str) =- case alexScan inp 0 of+alexScanTokens str0 = go (alexStartPos,'\n',[],str0)+ where go inp__@(pos,_,_,str) =+ case alexScan inp__ 0 of AlexEOF -> [] AlexError ((AlexPn _ line column),_,_,_) -> error $ "lexical error at line " ++ (show line) ++ ", column " ++ (show column)- AlexSkip inp' _ln -> go inp'- AlexToken inp' len act -> act pos (take len str) : go inp'+ AlexSkip inp__' _ln -> go inp__'+ AlexToken inp__' len act -> act pos (take len str) : go inp__' #endif @@ -459,14 +461,14 @@ #ifdef ALEX_POSN_BYTESTRING --alexScanTokens :: ByteString.ByteString -> [token]-alexScanTokens str = go (alexStartPos,'\n',str,0)- where go inp@(pos,_,str,n) =- case alexScan inp 0 of+alexScanTokens str0 = go (alexStartPos,'\n',str0,0)+ where go inp__@(pos,_,str,n) =+ 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'@(_,_,_,n') _ act ->- act pos (ByteString.take (n'-n) str) : go inp'+ AlexSkip inp__' _len -> go inp__'+ AlexToken inp__'@(_,_,_,n') _ act ->+ act pos (ByteString.take (n'-n) str) : go inp__' #endif @@ -476,14 +478,15 @@ -- For compatibility with previous versions of Alex, and because we can. #ifdef ALEX_GSCAN-alexGScan stop state inp = alex_gscan stop alexStartPos '\n' [] inp (0,state)+alexGScan stop__ state__ inp__ =+ alex_gscan stop__ alexStartPos '\n' [] inp__ (0,state__) -alex_gscan stop p c bs inp (sc,state) =- case alexScan (p,c,bs,inp) sc of- AlexEOF -> stop p c inp (sc,state)- AlexError _ -> stop p c inp (sc,state)- AlexSkip (p',c',bs',inp') _len -> alex_gscan stop p' c' bs' inp' (sc,state)- AlexToken (p',c',bs',inp') len k ->- k p c inp len (\scs -> alex_gscan stop p' c' bs' inp' scs)- (sc,state)+alex_gscan stop__ p c bs inp__ (sc,state__) =+ case alexScan (p,c,bs,inp__) sc of+ AlexEOF -> stop__ p c inp__ (sc,state__)+ AlexError _ -> stop__ p c inp__ (sc,state__)+ AlexSkip (p',c',bs',inp__') _len ->+ alex_gscan stop__ p' c' bs' inp__' (sc,state__)+ AlexToken (p',c',bs',inp__') len k ->+ k p c inp__ len (\scs -> alex_gscan stop__ p' c' bs' inp__' scs) (sc,state__) #endif
tests/Makefile view
@@ -1,6 +1,6 @@ ALEX=../dist/build/alex/alex HC=ghc-HC_OPTS=-Wall -fno-warn-missing-signatures -fno-warn-name-shadowing -fno-warn-unused-imports -fno-warn-tabs -Werror+HC_OPTS=-Wall -fno-warn-missing-signatures -fno-warn-unused-imports -fno-warn-tabs -Werror .PRECIOUS: %.n.hs %.g.hs %.o %.exe %.bin
tests/monadUserState_typeclass.x view
@@ -60,7 +60,7 @@ data Token s = Id Int s | EOF deriving Eq lex :: Read s => String -> Either String [Token s]-lex input =+lex inp = let lexAll = do@@ -72,7 +72,7 @@ rest <- lexAll return (tok : rest) in- runAlex input lexAll+ runAlex inp lexAll input = "abab\ndddc.fff\ngh\nijji.\nllmnm\noop.rq0tsst\n3uuvu.5xxw"
tests/monadUserState_typeclass_bytestring.x view
@@ -66,7 +66,7 @@ data Token s = Id Int s | EOF deriving Eq lex :: Read s => Lazy.ByteString -> Either String [Token s]-lex input =+lex inp = let lexAll = do@@ -78,7 +78,7 @@ rest <- lexAll return (tok : rest) in- runAlex input lexAll+ runAlex inp lexAll input = "abab\ndddc.fff\ngh\nijji.\nllmnm\noop.rq0tsst\n3uuvu.5xxw"
tests/monad_typeclass.x view
@@ -56,7 +56,7 @@ data Token s = Id Int s | EOF deriving Eq lex :: Read s => String -> Either String [Token s]-lex input =+lex inp = let lexAll = do@@ -68,7 +68,7 @@ rest <- lexAll return (tok : rest) in- runAlex input lexAll+ runAlex inp lexAll input = "abab\ndddc.fff\ngh\nijji.\nllmnm\noop.rq0tsst\n3uuvu.5xxw"
tests/monad_typeclass_bytestring.x view
@@ -62,7 +62,7 @@ data Token s = Id Int s | EOF deriving Eq lex :: Read s => Lazy.ByteString -> Either String [Token s]-lex input =+lex inp = let lexAll = do@@ -74,7 +74,7 @@ rest <- lexAll return (tok : rest) in- runAlex input lexAll+ runAlex inp lexAll input = "abab\ndddc.fff\ngh\nijji.\nllmnm\noop.rq0tsst\n3uuvu.5xxw"
tests/tokens_monadUserState_bytestring.x view
@@ -47,11 +47,11 @@ alexInitUserState = () scanner str = runAlex str $ do- let loop = do tok <- alexMonadScan- if tok == EOF- then return [tok]+ let loop = do tk <- alexMonadScan+ if tk == EOF+ then return [tk] else do toks <- loop- return (tok:toks)+ return (tk:toks) loop test1 = case scanner " let in 012334\n=+*foo bar__'" of
tests/tokens_monad_bytestring.x view
@@ -44,11 +44,11 @@ else exitWith ExitSuccess scanner str = runAlex str $ do- let loop = do tok <- alexMonadScan- if tok == EOF- then return [tok]+ let loop = do tk <- alexMonadScan+ if tk == EOF+ then return [tk] else do toks <- loop- return (tok:toks)+ return (tk:toks) loop test1 = case scanner " let in 012334\n=+*foo bar__'" of