From e4a778aa1264d9e0b6b39b9fcdd682e7312abeba Mon Sep 17 00:00:00 2001 From: Nadia Chambers Date: Sun, 3 Aug 2025 15:18:16 +0200 Subject: [PATCH 1/2] add testcases for -XImpredicativeTypes failures MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit With -XImpredicativeTypes, the following occurs: basic_typeclass.i.hs:877:28: error: [GHC-36495] • tagToEnum# must appear applied to one value argument • In the first argument of ‘(&&)’, namely ‘(GHC.Exts.tagToEnum# (offset >=# 0#))’ In the expression: (GHC.Exts.tagToEnum# (offset >=# 0#)) && let check = alexIndexInt16OffAddr alex_check offset in (GHC.Exts.tagToEnum# (check ==# ord_c)) In the expression: if (GHC.Exts.tagToEnum# (offset >=# 0#)) && let check = alexIndexInt16OffAddr alex_check offset in (GHC.Exts.tagToEnum# (check ==# ord_c)) then alexIndexInt16OffAddr alex_table offset else alexIndexInt16OffAddr alex_deflt s | 877 | new_s = if GTE(offset,ILIT(0)) | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ --- alex.cabal | 1 + tests/Makefile | 10 ++-- tests/monadic_expr.x | 122 +++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 130 insertions(+), 3 deletions(-) create mode 100644 tests/monadic_expr.x diff --git a/alex.cabal b/alex.cabal index d5ddc42..1dff816 100644 --- a/alex.cabal +++ b/alex.cabal @@ -80,6 +80,7 @@ extra-source-files: 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/tests/Makefile b/tests/Makefile index 97ecd22..c6adc74 100644 --- a/tests/Makefile +++ b/tests/Makefile @@ -86,6 +86,7 @@ ifeq "$(GHC_SHIPS_WITH_TEXT)" "yes" 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 @@ TEST_ALEX_OPTS= %.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 @@ ALL_TESTS = $(BASIC_TESTS) $(DEBUG_TESTS) ./$< %$(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 index 0000000..74e1838 --- /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 +} From 3f0dd74b4fd2a1ca6b36388a0db7bdaf7236ee2e Mon Sep 17 00:00:00 2001 From: Nadia Chambers Date: Sat, 2 Aug 2025 15:05:00 +0200 Subject: [PATCH 2/2] annotate comparison subexpressions in AlexTemplate MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit GTE() and EQ() were getting the following errors for the monadUserState-strict-text and possibly other cases with -XImpredicativeTypes enabled: basic_typeclass.i.hs:877:28: error: [GHC-36495] • tagToEnum# must appear applied to one value argument • In the first argument of ‘(&&)’, namely ‘(GHC.Exts.tagToEnum# (offset >=# 0#))’ In the expression: (GHC.Exts.tagToEnum# (offset >=# 0#)) && let check = alexIndexInt16OffAddr alex_check offset in (GHC.Exts.tagToEnum# (check ==# ord_c)) In the expression: if (GHC.Exts.tagToEnum# (offset >=# 0#)) && let check = alexIndexInt16OffAddr alex_check offset in (GHC.Exts.tagToEnum# (check ==# ord_c)) then alexIndexInt16OffAddr alex_table offset else alexIndexInt16OffAddr alex_deflt s | 877 | new_s = if GTE(offset,ILIT(0)) | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Annotating the tagToEnum# usage to specify which Enum is intended was one case. Another was annotating the results of ==# and >=# to resolve some ambiguity involved there. --- data/AlexTemplate.hs | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/data/AlexTemplate.hs b/data/AlexTemplate.hs index 80e6ac1..4531449 100644 --- 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)