diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,15 @@ +## Changes in 3.5.4.0 + +* Fix [issue #277](https://github.com/haskell/alex/issues/277): + compatibility of generated code with `{-# LANGUAGE ImpredicativeTypes #-}`, + thanks Nadia Yvette Chambers! +* Simplify `cabal install` ([PR #272](https://github.com/haskell/alex/pull/272)), + thanks Antoine Leblanc! +* Document `examples/words.x`, thanks Piotr Justyna! +* Tested with GHC 8.0 - 9.12.2. + +_Andreas Abel, 2025-08-03_ + ## Changes in 3.5.3.0 * Fix critical bug in automaton minimizer diff --git a/alex.cabal b/alex.cabal --- a/alex.cabal +++ b/alex.cabal @@ -1,6 +1,6 @@ -cabal-version: >= 1.10 +cabal-version: 1.18 name: alex -version: 3.5.3.0 +version: 3.5.4.0 -- don't forget updating changelog.md! license: BSD3 license-file: LICENSE @@ -23,7 +23,7 @@ tested-with: GHC == 9.12.2 - GHC == 9.10.1 + GHC == 9.10.2 GHC == 9.8.4 GHC == 9.6.7 GHC == 9.4.8 @@ -42,9 +42,11 @@ AlexTemplate.hs AlexWrappers.hs -extra-source-files: +extra-doc-files: CHANGELOG.md README.md + +extra-source-files: examples/Makefile examples/Tokens.x examples/Tokens_gscan.x @@ -80,6 +82,7 @@ tests/gscan_typeclass.x tests/posn_typeclass.x tests/monad_typeclass.x + tests/monadic_expr.x tests/monad_typeclass_bytestring.x tests/monadUserState_typeclass.x tests/monadUserState_typeclass_bytestring.x diff --git a/data/AlexTemplate.hs b/data/AlexTemplate.hs --- a/data/AlexTemplate.hs +++ b/data/AlexTemplate.hs @@ -13,12 +13,16 @@ # define FAST_INT Int# -- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. # if __GLASGOW_HASKELL__ > 706 -# define GTE(n,m) (GHC.Exts.tagToEnum# (n >=# m)) -# define EQ(n,m) (GHC.Exts.tagToEnum# (n ==# m)) +# define CMP_GEQ(n,m) (((n) >=# (m)) :: Int#) +# define CMP_EQ(n,m) (((n) ==# (m)) :: Int#) +# define CMP_MKBOOL(x) ((GHC.Exts.tagToEnum# (x)) :: Bool) # else -# define GTE(n,m) (n >=# m) -# define EQ(n,m) (n ==# m) +# define CMP_GEQ(n,m) (((n) >= (m)) :: Bool) +# define CMP_EQ(n,m) (((n) == (m)) :: Bool) +# define CMP_MKBOOL(x) ((x) :: Bool) # endif +# define GTE(n,m) CMP_MKBOOL(CMP_GEQ(n,m)) +# define EQ(n,m) CMP_MKBOOL(CMP_EQ(n,m)) # define PLUS(n,m) (n +# m) # define MINUS(n,m) (n -# m) # define TIMES(n,m) (n *# m) @@ -142,7 +146,7 @@ Nothing -> (new_acc, input__) Just (c, new_input) -> #ifdef ALEX_DEBUG - Debug.Trace.trace ("State: " ++ show IBOX(s) ++ ", char: " ++ show c ++ " " ++ (show . chr . fromIntegral) c) $ + Debug.Trace.trace ("State: " ++ show IBOX(s) ++ ", char: " ++ show c ++ " " ++ (show . Data.Char.chr . fromIntegral) c) $ #endif case fromIntegral c of { IBOX(ord_c) -> let diff --git a/data/AlexWrappers.hs b/data/AlexWrappers.hs --- a/data/AlexWrappers.hs +++ b/data/AlexWrappers.hs @@ -17,20 +17,17 @@ #if defined(ALEX_BASIC_BYTESTRING) || defined(ALEX_POSN_BYTESTRING) || defined(ALEX_MONAD_BYTESTRING) import Data.Int (Int64) -import qualified Data.Char import qualified Data.ByteString.Lazy as ByteString import qualified Data.ByteString.Internal as ByteString (w2c) #elif defined(ALEX_STRICT_BYTESTRING) -import qualified Data.Char import qualified Data.ByteString as ByteString import qualified Data.ByteString.Internal as ByteString hiding (ByteString) import qualified Data.ByteString.Unsafe as ByteString #else -import Data.Char (ord) import qualified Data.Bits -- | Encode a Haskell String to a list of Word8 values, in UTF8 format. @@ -38,7 +35,7 @@ utf8Encode = uncurry (:) . utf8Encode' utf8Encode' :: Char -> (Word8, [Word8]) -utf8Encode' c = case go (ord c) of +utf8Encode' c = case go (Data.Char.ord c) of (x, xs) -> (fromIntegral x, map fromIntegral xs) where go oc diff --git a/examples/words.x b/examples/words.x --- a/examples/words.x +++ b/examples/words.x @@ -1,4 +1,17 @@ --- Performance test; run with input /usr/dict/words, for example +-- this is intended to be a performance test of an alex-generated lexer +-- * run with /usr/dict/words or equivalent, depending on your os, e.g.: +-- * mac os: /usr/share/dict/words +-- * alpine linux: available as a package +-- (https://pkgs.alpinelinux.org/packages?name=words&branch=edge&repo=&arch=&origin=&flagged=&maintainer=) +-- and when installed, available here: /usr/share/dict/ (the directory contains multiple languages) +-- * to generate lexer: +-- alex words.x +-- * to scan a basic string with the generated lexer using ghci: +-- $ ghci +-- ghci> :l words +-- ghci> alexScanTokens "word1 word2" (produces: ["word1","word2"]) +-- * to run the performance test as intended, compile the lexer into an executable and run with: +-- time ./words.bin +RTS -s < /usr/dict/words { module Main (main) where } @@ -8,7 +21,7 @@ words :- $white+ ; -[A-Za-z0-9\'\-]+ { \s -> () } +[A-Za-z0-9\'\-]+ { \s -> s } { main = do diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -401,6 +401,7 @@ always_imports = [ "#include \"ghcconfig.h\"" , "import qualified Data.Array" + , "import qualified Data.Char" ] import_glaexts :: [String] @@ -437,8 +438,7 @@ import_debug :: [String] import_debug = - [ "import Data.Char (chr)" - , "import qualified Debug.Trace" + [ "import qualified Debug.Trace" ] templateDir :: IO FilePath -> [CLIFlags] -> IO FilePath diff --git a/src/Parser.hs b/src/Parser.hs --- a/src/Parser.hs +++ b/src/Parser.hs @@ -8,9 +8,6 @@ {-# LANGUAGE NoStrictData #-} {-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE PartialTypeSignatures #-} -#if __GLASGOW_HASKELL__ >= 710 -{-# LANGUAGE PartialTypeSignatures #-} -#endif -- ----------------------------------------------------------------------------- -- -- Parser.y, part of Alex @@ -29,25 +26,24 @@ import Data.Char --import Debug.Trace -import qualified Data.Function as Happy_Prelude +import qualified Control.Monad as Happy_Prelude import qualified Data.Bool as Happy_Prelude import qualified Data.Function as Happy_Prelude -import qualified Data.Maybe as Happy_Prelude import qualified Data.Int as Happy_Prelude +import qualified Data.List as Happy_Prelude +import qualified Data.Maybe as Happy_Prelude import qualified Data.String as Happy_Prelude import qualified Data.Tuple as Happy_Prelude -import qualified Data.List as Happy_Prelude -import qualified Control.Monad as Happy_Prelude -import qualified Text.Show as Happy_Prelude -import qualified GHC.Num as Happy_Prelude import qualified GHC.Err as Happy_Prelude +import qualified GHC.Num as Happy_Prelude +import qualified Text.Show as Happy_Prelude import qualified Data.Array as Happy_Data_Array import qualified Data.Bits as Bits import qualified GHC.Exts as Happy_GHC_Exts import Control.Applicative(Applicative(..)) import Control.Monad (ap) --- parser produced by Happy Version 2.1.5 +-- parser produced by Happy Version 2.1.6 newtype HappyAbsSyn = HappyAbsSyn HappyAny #if __GLASGOW_HASKELL__ >= 607 diff --git a/src/Scan.hs b/src/Scan.hs --- a/src/Scan.hs +++ b/src/Scan.hs @@ -19,6 +19,7 @@ -- import Debug.Trace #include "ghcconfig.h" import qualified Data.Array +import qualified Data.Char import Data.Array.Base (unsafeAt) import GHC.Exts (Addr#,Int#,Int(I#),(*#),(+#),(-#),(==#),(>=#),indexCharOffAddr#,indexInt16OffAddr#,indexInt32OffAddr#,int2Word#,narrow16Int#,narrow32Int#,negateInt#,or#,ord#,uncheckedShiftL#,word2Int#) import qualified GHC.Exts @@ -321,12 +322,16 @@ # define FAST_INT Int# -- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. # if __GLASGOW_HASKELL__ > 706 -# define GTE(n,m) (GHC.Exts.tagToEnum# (n >=# m)) -# define EQ(n,m) (GHC.Exts.tagToEnum# (n ==# m)) +# define CMP_GEQ(n,m) (((n) >=# (m)) :: Int#) +# define CMP_EQ(n,m) (((n) ==# (m)) :: Int#) +# define CMP_MKBOOL(x) ((GHC.Exts.tagToEnum# (x)) :: Bool) # else -# define GTE(n,m) (n >=# m) -# define EQ(n,m) (n ==# m) +# define CMP_GEQ(n,m) (((n) >= (m)) :: Bool) +# define CMP_EQ(n,m) (((n) == (m)) :: Bool) +# define CMP_MKBOOL(x) ((x) :: Bool) # endif +# define GTE(n,m) CMP_MKBOOL(CMP_GEQ(n,m)) +# define EQ(n,m) CMP_MKBOOL(CMP_EQ(n,m)) # define PLUS(n,m) (n +# m) # define MINUS(n,m) (n -# m) # define TIMES(n,m) (n *# m) @@ -450,7 +455,7 @@ Nothing -> (new_acc, input__) Just (c, new_input) -> #ifdef ALEX_DEBUG - Debug.Trace.trace ("State: " ++ show IBOX(s) ++ ", char: " ++ show c ++ " " ++ (show . chr . fromIntegral) c) $ + Debug.Trace.trace ("State: " ++ show IBOX(s) ++ ", char: " ++ show c ++ " " ++ (show . Data.Char.chr . fromIntegral) c) $ #endif case fromIntegral c of { IBOX(ord_c) -> let diff --git a/tests/Makefile b/tests/Makefile --- a/tests/Makefile +++ b/tests/Makefile @@ -41,7 +41,7 @@ HC_OPTS=-Wall $(WARNS_DEP_GHC_GTEQ_9_8) -fwarn-incomplete-uni-patterns -Werror -.PRECIOUS: %.n.hs %.g.hs %.o %.exe %.bin +.PRECIOUS: %.d.hs %.i.hs %.g.hs %.n.hs %.o %.exe %.bin ifeq "$(TARGETPLATFORM)" "i386-unknown-mingw32" HS_PROG_EXT = .exe @@ -86,6 +86,7 @@ TEXT_DEP = -package text TEXT_TESTS = \ + monadic_expr.x \ strict_text_typeclass.x \ posn_typeclass_strict_text.x \ tokens_monadUserState_strict_text.x @@ -105,12 +106,15 @@ %.g.hs : %.x $(ALEX) $(TEST_ALEX_OPTS) -g $< -o $@ +%.i.hs : %.x + $(ALEX) $(TEST_ALEX_OPTS) -g $< -o $@ + %.d.hs : %.x $(ALEX) $(TEST_ALEX_OPTS) --debug $< -o $@ -CLEAN_FILES += *.n.hs *.g.hs *.d.hs *.info *.hi *.o *.bin *.exe +CLEAN_FILES += *.n.hs *.g.hs *.i.hs *.d.hs *.info *.hi *.o *.bin *.exe -TESTS_HS = $(shell echo $(TESTS) $(TEXT_TESTS) | sed -e 's/\([^\. ]*\)\.\(l\)\{0,1\}x/\1.n.hs \1.g.hs/g') +TESTS_HS = $(shell echo $(TESTS) $(TEXT_TESTS) | sed -e 's/\([^\. ]*\)\.\(l\)\{0,1\}x/\1.n.hs \1.g.hs \1.i.hs/g') TESTS_HS_DEBUG = $(shell echo $(TESTS) $(TEXT_TESTS) | sed -e 's/\([^\. ]*\)\.\(l\)\{0,1\}x/\1.d.hs/g') TESTS_HS_ALL = $(TESTS_HS) $(TESTS_HS_DEBUG) @@ -122,7 +126,7 @@ ./$< %$(HS_PROG_EXT) : %.hs - $(HC) $(HC_OPTS) -package array -package bytestring $(TEXT_DEP) $($*_LD_OPTS) $< -o $@ + $(HC) $(if $(findstring .i.,$@),-XImpredicativeTypes,) $(HC_OPTS) -package array -package bytestring $(TEXT_DEP) $($*_LD_OPTS) $< -o $@ all :: $(ALL_TESTS) diff --git a/tests/monadic_expr.x b/tests/monadic_expr.x new file mode 100644 --- /dev/null +++ b/tests/monadic_expr.x @@ -0,0 +1,122 @@ +{ +module Main (main) where +import {- "containers" -} Data.Set (Set) +import {- "containers" -} qualified Data.Set as Set +import {- "text" -} Data.Text (Text) +import {- "text" -} qualified Data.Text as Text +import {- "text" -} qualified Data.Text.Read as Text +import {- "base" -} Control.Arrow hiding (arr) +import {- "base" -} Control.Monad (forM_, when) +import {- "base" -} Control.Monad.Fail (MonadFail) +import {- "base" -} qualified Control.Monad.Fail as Fail (MonadFail (..)) +import {- "base" -} Numeric.Natural +import {- "base" -} System.Exit +} + +%wrapper "monadUserState-strict-text" +%token "Token integer" +%typeclass "Integral integer, Read integer, Show integer" + +-- ugh +$digit = 0-9 +$unidigit = 1-9 +@number = [0] | $unidigit $digit* + +tokens :- + $white+ { skip } + @number { \(_, _, _, s) len -> case Text.decimal (Text.take len s) of + Left e -> Fail.fail e + Right (n, txt) + | Text.null txt -> pure $ TokenInt n + | otherwise -> Fail.fail "got incomplete prefix " } + [a-z]+ { \(_, _, _, s) len -> do + let name = Text.take len s + alexSeenVar name + pure $ TokenVar name } + [\+] { mk0ary TokenAdd } + [\-] { mk0ary TokenSub } + [\*] { mk0ary TokenMul } + [\/] { mk0ary TokenDiv } + [\^] { mk0ary TokenPow } + [\(] { mk0ary TokenLPar } + [\)] { mk0ary TokenRPar } + +{ +mk0ary :: (Read integer, Integral integer) => Token integer -> AlexInput -> Int -> Alex (Token integer) +mk0ary tok _ _ = pure tok + +data AlexUserState + = AlexUserState { + ausVars :: Set Text + } deriving (Eq, Read, Show) + +alexSeenVar :: Text -> Alex () +alexSeenVar txt = do + AlexUserState { ausVars = set } <- alexGetUserState + alexSetUserState $ AlexUserState { ausVars = txt `Set.insert` set } + +alexInitUserState :: AlexUserState +alexInitUserState = AlexUserState { ausVars = Set.empty } + +data Token integer + = TokenInt integer + | TokenVar Text + | TokenLPar + | TokenRPar + | TokenPow + | TokenDiv + | TokenMul + | TokenSub + | TokenAdd + | EOF + deriving (Eq, Read, Show) + +alexEOF :: (Read integer, Integral integer) => Alex (Token integer) +alexEOF = pure EOF + +instance MonadFail Alex where + fail s = Alex . const $ Left s + +evalAlex :: Text -> Alex t -> Either String (AlexUserState, t) +evalAlex txt alex = right (first getUserState) $ f state where + f = unAlex alex + getUserState AlexState { alex_ust = userState } = userState + state = AlexState + { alex_bytes = [] + , alex_pos = alexStartPos + , alex_inp = txt + , alex_chr = '\n' + , alex_ust = alexInitUserState + , alex_scd = 0 } + +scanAll :: (Eq integer, Integral integer, Read integer, Show integer) => Alex [Token integer] +scanAll = alexMonadScan >>= \result -> case result of + EOF -> pure [] + tok -> (tok :) <$> scanAll + +tests :: [(Text, Set Text, [Token Natural])] +tests = [ (Text.pack "x*y/(x^3+y^3)" + , Set.fromList [x, y] + , [TokenVar x, TokenMul, TokenVar y, TokenDiv, TokenLPar, TokenVar x, TokenPow, TokenInt 3, TokenAdd, TokenVar y, TokenPow, TokenInt 3, TokenRPar])] where + x = Text.pack "x" + y = Text.pack "y" + +main :: IO () +main = do + forM_ tests $ \(txt, vars, toks) -> do + case evalAlex txt scanAll of + Right (AlexUserState { ausVars = tokVars }, tokList) + | tokVars == vars && toks == tokList -> pure () + | otherwise -> do + when (toks /= tokList) $ do + putStrLn $ "got " <> show tokList + putStrLn $ "wanted " <> show toks + when (tokVars /= vars) $ do + putStrLn $ "got " <> show tokVars + putStrLn $ "wanted " <> show vars + exitFailure + Left errorString -> do + putStrLn $ "got error " <> errorString + exitFailure + exitSuccess +}