diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,3 +1,8 @@ +1.18.1 --> 1.18.2 +=================== + +* Fix overzealous lexing of type applications + 1.18.0 --> 1.18.1 =================== diff --git a/haskell-src-exts.cabal b/haskell-src-exts.cabal --- a/haskell-src-exts.cabal +++ b/haskell-src-exts.cabal @@ -1,5 +1,5 @@ Name: haskell-src-exts -Version: 1.18.1 +Version: 1.18.2 License: BSD3 License-File: LICENSE Build-Type: Simple diff --git a/src/Language/Haskell/Exts/InternalLexer.hs b/src/Language/Haskell/Exts/InternalLexer.hs --- a/src/Language/Haskell/Exts/InternalLexer.hs +++ b/src/Language/Haskell/Exts/InternalLexer.hs @@ -351,6 +351,12 @@ isPragmaChar c = isAlphaNum c || c == '_' +-- Used in the lexing of type applications +-- Why is it like this? I don't know exactly but this is how it is in +-- GHC's parser. +isOpSymbol :: Char -> Bool +isOpSymbol c = c `elem` "!#$%&*+./<=>?@\\^|-~" + -- | Checks whether the character would be legal in some position of a qvar. -- Means that '..' and "AAA" will pass the test. isPossiblyQvar :: Char -> Bool @@ -740,9 +746,11 @@ -- Lexed seperately to deal with visible type applciation - '@':_ | TypeApplications `elem` exts -> do - c <- getLastChar - if isIdent c + '@':c:_ | TypeApplications `elem` exts + -- Operator starting with an '@' + && not (isOpSymbol c) -> do + lc <- getLastChar + if isIdent lc then discard 1 >> return At else discard 1 >> return TApp diff --git a/tests/examples/AtOperator.hs b/tests/examples/AtOperator.hs new file mode 100644 --- /dev/null +++ b/tests/examples/AtOperator.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeOperators #-} + +data a :+: b = Proxy + +foo = id @(Int :+: Int) + +_ @> m = m diff --git a/tests/examples/AtOperator.hs.exactprinter.golden b/tests/examples/AtOperator.hs.exactprinter.golden new file mode 100644 --- /dev/null +++ b/tests/examples/AtOperator.hs.exactprinter.golden @@ -0,0 +1,1 @@ +Match diff --git a/tests/examples/AtOperator.hs.parser.golden b/tests/examples/AtOperator.hs.parser.golden new file mode 100644 --- /dev/null +++ b/tests/examples/AtOperator.hs.parser.golden @@ -0,0 +1,286 @@ +ParseOk + ( Module + SrcSpanInfo + { srcInfoSpan = SrcSpan "tests/examples/AtOperator.hs" 1 1 9 1 + , srcInfoPoints = + [ SrcSpan "tests/examples/AtOperator.hs" 1 1 1 1 + , SrcSpan "tests/examples/AtOperator.hs" 2 1 2 1 + , SrcSpan "tests/examples/AtOperator.hs" 4 1 4 1 + , SrcSpan "tests/examples/AtOperator.hs" 4 1 4 1 + , SrcSpan "tests/examples/AtOperator.hs" 4 1 4 1 + , SrcSpan "tests/examples/AtOperator.hs" 6 1 6 1 + , SrcSpan "tests/examples/AtOperator.hs" 8 1 8 1 + , SrcSpan "tests/examples/AtOperator.hs" 9 1 9 1 + , SrcSpan "tests/examples/AtOperator.hs" 9 1 9 1 + ] + } + Nothing + [ LanguagePragma + SrcSpanInfo + { srcInfoSpan = SrcSpan "tests/examples/AtOperator.hs" 1 1 1 34 + , srcInfoPoints = + [ SrcSpan "tests/examples/AtOperator.hs" 1 1 1 13 + , SrcSpan "tests/examples/AtOperator.hs" 1 31 1 34 + ] + } + [ Ident + SrcSpanInfo + { srcInfoSpan = SrcSpan "tests/examples/AtOperator.hs" 1 14 1 30 + , srcInfoPoints = [] + } + "TypeApplications" + ] + , LanguagePragma + SrcSpanInfo + { srcInfoSpan = SrcSpan "tests/examples/AtOperator.hs" 2 1 2 31 + , srcInfoPoints = + [ SrcSpan "tests/examples/AtOperator.hs" 2 1 2 13 + , SrcSpan "tests/examples/AtOperator.hs" 2 28 2 31 + ] + } + [ Ident + SrcSpanInfo + { srcInfoSpan = SrcSpan "tests/examples/AtOperator.hs" 2 14 2 27 + , srcInfoPoints = [] + } + "TypeOperators" + ] + ] + [] + [ DataDecl + SrcSpanInfo + { srcInfoSpan = SrcSpan "tests/examples/AtOperator.hs" 4 1 4 21 + , srcInfoPoints = + [ SrcSpan "tests/examples/AtOperator.hs" 4 14 4 15 ] + } + (DataType + SrcSpanInfo + { srcInfoSpan = SrcSpan "tests/examples/AtOperator.hs" 4 1 4 5 + , srcInfoPoints = [] + }) + Nothing + (DHApp + SrcSpanInfo + { srcInfoSpan = SrcSpan "tests/examples/AtOperator.hs" 4 6 4 13 + , srcInfoPoints = [] + } + (DHInfix + SrcSpanInfo + { srcInfoSpan = SrcSpan "tests/examples/AtOperator.hs" 4 6 4 13 + , srcInfoPoints = [] + } + (UnkindedVar + SrcSpanInfo + { srcInfoSpan = SrcSpan "tests/examples/AtOperator.hs" 4 6 4 7 + , srcInfoPoints = [] + } + (Ident + SrcSpanInfo + { srcInfoSpan = SrcSpan "tests/examples/AtOperator.hs" 4 6 4 7 + , srcInfoPoints = [] + } + "a")) + (Symbol + SrcSpanInfo + { srcInfoSpan = SrcSpan "tests/examples/AtOperator.hs" 4 8 4 11 + , srcInfoPoints = [] + } + ":+:")) + (UnkindedVar + SrcSpanInfo + { srcInfoSpan = SrcSpan "tests/examples/AtOperator.hs" 4 12 4 13 + , srcInfoPoints = [] + } + (Ident + SrcSpanInfo + { srcInfoSpan = SrcSpan "tests/examples/AtOperator.hs" 4 12 4 13 + , srcInfoPoints = [] + } + "b"))) + [ QualConDecl + SrcSpanInfo + { srcInfoSpan = SrcSpan "tests/examples/AtOperator.hs" 4 16 4 21 + , srcInfoPoints = [] + } + Nothing + Nothing + (ConDecl + SrcSpanInfo + { srcInfoSpan = SrcSpan "tests/examples/AtOperator.hs" 4 16 4 21 + , srcInfoPoints = [] + } + (Ident + SrcSpanInfo + { srcInfoSpan = SrcSpan "tests/examples/AtOperator.hs" 4 16 4 21 + , srcInfoPoints = [] + } + "Proxy") + []) + ] + Nothing + , PatBind + SrcSpanInfo + { srcInfoSpan = SrcSpan "tests/examples/AtOperator.hs" 6 1 6 24 + , srcInfoPoints = [] + } + (PVar + SrcSpanInfo + { srcInfoSpan = SrcSpan "tests/examples/AtOperator.hs" 6 1 6 4 + , srcInfoPoints = [] + } + (Ident + SrcSpanInfo + { srcInfoSpan = SrcSpan "tests/examples/AtOperator.hs" 6 1 6 4 + , srcInfoPoints = [] + } + "foo")) + (UnGuardedRhs + SrcSpanInfo + { srcInfoSpan = SrcSpan "tests/examples/AtOperator.hs" 6 5 6 24 + , srcInfoPoints = + [ SrcSpan "tests/examples/AtOperator.hs" 6 5 6 6 ] + } + (App + SrcSpanInfo + { srcInfoSpan = SrcSpan "tests/examples/AtOperator.hs" 6 7 6 24 + , srcInfoPoints = [] + } + (Var + SrcSpanInfo + { srcInfoSpan = SrcSpan "tests/examples/AtOperator.hs" 6 7 6 9 + , srcInfoPoints = [] + } + (UnQual + SrcSpanInfo + { srcInfoSpan = SrcSpan "tests/examples/AtOperator.hs" 6 7 6 9 + , srcInfoPoints = [] + } + (Ident + SrcSpanInfo + { srcInfoSpan = SrcSpan "tests/examples/AtOperator.hs" 6 7 6 9 + , srcInfoPoints = [] + } + "id"))) + (TypeApp + SrcSpanInfo + { srcInfoSpan = SrcSpan "tests/examples/AtOperator.hs" 6 10 6 24 + , srcInfoPoints = + [ SrcSpan "tests/examples/AtOperator.hs" 6 10 6 11 ] + } + (TyParen + SrcSpanInfo + { srcInfoSpan = SrcSpan "tests/examples/AtOperator.hs" 6 11 6 24 + , srcInfoPoints = + [ SrcSpan "tests/examples/AtOperator.hs" 6 11 6 12 + , SrcSpan "tests/examples/AtOperator.hs" 6 23 6 24 + ] + } + (TyInfix + SrcSpanInfo + { srcInfoSpan = SrcSpan "tests/examples/AtOperator.hs" 6 12 6 23 + , srcInfoPoints = [] + } + (TyCon + SrcSpanInfo + { srcInfoSpan = SrcSpan "tests/examples/AtOperator.hs" 6 12 6 15 + , srcInfoPoints = [] + } + (UnQual + SrcSpanInfo + { srcInfoSpan = SrcSpan "tests/examples/AtOperator.hs" 6 12 6 15 + , srcInfoPoints = [] + } + (Ident + SrcSpanInfo + { srcInfoSpan = SrcSpan "tests/examples/AtOperator.hs" 6 12 6 15 + , srcInfoPoints = [] + } + "Int"))) + (UnQual + SrcSpanInfo + { srcInfoSpan = SrcSpan "tests/examples/AtOperator.hs" 6 16 6 19 + , srcInfoPoints = [] + } + (Symbol + SrcSpanInfo + { srcInfoSpan = SrcSpan "tests/examples/AtOperator.hs" 6 16 6 19 + , srcInfoPoints = [] + } + ":+:")) + (TyCon + SrcSpanInfo + { srcInfoSpan = SrcSpan "tests/examples/AtOperator.hs" 6 20 6 23 + , srcInfoPoints = [] + } + (UnQual + SrcSpanInfo + { srcInfoSpan = SrcSpan "tests/examples/AtOperator.hs" 6 20 6 23 + , srcInfoPoints = [] + } + (Ident + SrcSpanInfo + { srcInfoSpan = SrcSpan "tests/examples/AtOperator.hs" 6 20 6 23 + , srcInfoPoints = [] + } + "Int")))))))) + Nothing + , FunBind + SrcSpanInfo + { srcInfoSpan = SrcSpan "tests/examples/AtOperator.hs" 8 1 8 11 + , srcInfoPoints = [] + } + [ InfixMatch + SrcSpanInfo + { srcInfoSpan = SrcSpan "tests/examples/AtOperator.hs" 8 1 8 11 + , srcInfoPoints = [] + } + (PWildCard + SrcSpanInfo + { srcInfoSpan = SrcSpan "tests/examples/AtOperator.hs" 8 1 8 2 + , srcInfoPoints = [] + }) + (Symbol + SrcSpanInfo + { srcInfoSpan = SrcSpan "tests/examples/AtOperator.hs" 8 3 8 5 + , srcInfoPoints = [] + } + "@>") + [ PVar + SrcSpanInfo + { srcInfoSpan = SrcSpan "tests/examples/AtOperator.hs" 8 6 8 7 + , srcInfoPoints = [] + } + (Ident + SrcSpanInfo + { srcInfoSpan = SrcSpan "tests/examples/AtOperator.hs" 8 6 8 7 + , srcInfoPoints = [] + } + "m") + ] + (UnGuardedRhs + SrcSpanInfo + { srcInfoSpan = SrcSpan "tests/examples/AtOperator.hs" 8 8 8 11 + , srcInfoPoints = + [ SrcSpan "tests/examples/AtOperator.hs" 8 8 8 9 ] + } + (Var + SrcSpanInfo + { srcInfoSpan = SrcSpan "tests/examples/AtOperator.hs" 8 10 8 11 + , srcInfoPoints = [] + } + (UnQual + SrcSpanInfo + { srcInfoSpan = SrcSpan "tests/examples/AtOperator.hs" 8 10 8 11 + , srcInfoPoints = [] + } + (Ident + SrcSpanInfo + { srcInfoSpan = SrcSpan "tests/examples/AtOperator.hs" 8 10 8 11 + , srcInfoPoints = [] + } + "m")))) + Nothing + ] + ] + , [] + ) diff --git a/tests/examples/AtOperator.hs.prettyparser.golden b/tests/examples/AtOperator.hs.prettyparser.golden new file mode 100644 --- /dev/null +++ b/tests/examples/AtOperator.hs.prettyparser.golden @@ -0,0 +1,1 @@ +Match diff --git a/tests/examples/AtOperator.hs.prettyprinter.golden b/tests/examples/AtOperator.hs.prettyprinter.golden new file mode 100644 --- /dev/null +++ b/tests/examples/AtOperator.hs.prettyprinter.golden @@ -0,0 +1,6 @@ +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeOperators #-} + +data a :+: b = Proxy +foo = id @(Int :+: Int) +_ @> m = m