diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -6,6 +6,50 @@
 
 ## [Unreleased]
 
+## [3.0.1.0] - 2026-09-09
+
+### Performance
+
+- Cut parser wall time by about 10%, allocations by about 4%, and peak heap by
+  about 27% on the Stackage corpus benchmark. The lexer decides ASCII
+  characters without consulting the Unicode general-category tables, groups
+  the keyword table by length, and derives byte offsets from the length of the
+  consumed text; the token stream builds its successor strictly instead of
+  through a thunk; identifier atoms are built inside a single token match; and
+  implied `LANGUAGE` extensions are resolved through a map rather than a
+  linear scan.
+
+### Fixed
+
+- Accept `(@)` as a parenthesized operator variable in expressions. A tight
+  `@` lexes as a reserved token, and the parenthesized-operator parser rejected
+  it, so `(@)`, `(@) 1 2`, and `$(@)` failed to parse even though GHC accepts
+  them (rejecting `(@)` only later, in the renamer). The pretty-printer already
+  rendered such names as `(@)`, so they did not round-trip. Other reserved
+  operators (`->`, `=>`, `::`, `|`, `<-`, `=`, `..`) are still rejected.
+
+- Wrap `DeclPatSynSig`, `DeclDefault`, and `DeclSplice` in `DeclAnn` with a
+  source span, like every other top-level declaration. Consumers that locate
+  declarations by span (such as attaching `-- |` comments) can now handle
+  pattern synonym signatures, `default` declarations, and declaration splices.
+
+- Reuse parsed expressions in nested list, record, and view patterns to avoid
+  quadratic backtracking.
+- Limit retries for local function bindings to the binding head. Invalid
+  nested `let` expressions no longer cause exponential backtracking.
+- Parse parenthesized arrow commands before trying expression or pattern
+  bindings. Deeply nested commands no longer cause quadratic backtracking.
+
+- Removed exponential backtracking for nested parenthesized block expressions
+  in `do` statements, guards, and list comprehensions. Parse expressions first
+  and use the pattern parser when pattern-only syntax requires it. This also
+  speeds up nested list expressions in these positions.
+
+- Apply `LANGUAGE` settings left to right, the order GHC applies them in, so
+  that a later setting overrides an earlier one. A later explicit disable of
+  an extension could previously be resurrected by an implication from an
+  earlier enable.
+
 ## [3.0.0.0] - 2026-09-06
 
 ### Changed
diff --git a/aihc-parser.cabal b/aihc-parser.cabal
--- a/aihc-parser.cabal
+++ b/aihc-parser.cabal
@@ -1,6 +1,6 @@
 cabal-version: 3.8
 name: aihc-parser
-version: 3.0.0.0
+version: 3.0.1.0
 build-type: Simple
 license: Unlicense
 license-file: LICENSE
diff --git a/src/Aihc/Parser/Internal/Cmd.hs b/src/Aihc/Parser/Internal/Cmd.hs
--- a/src/Aihc/Parser/Internal/Cmd.hs
+++ b/src/Aihc/Parser/Internal/Cmd.hs
@@ -154,7 +154,8 @@
     TkKeywordIf -> cmdBodyStmtParser
     TkKeywordCase -> cmdBodyStmtParser
     TkReservedBackslash -> cmdBodyStmtParser
-    TkSpecialLParen -> MP.try cmdBindOrBodyStmtParser <|> MP.try cmdBindStmtParser <|> cmdBodyStmtParser
+    -- Try commands first so nested command parentheses are parsed once.
+    TkSpecialLParen -> MP.try cmdBodyStmtParser <|> MP.try cmdBindOrBodyStmtParser <|> cmdBindStmtParser
     _ -> do
       isPatternBind <- startsWithPatternBind
       if isPatternBind
diff --git a/src/Aihc/Parser/Internal/Common.hs b/src/Aihc/Parser/Internal/Common.hs
--- a/src/Aihc/Parser/Internal/Common.hs
+++ b/src/Aihc/Parser/Internal/Common.hs
@@ -14,6 +14,7 @@
     nameToUnqualified,
     mkUnqualifiedNameAt,
     mkNameAt,
+    identifierName,
     identifierNameWithTokenParser,
     identifierNameParser,
     identifierUnqualifiedNameParser,
@@ -271,19 +272,29 @@
         TkQConId modName name | isModuleName (modName <> "." <> name) -> Just (modName <> "." <> name)
         _ -> Nothing
 
+-- | The 'Name' an identifier token denotes, or 'Nothing' if the token is not
+-- an identifier.
+--
+-- Exposed as a plain function rather than only as a parser so that callers
+-- which also need the token itself (for its span) can build their result
+-- inside a single token match, instead of pairing the two up and taking the
+-- pair apart again in a monadic bind.
+identifierName :: LexToken -> Maybe Name
+identifierName tok =
+  case lexTokenKind tok of
+    TkVarId ident -> Just (mkNameAt tok Nothing NameVarId ident)
+    TkConId ident -> Just (mkNameAt tok Nothing NameConId ident)
+    TkQVarId modName ident -> Just (mkNameAt tok (Just modName) NameVarId ident)
+    TkQConId modName ident -> Just (mkNameAt tok (Just modName) NameConId ident)
+    _ -> Nothing
+
 identifierNameWithTokenParser :: TokParser (LexToken, Name)
 identifierNameWithTokenParser =
-  tokenSatisfy "identifier" $ \tok ->
-    case lexTokenKind tok of
-      TkVarId ident -> Just (tok, qualifyName Nothing (mkUnqualifiedNameAt tok NameVarId ident))
-      TkConId ident -> Just (tok, qualifyName Nothing (mkUnqualifiedNameAt tok NameConId ident))
-      TkQVarId modName ident -> Just (tok, mkNameAt tok (Just modName) NameVarId ident)
-      TkQConId modName ident -> Just (tok, mkNameAt tok (Just modName) NameConId ident)
-      _ -> Nothing
+  tokenSatisfy "identifier" $ \tok -> (,) tok <$> identifierName tok
 
 identifierNameParser :: TokParser Name
 identifierNameParser =
-  snd <$> identifierNameWithTokenParser
+  tokenSatisfy "identifier" identifierName
 
 identifierUnqualifiedNameParser :: TokParser UnqualifiedName
 identifierUnqualifiedNameParser =
@@ -320,7 +331,7 @@
 constructorNameParser =
   tokenSatisfy "constructor identifier" $ \tok ->
     case lexTokenKind tok of
-      TkConId ident -> Just (qualifyName Nothing (mkUnqualifiedNameAt tok NameConId ident))
+      TkConId ident -> Just (mkNameAt tok Nothing NameConId ident)
       TkQConId modName ident -> Just (mkNameAt tok (Just modName) NameConId ident)
       _ -> Nothing
 
@@ -356,11 +367,11 @@
 operatorNameParser =
   tokenSatisfy "operator" $ \tok ->
     case lexTokenKind tok of
-      TkVarSym op -> Just (qualifyName Nothing (mkUnqualifiedNameAt tok NameVarSym op))
-      TkConSym op -> Just (qualifyName Nothing (mkUnqualifiedNameAt tok NameConSym op))
+      TkVarSym op -> Just (mkNameAt tok Nothing NameVarSym op)
+      TkConSym op -> Just (mkNameAt tok Nothing NameConSym op)
       TkQVarSym modName op -> Just (mkNameAt tok (Just modName) NameVarSym op)
       TkQConSym modName op -> Just (mkNameAt tok (Just modName) NameConSym op)
-      TkReservedAt -> Just (qualifyName Nothing (mkUnqualifiedNameAt tok NameVarSym "@"))
+      TkReservedAt -> Just (mkNameAt tok Nothing NameVarSym "@")
       _ -> Nothing
 
 operatorUnqualifiedNameParser :: TokParser UnqualifiedName
@@ -684,8 +695,8 @@
     constraintOperatorIdentifierParser =
       tokenSatisfy "constraint operator identifier" $ \tok ->
         case lexTokenKind tok of
-          TkVarId name -> Just (qualifyName Nothing (mkUnqualifiedNameAt tok NameVarId name))
-          TkConId name -> Just (qualifyName Nothing (mkUnqualifiedNameAt tok NameConId name))
+          TkVarId name -> Just (mkNameAt tok Nothing NameVarId name)
+          TkConId name -> Just (mkNameAt tok Nothing NameConId name)
           _ -> Nothing
     unpromotedInfixOperatorParser =
       tokenSatisfy "type infix operator" $ \tok ->
@@ -693,8 +704,8 @@
           TkVarSym op
             | op /= "."
                 && op /= "!" ->
-                Just (qualifyName Nothing (mkUnqualifiedNameAt tok NameVarSym op), Unpromoted)
-          TkConSym op -> Just (qualifyName Nothing (mkUnqualifiedNameAt tok NameConSym op), Unpromoted)
+                Just (mkNameAt tok Nothing NameVarSym op, Unpromoted)
+          TkConSym op -> Just (mkNameAt tok Nothing NameConSym op, Unpromoted)
           TkQVarSym modName op ->
             Just (mkNameAt tok (Just modName) NameVarSym op, Unpromoted)
           TkQConSym modName op -> Just (mkNameAt tok (Just modName) NameConSym op, Unpromoted)
@@ -895,10 +906,18 @@
   name <- MP.try (binderNameParser <* expectedTok TkReservedAt)
   PAs name <$> bodyParser
 
+-- | Match a tuple opening delimiter and report the closer that must match it.
+--
+-- A single token match rather than two alternatives: this parser is tried at
+-- very many positions where the next token is neither @(@ nor @(#@, and one
+-- token test rejects those positions instead of two.
 tupleDelimsParser :: TokParser (TupleFlavor, LexTokenKind)
 tupleDelimsParser =
-  (expectedTok TkSpecialLParen $> (Boxed, TkSpecialRParen))
-    <|> (expectedTok TkSpecialUnboxedLParen $> (Unboxed, TkSpecialUnboxedRParen))
+  tokenSatisfy "symbol '(' or '(#'" $ \tok ->
+    case lexTokenKind tok of
+      TkSpecialLParen -> Just (Boxed, TkSpecialRParen)
+      TkSpecialUnboxedLParen -> Just (Unboxed, TkSpecialUnboxedRParen)
+      _ -> Nothing
 
 recordFieldsWithWildcardsParser :: TokParser [a] -> TokParser ([a], Bool)
 recordFieldsWithWildcardsParser fieldsParser = do
@@ -1143,15 +1162,15 @@
     symbolicOperatorParser =
       tokenSatisfy "infix operator" $ \tok ->
         case lexTokenKind tok of
-          TkVarSym op -> Just (qualifyName Nothing (mkUnqualifiedNameAt tok NameVarSym op))
-          TkConSym op -> Just (qualifyName Nothing (mkUnqualifiedNameAt tok NameConSym op))
-          TkPrefixPercent -> Just (qualifyName Nothing (mkUnqualifiedNameAt tok NameVarSym "%"))
+          TkVarSym op -> Just (mkNameAt tok Nothing NameVarSym op)
+          TkConSym op -> Just (mkNameAt tok Nothing NameConSym op)
+          TkPrefixPercent -> Just (mkNameAt tok Nothing NameVarSym "%")
           TkQVarSym modName op -> Just (mkNameAt tok (Just modName) NameVarSym op)
           TkQConSym modName op -> Just (mkNameAt tok (Just modName) NameConSym op)
           -- TkMinusOperator is minus when LexicalNegation is enabled but used as infix
-          TkMinusOperator -> Just (qualifyName Nothing (mkUnqualifiedNameAt tok NameVarSym "-"))
+          TkMinusOperator -> Just (mkNameAt tok Nothing NameVarSym "-")
           -- Reserved operators that can be used as infix operators
-          TkReservedColon -> Just (qualifyName Nothing (mkUnqualifiedNameAt tok NameConSym ":"))
+          TkReservedColon -> Just (mkNameAt tok Nothing NameConSym ":")
           _ -> Nothing
 
     backtickIdentifierOperatorParser =
diff --git a/src/Aihc/Parser/Internal/Decl.hs b/src/Aihc/Parser/Internal/Decl.hs
--- a/src/Aihc/Parser/Internal/Decl.hs
+++ b/src/Aihc/Parser/Internal/Decl.hs
@@ -132,7 +132,7 @@
 -- constructs (e.g. @$expr@, @$(expr)@ via TH, @[qq|...|]@ via QuasiQuotes),
 -- so no special dispatch is needed here.
 exprDeclParser :: TokParser Decl
-exprDeclParser = DeclSplice <$> exprParser
+exprDeclParser = withSpanAnn (DeclAnn . mkAnnotation) $ DeclSplice <$> exprParser
 
 -- | Parse a @type@ declaration after the @type@ keyword has been consumed.
 -- Uses 'typeDeclHeadParser' to handle both prefix and infix type heads,
@@ -566,7 +566,7 @@
       "typed pattern bindings with '=' require exactly one binder"
 
 defaultDeclParser :: TokParser Decl
-defaultDeclParser = do
+defaultDeclParser = withSpanAnn (DeclAnn . mkAnnotation) $ do
   expectedTok TkKeywordDefault
   DeclDefault <$> parens (typeParser `MP.sepEndBy` expectedTok TkSpecialComma)
 
@@ -1570,7 +1570,7 @@
 
 -- | Parse a pattern synonym type signature: @pattern Name1, Name2 :: Type@
 patternSynonymSigDeclParser :: TokParser Decl
-patternSynonymSigDeclParser = do
+patternSynonymSigDeclParser = withSpanAnn (DeclAnn . mkAnnotation) $ do
   expectedTok TkKeywordPattern
   names <- patSynNameParser `MP.sepBy1` expectedTok TkSpecialComma
   expectedTok TkReservedDoubleColon
diff --git a/src/Aihc/Parser/Internal/Expr.hs b/src/Aihc/Parser/Internal/Expr.hs
--- a/src/Aihc/Parser/Internal/Expr.hs
+++ b/src/Aihc/Parser/Internal/Expr.hs
@@ -31,6 +31,7 @@
 -- | Parse an expression, then optionally consume @<-@ and a right-hand side.
 -- If the arrow is present, the expression is converted to a pattern via
 -- 'checkPattern' and the result is a bind; otherwise it is an expression.
+-- Retry with the pattern parser for syntax that expressions cannot contain.
 exprOrPatternBindParser ::
   TokParser Expr ->
   TokParser Expr ->
@@ -38,14 +39,31 @@
   (Expr -> a) ->
   TokParser a
 exprOrPatternBindParser exprP rhsP bindCtor exprCtor = do
-  expr <- exprP
-  mArrow <- MP.optional (expectedTok TkReservedLeftArrow)
-  case mArrow of
-    Just () -> do
-      pat <- liftCheck (checkPattern expr)
-      bindCtor pat <$> rhsP
-    Nothing -> pure (exprCtor expr)
+  lhs <- MP.try exprOrPattern <|> patternBind
+  case lhs of
+    Left pat -> bindCtor pat <$> rhsP
+    Right expr -> pure (exprCtor expr)
+  where
+    -- Keep the right-hand side outside 'try'. Only the left-hand side
+    -- can require a second parse as a pattern.
+    exprOrPattern = do
+      expr <- exprP
+      -- An expression can stop before a pattern-only argument or suffix.
+      MP.notFollowedBy $
+        expectedTok TkReservedAt
+          <|> expectedTok TkPrefixBang
+          <|> expectedTok TkPrefixTilde
+          <|> expectedTok TkReservedDoubleColon
+      mArrow <- MP.optional (expectedTok TkReservedLeftArrow)
+      case mArrow of
+        Just () -> Left <$> liftCheck (checkPattern expr)
+        Nothing -> pure (Right expr)
 
+    patternBind = do
+      pat <- patternParser
+      expectedTok TkReservedLeftArrow
+      pure (Left pat)
+
 -- | Report core:
 --
 -- > exp -> infixexp ['::' type]
@@ -197,41 +215,12 @@
   case lexTokenKind tok of
     TkKeywordLet -> MP.try doLetStmtParser <|> doBindOrExprStmtParser
     TkKeywordRec -> doRecStmtParser
-    _ -> MP.try doPatBindStmtParser <|> doBindOrExprStmtParser
+    _ -> doBindOrExprStmtParser
 
 doBindOrExprStmtParser :: TokParser (DoStmt Expr)
-doBindOrExprStmtParser = withSpanAnn (DoAnn . mkAnnotation) $ do
-  mExpr <- MP.optional . MP.try $ exprParser
-  case mExpr of
-    Nothing -> do
-      pat <- patternParser
-      expectedTok TkReservedLeftArrow
-      rhs <- region "while parsing '<-' binding" exprParser
-      pure (DoBind pat rhs)
-    Just expr -> do
-      tok <- lookAhead anySingle
-      case lexTokenKind tok of
-        TkReservedAt -> do
-          pat <- patternParser
-          expectedTok TkReservedLeftArrow
-          rhs <- region "while parsing '<-' binding" exprParser
-          pure (DoBind pat rhs)
-        _ -> do
-          mArrow <- MP.optional (expectedTok TkReservedLeftArrow)
-          case mArrow of
-            Just () -> do
-              pat <- liftCheck (checkPattern expr)
-              rhs <- region "while parsing '<-' binding" exprParser
-              pure (DoBind pat rhs)
-            Nothing ->
-              pure (DoExpr expr)
-
-doPatBindStmtParser :: TokParser (DoStmt Expr)
-doPatBindStmtParser = withSpanAnn (DoAnn . mkAnnotation) $ do
-  pat <- patternParser
-  expectedTok TkReservedLeftArrow
-  expr <- region "while parsing '<-' binding" exprParser
-  pure (DoBind pat expr)
+doBindOrExprStmtParser =
+  withSpanAnn (DoAnn . mkAnnotation) $
+    exprOrPatternBindParser exprParser (region "while parsing '<-' binding" exprParser) DoBind DoExpr
 
 parseLetDeclsParser :: TokParser [Decl]
 parseLetDeclsParser = expectedTok TkKeywordLet *> bracedDeclsMaybeEmpty
@@ -644,21 +633,28 @@
     EVar <$> parens operatorExprNameParser
 
 -- | Parse the operator inside a parenthesized operator expression such as
--- @(+)@, @(:)@, or @(-)@.
+-- @(+)@, @(:)@, or @(\@)@.
 --
--- Reserved operators such as @->@, @=>@, @::@, @|@, @<-@, @=@, @..@, and @\@@
--- are grammar, not names.  They have no term-level meaning, so this parser
--- rejects them, in the same way as GHC.
+-- Reserved operators such as @->@, @=>@, @::@, @|@, @<-@, @=@, and @..@ are
+-- grammar, not names.  They have no term-level meaning, so this parser rejects
+-- them, in the same way as GHC.
+--
+-- @\@@ is different: since the whitespace-sensitive @\@@ proposal, GHC's
+-- grammar admits @(\@)@ as an ordinary varsym, so @$(\@)@ and @(\@) 1 2@ parse
+-- and only fail later in the renamer.  A tight @\@@ lexes as 'TkReservedAt'
+-- (see 'Aihc.Parser.Lex.lexTypeApplication'), which is why it needs its own
+-- case here.
 operatorExprNameParser :: TokParser Name
 operatorExprNameParser =
   tokenSatisfy "operator" $ \tok ->
     case lexTokenKind tok of
-      TkVarSym sym -> Just (qualifyName Nothing (mkUnqualifiedNameAt tok NameVarSym sym))
-      TkConSym sym -> Just (qualifyName Nothing (mkUnqualifiedNameAt tok NameConSym sym))
+      TkVarSym sym -> Just (mkNameAt tok Nothing NameVarSym sym)
+      TkConSym sym -> Just (mkNameAt tok Nothing NameConSym sym)
       TkQVarSym modName sym -> Just (mkNameAt tok (Just modName) NameVarSym sym)
       TkQConSym modName sym -> Just (mkNameAt tok (Just modName) NameConSym sym)
-      TkMinusOperator -> Just (qualifyName Nothing (mkUnqualifiedNameAt tok NameVarSym "-"))
-      TkReservedColon -> Just (qualifyName Nothing (mkUnqualifiedNameAt tok NameConSym ":"))
+      TkMinusOperator -> Just (mkNameAt tok Nothing NameVarSym "-")
+      TkReservedColon -> Just (mkNameAt tok Nothing NameConSym ":")
+      TkReservedAt -> Just (mkNameAt tok Nothing NameVarSym "@")
       _ -> Nothing
 
 rhsParser :: TokParser (Rhs Expr)
@@ -741,7 +737,7 @@
   tok <- lookAhead anySingle
   case lexTokenKind tok of
     TkKeywordLet -> MP.try guardLetParser <|> guardBindOrExprParser arrowKind
-    _ -> MP.try guardPatBindParser <|> guardBindOrExprParser arrowKind
+    _ -> guardBindOrExprParser arrowKind
 
 -- | Parse a guard expression or pattern bind.
 guardBindOrExprParser :: RhsArrowKind -> TokParser GuardQualifier
@@ -753,12 +749,6 @@
       GuardPat
       GuardExpr
 
-guardPatBindParser :: TokParser GuardQualifier
-guardPatBindParser = withSpanAnn (GuardAnn . mkAnnotation) $ do
-  pat <- patternParser
-  expectedTok TkReservedLeftArrow
-  GuardPat pat <$> exprParser
-
 guardLetParser :: TokParser GuardQualifier
 guardLetParser = withSpanAnn (GuardAnn . mkAnnotation) $ do
   GuardLet <$> parseLetDeclsStmtParser
@@ -1053,7 +1043,7 @@
   case lexTokenKind tok of
     TkKeywordLet -> MP.try compLetStmtParser <|> compGenOrGuardParser
     TkKeywordThen -> compTransformStmtParser <|> compGenOrGuardParser
-    _ -> MP.try compPatGenParser <|> compGenOrGuardParser
+    _ -> compGenOrGuardParser
 
 -- | Parse a TransformListComp qualifier: @then f@, @then f by e@,
 -- @then group by e using f@, or @then group using f@.
@@ -1192,13 +1182,6 @@
   withSpanAnn (CompAnn . mkAnnotation) $
     exprOrPatternBindParser exprParser (region "while parsing '<-' generator" exprParser) CompGen CompGuard
 
-compPatGenParser :: TokParser CompStmt
-compPatGenParser = withSpanAnn (CompAnn . mkAnnotation) $ do
-  pat <- patternParser
-  expectedTok TkReservedLeftArrow
-  expr <- region "while parsing '<-' generator" exprParser
-  pure (CompGen pat expr)
-
 compLetStmtParser :: TokParser CompStmt
 compLetStmtParser = withSpanAnn (CompAnn . mkAnnotation) $ do
   CompLetDecls <$> parseLetDeclsStmtParser
@@ -1255,7 +1238,7 @@
     <|> implicitParamDeclParser
     <|> fixityDeclParser
     <|> (if typeSigPrefix then localTypeSigDeclsParser else MP.empty)
-    <|> MP.try localFunctionDeclParser
+    <|> localFunctionDeclParser
     <|> localPatternDeclParser
 
 localTypeSigDeclsParser :: TokParser Decl
@@ -1273,7 +1256,12 @@
 
 localFunctionDeclParser :: TokParser Decl
 localFunctionDeclParser = withSpanAnn (DeclAnn . mkAnnotation) $ do
-  (headForm, name, pats) <- functionHeadParserWith patParser apatParser
+  -- Only the head can require a retry as a pattern binding. A failed body
+  -- must not cause the same nested declarations to be parsed again.
+  (headForm, name, pats) <- MP.try $ do
+    headParts <- functionHeadParserWith patParser apatParser
+    lookAhead (expectedTok TkReservedEquals <|> expectedTok TkReservedPipe)
+    pure headParts
   functionBindDecl headForm name pats <$> equationRhsParser
 
 localPatternDeclParser :: TokParser Decl
@@ -1303,9 +1291,11 @@
   pure $ DeclImplicitParam name rhsExpr whereDecls
 
 varExprParser :: TokParser Expr
-varExprParser = do
-  (tok, name) <- identifierNameWithTokenParser
-  pure (EAnn (mkAnnotation (lexTokenSpan tok)) (EVar name))
+varExprParser =
+  tokenSatisfy "identifier" $ \tok ->
+    case identifierName tok of
+      Just name -> Just (EAnn (mkAnnotation (lexTokenSpan tok)) (EVar name))
+      Nothing -> Nothing
 
 implicitParamExprParser :: TokParser Expr
 implicitParamExprParser =
@@ -1326,7 +1316,7 @@
         Just $
           EAnn
             (mkAnnotation (lexTokenSpan tok))
-            (EVar (qualifyName Nothing (mkUnqualifiedNameAt tok NameVarId "_")))
+            (EVar (mkNameAt tok Nothing NameVarId "_"))
       _ -> Nothing
 
 -- | Parse Template Haskell quote brackets
diff --git a/src/Aihc/Parser/Internal/Pattern.hs b/src/Aihc/Parser/Internal/Pattern.hs
--- a/src/Aihc/Parser/Internal/Pattern.hs
+++ b/src/Aihc/Parser/Internal/Pattern.hs
@@ -71,9 +71,9 @@
     symbolicConOp =
       tokenSatisfy "constructor operator" $ \tok ->
         case lexTokenKind tok of
-          TkConSym op -> Just (qualifyName Nothing (mkUnqualifiedNameAt tok NameConSym op))
+          TkConSym op -> Just (mkNameAt tok Nothing NameConSym op)
           TkQConSym modName op -> Just (mkNameAt tok (Just modName) NameConSym op)
-          TkReservedColon -> Just (qualifyName Nothing (mkUnqualifiedNameAt tok NameConSym ":"))
+          TkReservedColon -> Just (mkNameAt tok Nothing NameConSym ":")
           _ -> Nothing
     backtickConOp =
       MP.try $
@@ -348,16 +348,32 @@
 -- fields, where there is no surrounding pair of parens to disambiguate the
 -- view-pattern arrow from the enclosing syntax.
 --
+-- Reuse a complete expression as a pattern when there is no view arrow.
+-- This avoids parsing each nested list or record again.
+--
 -- This parser is recursive so that deeply nested view patterns such as
 -- @expr1 -> expr2 -> pat@ are accepted without requiring explicit parentheses
 -- around each intermediate view pattern.
 subpatternWithBareViewParser :: TokParser Pattern
 subpatternWithBareViewParser = do
-  mView <- MP.optional . MP.try $ do
+  mResult <- MP.optional . MP.try $ do
     expr <- exprParser
-    expectedTok TkReservedRightArrow
-    PView expr <$> subpatternWithBareViewParser
-  maybe patternParser pure mView
+    tok <- lookAhead anySingle
+    case lexTokenKind tok of
+      TkReservedRightArrow -> pure (Left expr)
+      TkSpecialComma -> Right <$> liftCheck (checkPattern expr)
+      TkSpecialRBracket -> Right <$> liftCheck (checkPattern expr)
+      TkSpecialRBrace -> Right <$> liftCheck (checkPattern expr)
+      TkSpecialRParen -> Right <$> liftCheck (checkPattern expr)
+      TkSpecialUnboxedRParen -> Right <$> liftCheck (checkPattern expr)
+      TkReservedPipe -> Right <$> liftCheck (checkPattern expr)
+      _ -> fail "incomplete element parse"
+  case mResult of
+    Just (Left expr) -> do
+      expectedTok TkReservedRightArrow
+      PView expr <$> subpatternWithBareViewParser
+    Just (Right pat) -> pure pat
+    Nothing -> patternParser
 
 parenOrTuplePatternParser :: TokParser Pattern
 parenOrTuplePatternParser = withSpanAnn (PAnn . mkAnnotation) $ do
@@ -465,7 +481,7 @@
           isAs <- startsWithAsPattern
           if isAs
             then (False,) <$> patternParser
-            else (False,) <$> exprThenReclassify
+            else (False,) <$> subpatternWithBareViewParser
       where
         -- Try to parse an operator as a pattern if it's alone (followed by closing delim),
         -- otherwise fall back to parsing as an expression.
@@ -482,7 +498,7 @@
             Just TkSpecialComma -> (True,) <$> operatorPatternParser
             Just TkReservedPipe -> (True,) <$> operatorPatternParser
             -- Otherwise, try parsing as expression (for cases like (x + y))
-            _ -> (False,) <$> exprThenReclassify
+            _ -> (False,) <$> subpatternWithBareViewParser
 
         -- Parse an operator token as a variable or constructor pattern.
         operatorPatternParser :: TokParser Pattern
@@ -491,9 +507,9 @@
           let ann = mkAnnotation (lexTokenSpan tok')
           case lexTokenKind tok' of
             TkVarSym op -> pure (PAnn ann (PVar (mkUnqualifiedNameAt tok' NameVarSym op)))
-            TkConSym op -> pure (PAnn ann (PCon (qualifyName Nothing (mkUnqualifiedNameAt tok' NameConSym op)) [] []))
+            TkConSym op -> pure (PAnn ann (PCon (mkNameAt tok' Nothing NameConSym op) [] []))
             TkQConSym modName op -> pure (PAnn ann (PCon (mkNameAt tok' (Just modName) NameConSym op) [] []))
-            TkReservedColon -> pure (PAnn ann (PCon (qualifyName Nothing (mkUnqualifiedNameAt tok' NameConSym ":")) [] []))
+            TkReservedColon -> pure (PAnn ann (PCon (mkNameAt tok' Nothing NameConSym ":") [] []))
             TkReservedAt -> pure (PAnn ann (PVar (mkUnqualifiedNameAt tok' NameVarSym "@")))
             _ ->
               MP.customFailure
@@ -502,39 +518,6 @@
                     unexpectedExpecting = "operator token",
                     unexpectedContext = []
                   }
-
-    -- Try to parse as expression, then reclassify via checkPattern.
-    -- When exprParser fails, does not consume the full element (e.g.,
-    -- '@' from an as-pattern), or checkPattern rejects it (e.g., variable
-    -- operator in infix position), fall back to patternParser.
-    --
-    -- View patterns within tuple elements are also handled here: if '->'
-    -- follows the parsed expression, it is a view pattern.
-    exprThenReclassify :: TokParser Pattern
-    exprThenReclassify = do
-      mResult <- MP.optional . MP.try $ do
-        expr <- exprParser
-        -- Verify the expression consumed the full element: the next token
-        -- must be a valid delimiter in paren/tuple/sum context. If not
-        -- (e.g., '@' from an as-pattern), the expression parser stopped
-        -- too early and we should backtrack to patternParser.
-        tok <- lookAhead anySingle
-        case lexTokenKind tok of
-          TkReservedRightArrow -> pure (Left expr) -- view pattern: defer arrow handling
-          TkSpecialComma -> Right <$> liftCheck (checkPattern expr)
-          TkSpecialRParen -> Right <$> liftCheck (checkPattern expr)
-          TkSpecialUnboxedRParen -> Right <$> liftCheck (checkPattern expr)
-          TkReservedPipe -> Right <$> liftCheck (checkPattern expr)
-          _ -> fail "incomplete element parse"
-      case mResult of
-        Just (Left expr) -> do
-          -- View pattern: expr -> pattern
-          expectedTok TkReservedRightArrow
-          PView expr <$> subpatternWithBareViewParser
-        Just (Right pat) ->
-          pure pat
-        Nothing ->
-          patternParser
 
     tupleOrParenPatternParser tupleFlavor closeTok = do
       (isBareOp, first) <- parenPatElementParser
diff --git a/src/Aihc/Parser/Internal/Type.hs b/src/Aihc/Parser/Internal/Type.hs
--- a/src/Aihc/Parser/Internal/Type.hs
+++ b/src/Aihc/Parser/Internal/Type.hs
@@ -22,7 +22,7 @@
 import Aihc.Parser.Lex (LexTokenKind (..), lexTokenKind, lexTokenSpan, lexTokenText)
 import Aihc.Parser.Syntax
 import Data.Char (isLower)
-import Data.Functor (($>))
+import Data.Functor (($>), (<&>))
 import Data.Text qualified as T
 import Text.Megaparsec ((<|>))
 import Text.Megaparsec qualified as MP
@@ -261,13 +261,13 @@
     unpromotedInfixOperatorParser =
       tokenSatisfy "type infix operator" $ \tok ->
         case lexTokenKind tok of
-          TkReservedColon -> Just (qualifyName Nothing (mkUnqualifiedNameAt tok NameConSym ":"), Unpromoted)
+          TkReservedColon -> Just (mkNameAt tok Nothing NameConSym ":", Unpromoted)
           TkVarSym op
             | op /= "."
                 && op /= "!"
                 && op /= "'" ->
-                Just (qualifyName Nothing (mkUnqualifiedNameAt tok NameVarSym op), Unpromoted)
-          TkConSym op -> Just (qualifyName Nothing (mkUnqualifiedNameAt tok NameConSym op), Unpromoted)
+                Just (mkNameAt tok Nothing NameVarSym op, Unpromoted)
+          TkConSym op -> Just (mkNameAt tok Nothing NameConSym op, Unpromoted)
           TkQVarSym modName op -> Just (mkNameAt tok (Just modName) NameVarSym op, Unpromoted)
           TkQConSym modName op -> Just (mkNameAt tok (Just modName) NameConSym op, Unpromoted)
           _ -> Nothing
@@ -281,8 +281,8 @@
     typeOperatorIdentifierParser =
       tokenSatisfy "type operator identifier" $ \tok ->
         case lexTokenKind tok of
-          TkVarId name -> Just (qualifyName Nothing (mkUnqualifiedNameAt tok NameVarId name))
-          TkConId name -> Just (qualifyName Nothing (mkUnqualifiedNameAt tok NameConId name))
+          TkVarId name -> Just (mkNameAt tok Nothing NameVarId name)
+          TkConId name -> Just (mkNameAt tok Nothing NameConId name)
           TkQVarId modName name -> Just (mkNameAt tok (Just modName) NameVarId name)
           TkQConId modName name -> Just (mkNameAt tok (Just modName) NameConId name)
           _ -> Nothing
@@ -294,11 +294,11 @@
       -- or ':$$: for a promoted user-defined type operator)
       tokenSatisfy "promoted type infix operator" $ \tok ->
         case lexTokenKind tok of
-          TkReservedColon -> Just (qualifyName Nothing (mkUnqualifiedNameAt tok NameConSym ":"), Promoted)
+          TkReservedColon -> Just (mkNameAt tok Nothing NameConSym ":", Promoted)
           TkVarSym sym
             | sym /= "." && sym /= "!" ->
-                Just (qualifyName Nothing (mkUnqualifiedNameAt tok NameVarSym sym), Promoted)
-          TkConSym sym -> Just (qualifyName Nothing (mkUnqualifiedNameAt tok NameConSym sym), Promoted)
+                Just (mkNameAt tok Nothing NameVarSym sym, Promoted)
+          TkConSym sym -> Just (mkNameAt tok Nothing NameConSym sym, Promoted)
           TkQVarSym modQual sym -> Just (mkNameAt tok (Just modQual) NameVarSym sym, Promoted)
           TkQConSym modQual sym -> Just (mkNameAt tok (Just modQual) NameConSym sym, Promoted)
           _ -> Nothing
@@ -457,13 +457,13 @@
   unicodeSyntax <- isExtensionEnabled UnicodeSyntax
   op <- tokenSatisfy "type operator" $ \tok ->
     case lexTokenKind tok of
-      TkVarSym sym | not (isStarTypeSymbol starIsType unicodeSyntax sym) -> Just (qualifyName Nothing (mkUnqualifiedNameAt tok NameVarSym sym))
-      TkConSym sym | not (isStarTypeSymbol starIsType unicodeSyntax sym) -> Just (qualifyName Nothing (mkUnqualifiedNameAt tok NameConSym sym))
+      TkVarSym sym | not (isStarTypeSymbol starIsType unicodeSyntax sym) -> Just (mkNameAt tok Nothing NameVarSym sym)
+      TkConSym sym | not (isStarTypeSymbol starIsType unicodeSyntax sym) -> Just (mkNameAt tok Nothing NameConSym sym)
       TkQVarSym modQual sym -> Just (mkNameAt tok (Just modQual) NameVarSym sym)
       TkQConSym modQual sym -> Just (mkNameAt tok (Just modQual) NameConSym sym)
       -- Handle reserved operators that can be used as type constructors
-      TkReservedRightArrow -> Just (qualifyName Nothing (mkUnqualifiedNameAt tok NameVarSym "->"))
-      TkReservedColon -> Just (qualifyName Nothing (mkUnqualifiedNameAt tok NameConSym ":"))
+      TkReservedRightArrow -> Just (mkNameAt tok Nothing NameVarSym "->")
+      TkReservedColon -> Just (mkNameAt tok Nothing NameConSym ":")
       -- Note: ~ is now lexed as TkVarSym "~" so TkVarSym case handles it
       _ -> Nothing
   expectedTok TkSpecialRParen
@@ -481,15 +481,15 @@
       _ -> Nothing
 
 typeIdentifierParser :: TokParser Type
-typeIdentifierParser = do
-  (tok, name) <- identifierNameWithTokenParser
-  pure $
-    TAnn (mkAnnotation (lexTokenSpan tok)) $
-      case (nameQualifier name, nameType name, T.uncons (nameText name)) of
-        (Nothing, NameVarId, Just (c, _))
-          | isLower c || c == '_' ->
-              TVar (nameToUnqualified name)
-        _ -> TCon name Unpromoted
+typeIdentifierParser =
+  tokenSatisfy "identifier" $ \tok ->
+    identifierName tok <&> \name ->
+      TAnn (mkAnnotation (lexTokenSpan tok)) $
+        case (nameQualifier name, nameType name, T.uncons (nameText name)) of
+          (Nothing, NameVarId, Just (c, _))
+            | isLower c || c == '_' ->
+                TVar (nameToUnqualified name)
+          _ -> TCon name Unpromoted
 
 typeStarParser :: TokParser Type
 typeStarParser = do
diff --git a/src/Aihc/Parser/Lex.hs b/src/Aihc/Parser/Lex.hs
--- a/src/Aihc/Parser/Lex.hs
+++ b/src/Aihc/Parser/Lex.hs
@@ -296,8 +296,9 @@
     c :< rest
       | isIdentStart c ->
           let hasMagicHash = hasExt MagicHash env
-              (seg, rest0) = consumeIdentTail hasMagicHash rest
-              firstChunk = TU.takeWord8 (utf8CharWidth c + TU.lengthWord8 seg) (lexerInput st)
+              !firstChunkLen = utf8CharWidth c + identTailBytes hasMagicHash rest
+              firstChunk = TU.takeWord8 firstChunkLen (lexerInput st)
+              rest0 = TU.dropWord8 firstChunkLen (lexerInput st)
               (consumed, rest1, isQualified) = gatherQualified hasMagicHash False firstChunk rest0
            in case (isQualified || isConIdStart c, rest1) of
                 (True, '.' :< dotRest@(opChar :< _))
@@ -356,15 +357,23 @@
               | isConIdStart firstChar -> TkConId ident
               | otherwise -> TkVarId ident
 
+-- | Byte length of the identifier tail at the start of @inp@, including any
+-- run of trailing @#@ when MagicHash is enabled.
+--
+-- 'lexIdentifier' only needs this length, so returning it directly avoids
+-- materialising the two 'Text' slices that a @span@ would produce for every
+-- identifier in the input.
+identTailBytes :: Bool -> Text -> Int
+identTailBytes hasMH inp =
+  let !tailBytes = TU.lengthWord8 (T.takeWhile isIdentTail inp)
+   in if hasMH
+        then tailBytes + TU.lengthWord8 (T.takeWhile (== '#') (TU.dropWord8 tailBytes inp))
+        else tailBytes
+
 consumeIdentTail :: Bool -> Text -> (Text, Text)
 consumeIdentTail hasMH inp =
-  let (tailPart, rest) = T.span isIdentTail inp
-   in case rest of
-        '#' :< _
-          | hasMH ->
-              let hashes = T.takeWhile (== '#') rest
-               in (tailPart <> hashes, T.drop (T.length hashes) rest)
-        _ -> (tailPart, rest)
+  let !n = identTailBytes hasMH inp
+   in (TU.takeWord8 n inp, TU.dropWord8 n inp)
 
 lexImplicitParam :: LexerEnv -> LexerState -> Maybe (LexToken, LexerState)
 lexImplicitParam env st
@@ -1024,14 +1033,28 @@
                in go (n + segLen) (T.drop (T.length tailChars) more)
         _ -> (T.take n input, chars)
 
+-- | ASCII covers nearly every character in real source, and the Unicode
+-- branches below are all guarded by @not (isAscii c)@ anyway, so splitting on
+-- 'isAscii' first keeps the general-category tables out of the hot path.
 isIdentStart :: Char -> Bool
-isIdentStart c = isAsciiUpper c || isAsciiLower c || c == '_' || isUniSmall c || isUniLarge c || isUniOtherLetter c
+isIdentStart c
+  | isAscii c = isAsciiUpper c || isAsciiLower c || c == '_'
+  | otherwise = isUniSmall c || isUniLarge c || isUniOtherLetter c
 
 isVarIdentifierStartChar :: Char -> Bool
 isVarIdentifierStartChar c = c == '_' || isAsciiLower c || isUniSmall c
 
+-- | Identifier continuation characters.
+--
+-- For ASCII, 'isIdentContinue' reduces to 'isDigit': ASCII has no
+-- LetterNumber, ModifierLetter, NonSpacingMark or OtherNumber characters.  The
+-- ASCII branch below is therefore the same predicate as the general one, but
+-- without a general-category lookup -- which matters because this runs on
+-- every character of every identifier plus the character that ends it.
 isIdentTail :: Char -> Bool
-isIdentTail c = isIdentStart c || isIdentContinue c || c == '\''
+isIdentTail c
+  | isAscii c = isAsciiUpper c || isAsciiLower c || isDigit c || c == '_' || c == '\''
+  | otherwise = isIdentStart c || isIdentContinue c
 
 isConIdStart :: Char -> Bool
 isConIdStart c = isAsciiUpper c || isUniLarge c
@@ -1065,39 +1088,62 @@
     c :< _ -> isSymbolicOpChar c
     _ -> False
 
+-- | Classify an identifier as a keyword, if it is one.
+--
+-- Grouped by byte length so that an ordinary identifier is rejected after a
+-- single length comparison instead of being compared against all thirty
+-- keywords in turn.  Every keyword is ASCII, so its byte length is its
+-- character length; a non-ASCII identifier simply matches none of the
+-- literals in its group.
 keywordTokenKind :: ExtensionSet -> Text -> Maybe LexTokenKind
 keywordTokenKind exts txt =
-  case txt of
-    "case" -> Just TkKeywordCase
-    "class" -> Just TkKeywordClass
-    "data" -> Just TkKeywordData
-    "default" -> Just TkKeywordDefault
-    "deriving" -> Just TkKeywordDeriving
-    "do" -> Just TkKeywordDo
-    "else" -> Just TkKeywordElse
-    "forall" -> Just TkKeywordForall
-    "foreign" -> Just TkKeywordForeign
-    "if" -> Just TkKeywordIf
-    "import" -> Just TkKeywordImport
-    "in" -> Just TkKeywordIn
-    "infix" -> Just TkKeywordInfix
-    "infixl" -> Just TkKeywordInfixl
-    "infixr" -> Just TkKeywordInfixr
-    "instance" -> Just TkKeywordInstance
-    "let" -> Just TkKeywordLet
-    "module" -> Just TkKeywordModule
-    "newtype" -> Just TkKeywordNewtype
-    "of" -> Just TkKeywordOf
-    "then" -> Just TkKeywordThen
-    "type" -> Just TkKeywordType
-    "where" -> Just TkKeywordWhere
-    "_" -> Just TkKeywordUnderscore
-    "proc" | memberExtension Arrows exts -> Just TkKeywordProc
-    "rec" | memberExtension Arrows exts || memberExtension RecursiveDo exts -> Just TkKeywordRec
-    "mdo" | memberExtension RecursiveDo exts -> Just TkKeywordMdo
-    "pattern" | memberExtension PatternSynonyms exts -> Just TkKeywordPattern
-    "by" | memberExtension TransformListComp exts -> Just TkKeywordBy
-    "using" | memberExtension TransformListComp exts -> Just TkKeywordUsing
+  case TU.lengthWord8 txt of
+    1 -> case txt of
+      "_" -> Just TkKeywordUnderscore
+      _ -> Nothing
+    2 -> case txt of
+      "do" -> Just TkKeywordDo
+      "if" -> Just TkKeywordIf
+      "in" -> Just TkKeywordIn
+      "of" -> Just TkKeywordOf
+      "by" | memberExtension TransformListComp exts -> Just TkKeywordBy
+      _ -> Nothing
+    3 -> case txt of
+      "let" -> Just TkKeywordLet
+      "rec" | memberExtension Arrows exts || memberExtension RecursiveDo exts -> Just TkKeywordRec
+      "mdo" | memberExtension RecursiveDo exts -> Just TkKeywordMdo
+      _ -> Nothing
+    4 -> case txt of
+      "case" -> Just TkKeywordCase
+      "data" -> Just TkKeywordData
+      "else" -> Just TkKeywordElse
+      "then" -> Just TkKeywordThen
+      "type" -> Just TkKeywordType
+      "proc" | memberExtension Arrows exts -> Just TkKeywordProc
+      _ -> Nothing
+    5 -> case txt of
+      "class" -> Just TkKeywordClass
+      "infix" -> Just TkKeywordInfix
+      "where" -> Just TkKeywordWhere
+      "using" | memberExtension TransformListComp exts -> Just TkKeywordUsing
+      _ -> Nothing
+    6 -> case txt of
+      "forall" -> Just TkKeywordForall
+      "import" -> Just TkKeywordImport
+      "infixl" -> Just TkKeywordInfixl
+      "infixr" -> Just TkKeywordInfixr
+      "module" -> Just TkKeywordModule
+      _ -> Nothing
+    7 -> case txt of
+      "default" -> Just TkKeywordDefault
+      "foreign" -> Just TkKeywordForeign
+      "newtype" -> Just TkKeywordNewtype
+      "pattern" | memberExtension PatternSynonyms exts -> Just TkKeywordPattern
+      _ -> Nothing
+    8 -> case txt of
+      "deriving" -> Just TkKeywordDeriving
+      "instance" -> Just TkKeywordInstance
+      _ -> Nothing
     _ -> Nothing
 
 reservedOpTokenKind :: Text -> Maybe LexTokenKind
diff --git a/src/Aihc/Parser/Lex/Types.hs b/src/Aihc/Parser/Lex/Types.hs
--- a/src/Aihc/Parser/Lex/Types.hs
+++ b/src/Aihc/Parser/Lex/Types.hs
@@ -376,27 +376,43 @@
       sourceSpanEndOffset = lexerByteOffset end
     }
 
+-- | Consume a prefix of the input, updating the source position.
+--
+-- Every character advances the byte offset by its own UTF-8 width, so the new
+-- offset is just the old one plus the byte length of @consumed@; only the
+-- line/column/line-start fields need a scan.  That scan walks byte indices
+-- with 'TU.iter' so the UTF-8 width of each character comes from the iterator
+-- instead of being recomputed from the character.
 advanceChars :: Text -> LexerState -> LexerState
 advanceChars consumed st =
-  let go (!line, !col, !byteOff, !atLineStart) ch =
-        case ch of
-          '\n' -> (line + 1, 1, byteOff + 1, True)
-          '\t' ->
-            let nextTabStop = 8 - ((col - 1) `mod` 8)
-             in (line, col + nextTabStop, byteOff + 1, atLineStart)
-          ' ' -> (line, col + 1, byteOff + 1, atLineStart)
-          _
-            | isSpace ch -> (line, col + 1, byteOff + utf8CharWidth ch, atLineStart)
-            | otherwise -> (line, col + 1, byteOff + utf8CharWidth ch, False)
-      (!finalLine, !finalCol, !finalByteOff, !finalAtLineStart) =
-        T.foldl' go (lexerLine st, lexerCol st, lexerByteOffset st, lexerAtLineStart st) consumed
+  let !nbytes = TU.lengthWord8 consumed
+      go !i !line !col !atLineStart
+        | i >= nbytes = (line, col, atLineStart)
+        | otherwise =
+            let TU.Iter ch d = TU.iter consumed i
+             in case ch of
+                  '\n' -> go (i + d) (line + 1) 1 True
+                  '\t' ->
+                    let nextTabStop = 8 - ((col - 1) `mod` 8)
+                     in go (i + d) line (col + nextTabStop) atLineStart
+                  _
+                    -- Printable ASCII is the overwhelmingly common case and
+                    -- is never a space character, so it is settled before the
+                    -- 'isSpace' test.  Space itself (and any other space
+                    -- character) falls through to the guard below, which
+                    -- leaves 'atLineStart' alone exactly as before.
+                    | ch > ' ' && isAscii ch -> go (i + d) line (col + 1) False
+                    | isSpace ch -> go (i + d) line (col + 1) atLineStart
+                    | otherwise -> go (i + d) line (col + 1) False
+      (!finalLine, !finalCol, !finalAtLineStart) =
+        go 0 (lexerLine st) (lexerCol st) (lexerAtLineStart st)
    in st
         { -- The consumed text is a prefix of the input, so dropping its UTF-8
           -- byte length avoids a second scan of the characters.
-          lexerInput = TU.dropWord8 (TU.lengthWord8 consumed) (lexerInput st),
+          lexerInput = TU.dropWord8 nbytes (lexerInput st),
           lexerLine = finalLine,
           lexerCol = finalCol,
-          lexerByteOffset = finalByteOff,
+          lexerByteOffset = lexerByteOffset st + nbytes,
           lexerAtLineStart = finalAtLineStart
         }
 
@@ -468,8 +484,39 @@
       | code <= 0xFFFF -> 3
       | otherwise -> 4
 
+-- | Characters that may appear in a symbolic operator.
+--
+-- The ASCII branch lists exactly @:!#$%&*+./\<=>?\@\\^|-~@; every ASCII
+-- character that 'isUnicodeSymbol' would accept (@+ \< = > | ~ $@) is already
+-- in that list, so the split loses nothing.  It is written as a @case@ rather
+-- than @elem@ over a string because this predicate runs on nearly every lexed
+-- character and @elem@ would walk a 21-element list each time.
 isSymbolicOpChar :: Char -> Bool
-isSymbolicOpChar c = c `elem` (":!#$%&*+./<=>?@\\^|-~" :: String) || isUnicodeSymbol c
+isSymbolicOpChar c
+  | isAscii c =
+      case c of
+        ':' -> True
+        '!' -> True
+        '#' -> True
+        '$' -> True
+        '%' -> True
+        '&' -> True
+        '*' -> True
+        '+' -> True
+        '.' -> True
+        '/' -> True
+        '<' -> True
+        '=' -> True
+        '>' -> True
+        '?' -> True
+        '@' -> True
+        '\\' -> True
+        '^' -> True
+        '|' -> True
+        '-' -> True
+        '~' -> True
+        _ -> False
+  | otherwise = isUnicodeSymbol c
 
 isUnicodeSymbol :: Char -> Bool
 isUnicodeSymbol c =
diff --git a/src/Aihc/Parser/Syntax.hs b/src/Aihc/Parser/Syntax.hs
--- a/src/Aihc/Parser/Syntax.hs
+++ b/src/Aihc/Parser/Syntax.hs
@@ -650,16 +650,26 @@
     EnableExtension ext -> ext : filter (/= ext) extensions
     DisableExtension ext -> filter (/= ext) extensions
 
+-- | 'impliedExtensions' as a map.  The fixpoint below looks up every enabled
+-- extension on every iteration, which is too many linear scans of the table.
+impliedExtensionMap :: Map.Map Extension [ExtensionSetting]
+impliedExtensionMap = Map.fromList impliedExtensions
+
 applyImpliedExtensions :: [Extension] -> [Extension]
 applyImpliedExtensions extensions =
-  let settings = concat $ mapMaybe (`lookup` impliedExtensions) extensions
+  let settings = concat $ mapMaybe (`Map.lookup` impliedExtensionMap) extensions
       newExtensions = foldr applyExtensionSetting extensions settings
    in if sort newExtensions == sort extensions then extensions else applyImpliedExtensions newExtensions
 
+-- | Apply 'LANGUAGE' settings left to right, the order GHC applies them in,
+-- so that a later setting overrides an earlier one. Implications are applied
+-- immediately after each enable, so a later explicit disable can override an
+-- implication instead of having it resurrected by a final implication pass.
 effectiveExtensions :: LanguageEdition -> [ExtensionSetting] -> [Extension]
-effectiveExtensions edition extensionSettings =
-  applyImpliedExtensions $
-    foldr applyExtensionSetting (languageEditionExtensions edition) extensionSettings
+effectiveExtensions edition = List.foldl' applyOne (languageEditionExtensions edition)
+  where
+    applyOne extensions setting@(EnableExtension _) = applyImpliedExtensions (applyExtensionSetting setting extensions)
+    applyOne extensions setting@(DisableExtension _) = applyExtensionSetting setting extensions
 
 -- | Source location metadata for parsed syntax.
 -- Example: the span covering @map@ in @map f xs@.
diff --git a/src/Aihc/Parser/Types.hs b/src/Aihc/Parser/Types.hs
--- a/src/Aihc/Parser/Types.hs
+++ b/src/Aihc/Parser/Types.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE OverloadedStrings #-}
@@ -284,17 +285,19 @@
                   FromSource
                     | TkSpecialSemicolon <- kind -> tokStreamPendingPragmas ts
                     | otherwise -> []
-           in Just
-                ( tok,
-                  normalizeTokStreamParts
-                    (tokStreamRawTokens ts)
-                    (tokStreamLayoutState ts)
-                    rest
-                    pendingPragmas
-                    (Just tok)
-                    (tokStreamExtensionSet ts)
-                    isEOF
-                )
+              -- The successor is demanded as soon as the parser asks for the
+              -- token after this one, which is what almost always happens, so
+              -- building it here avoids a thunk per token.
+              !next =
+                normalizeTokStreamParts
+                  (tokStreamRawTokens ts)
+                  (tokStreamLayoutState ts)
+                  rest
+                  pendingPragmas
+                  (Just tok)
+                  (tokStreamExtensionSet ts)
+                  isEOF
+           in Just (tok, next)
         [] ->
           Nothing
 
diff --git a/test/Spec.hs b/test/Spec.hs
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -222,6 +222,7 @@
                 testCase "runs the parser when its result is forced" test_lazyForcesParserWhenResultIsForced,
                 testCase "preserves errors from the lazy parser" test_lazyPreservesErrors
               ],
+            testCase "preserves patterns in expression and binding positions" test_bindingPatternFallback,
             testCase "emits lexer error token for unterminated strings" test_unterminatedStringProducesErrorToken,
             testCase "emits lexer error token for unterminated block comments" test_unterminatedBlockCommentProducesErrorToken,
             testCase "applies hash line directives to subsequent tokens" test_hashLineDirectiveUpdatesSpan,
@@ -262,6 +263,7 @@
             testCase "syntax utility functions cover public edge cases" test_syntaxUtilityFunctions,
             testCase "shrunk class default pattern binds make progress" test_shrunkClassDefaultPatternBindMakesProgress,
             testCase "parsed binders carry source spans" test_parsedBindersCarrySourceSpans,
+            testCase "every top-level declaration carries a source span" test_everyTopLevelDeclarationCarriesSourceSpan,
             testCase "shrunk arrow command infix lhs modules make progress" test_shrunkArrowCommandInfixLhsModuleMakesProgress,
             testCase "shrunk wildcard pattern binds do not cycle" test_shrunkWildcardPatternBindsDoNotCycle,
             testCase "shrunk infix expression left operands do not cycle" test_shrunkInfixExprLeftOperandsDoNotCycle,
@@ -303,6 +305,10 @@
             testCase "parenthesizes if RHS before following infix operators" test_ifInfixRhsBeforeFollowingInfixParens,
             testCase "parenthesizes infix RHS operands inside left sections" test_infixRhsInsideLeftSectionParens,
             testCase "pretty-prints reserved at right sections" test_prettyReservedAtRightSection,
+            testCase "pretty-prints reserved at operator variables" test_prettyReservedAtOperatorVariable,
+            testCase "parses applications of reserved at operator variables" test_reservedAtOperatorVariableApplication,
+            testCase "parses reserved at operator variables in pattern splices" test_reservedAtOperatorVariableInPatternSplice,
+            testCase "rejects reserved operators as parenthesized operator expressions" test_parenOperatorExprRejectsReservedOperators,
             testCase "pretty-prints type applications after layout-ending functions" test_prettyTypeAppAfterLayoutEndingFunction,
             testCase "pretty-prints type signatures after layout-ending functions" test_prettyTypeSigAfterLayoutEndingFunction,
             testCase "pretty-prints operators after layout-rendered do blocks" test_prettyOperatorAfterLayoutDoBlock,
@@ -600,6 +606,64 @@
               assertUnqualifiedNameSpan "foreign binder" "<input>" 4 28 4 33 87 92 (foreignName foreignDecl)
           other -> assertFailure ("expected data, value, operator, and foreign declarations, got: " <> show other)
 
+-- | Every top-level declaration form must be wrapped in 'DeclAnn' with a real
+-- source span, so that consumers (e.g. haddock comment attachment) can locate
+-- declarations by position. Regression test for 'DeclPatSynSig', 'DeclDefault'
+-- and 'DeclSplice', which used to be returned unwrapped.
+test_everyTopLevelDeclarationCarriesSourceSpan :: Assertion
+test_everyTopLevelDeclarationCarriesSourceSpan =
+  let source =
+        T.unlines
+          [ "{-# LANGUAGE PatternSynonyms, RoleAnnotations, StandaloneDeriving #-}",
+            "{-# LANGUAGE StandaloneKindSignatures, TemplateHaskell, TypeData #-}",
+            "{-# LANGUAGE TypeFamilies #-}",
+            "module M where",
+            "import Data.Kind (Type)",
+            "type T :: Type -> Type",
+            "data T a = MkT a",
+            "type role T nominal",
+            "type data N = Z",
+            "newtype I a = I a",
+            "type P a = (a, a)",
+            "class C a where { m :: a -> a }",
+            "instance C Int where { m = id }",
+            "deriving instance Show (T Int)",
+            "default (Integer, Double)",
+            "infixr 5 `seq`",
+            "f, g :: Int -> Int",
+            "f = id",
+            "g = id",
+            "foreign import ccall \"puts\" c_puts :: Int -> IO Int",
+            "type family F a",
+            "data family DF a",
+            "type instance F Int = Bool",
+            "data instance DF Int = DFInt",
+            "{-# INLINE f #-}",
+            "pattern Q :: Int -> T Int",
+            "pattern Q x = MkT x",
+            "$(pure [])"
+          ]
+      -- 'DeclAnn' is the wrapper itself and 'DeclImplicitParam' only occurs in
+      -- local binding groups, so neither can appear at the top level.
+      nonTopLevelConstrs = Set.fromList ["DeclAnn", "DeclImplicitParam"]
+      allConstrs =
+        Set.fromList (map showConstr (dataTypeConstrs (dataTypeOf (undefined :: Decl))))
+          `Set.difference` nonTopLevelConstrs
+      (errs, modu) = parseModule defaultConfig source
+   in do
+        assertBool ("expected no parse errors, got: " <> show errs) (null errs)
+        let lacksSpan decl = case decl of
+              DeclAnn ann _ -> isNothing (fromAnnotation ann :: Maybe SourceSpan)
+              _ -> True
+            unannotated =
+              [showConstr (toConstr decl) | decl <- moduleDecls modu, lacksSpan decl]
+        assertEqual "declarations without a DeclAnn source span" [] unannotated
+        let covered = Set.fromList (map (showConstr . toConstr . peelDeclAnn) (moduleDecls modu))
+        assertEqual
+          "declaration forms not exercised by this fixture"
+          Set.empty
+          (allConstrs `Set.difference` covered)
+
 test_emptyCaseLayoutAtEof :: Assertion
 test_emptyCaseLayoutAtEof =
   let source = "x = case () of"
@@ -1483,6 +1547,43 @@
   assertEqual "pretty-printed expression" "(@ ())" rendered
   assertExprRenderingRoundTrip defaultConfig expr rendered
 
+test_prettyReservedAtOperatorVariable :: Assertion
+test_prettyReservedAtOperatorVariable = do
+  let expr = EVar (qualifyName Nothing (mkUnqualifiedName NameVarSym "@"))
+      rendered = renderPretty expr
+  assertEqual "pretty-printed expression" "(@)" rendered
+  assertExprRenderingRoundTrip defaultConfig expr rendered
+
+test_reservedAtOperatorVariableApplication :: Assertion
+test_reservedAtOperatorVariableApplication =
+  assertParsedStrippedDeclShapeRoundTrip defaultConfig "f = (@) 1 2"
+
+test_reservedAtOperatorVariableInPatternSplice :: Assertion
+test_reservedAtOperatorVariableInPatternSplice = do
+  let config = defaultConfig {parserExtensions = requiredExtensions}
+      source =
+        """
+        _ = [[]
+         | let $(@) `a` _ = []]
+        """
+  assertParsedStrippedDeclShapeRoundTrip config source
+
+test_parenOperatorExprRejectsReservedOperators :: Assertion
+test_parenOperatorExprRejectsReservedOperators =
+  mapM_ assertRejected ["(->)", "(=>)", "(::)", "(|)", "(<-)", "(=)", "(..)"]
+  where
+    config = defaultConfig {parserExtensions = requiredExtensions}
+    assertRejected source =
+      case parseExpr config source of
+        ParseErr {} -> pure ()
+        ParseOk expr ->
+          assertFailure
+            ( "expected parse failure for "
+                <> T.unpack source
+                <> ", got: "
+                <> show (shorthand (stripAnnotations expr))
+            )
+
 test_prettyTypeAppAfterLayoutEndingFunction :: Assertion
 test_prettyTypeAppAfterLayoutEndingFunction = do
   let config = defaultConfig {parserExtensions = requiredExtensions}
@@ -2273,3 +2374,27 @@
             ]
         )
         (null failures)
+
+-- Each suffix must trigger the fallback without an earlier pattern prefix.
+test_bindingPatternFallback :: Assertion
+test_bindingPatternFallback =
+  mapM_ check ["K !x", "K ~x", "K y@(Just z)", "x@(Just y)", "(id -> x)", "x :: Int", "(x, y)", "(-1)", "(:)", "(,)", "[x, y]"]
+  where
+    config = defaultConfig {parserExtensions = [BangPatterns, ViewPatterns, ScopedTypeVariables]}
+    check source = case parsePattern config source of
+      ParseErr errs -> assertFailure (formatParseErrors "<test>" (Just source) errs)
+      ParseOk expected ->
+        mapM_
+          (checkContext (stripAnnotations expected))
+          [ "do { " <> source <> " <- xs; pure () }",
+            "[() | " <> source <> " <- xs]",
+            "case () of { _ | " <> source <> " <- xs -> () }"
+          ]
+    checkContext expected source = case parseExpr config source of
+      ParseErr errs -> assertFailure (formatParseErrors "<test>" (Just source) errs)
+      ParseOk expr -> case stripAnnotations expr of
+        EDo [DoBind pat _, DoExpr _] _ -> assertEqual (T.unpack source) expected pat
+        EListComp _ [CompGen pat _] -> assertEqual (T.unpack source) expected pat
+        ECase _ [CaseAlt _ _ (GuardedRhss _ [GuardedRhs _ [GuardPat pat _] _] Nothing)] ->
+          assertEqual (T.unpack source) expected pat
+        actual -> assertFailure ("unexpected binding structure: " <> show actual)
diff --git a/test/Test/Fixtures/golden/expr/let-binding-head-fallback.yaml b/test/Test/Fixtures/golden/expr/let-binding-head-fallback.yaml
new file mode 100644
--- /dev/null
+++ b/test/Test/Fixtures/golden/expr/let-binding-head-fallback.yaml
@@ -0,0 +1,6 @@
+extensions: []
+input: |
+  let { x@(Just y) = value; f z = z; (a, b) = pair } in y
+ast: |-
+  ELetDecls [DeclValue (PatternBind (PAs UnqualifiedName {"x"} (PParen (PCon "Just" [PVar "y"]))) (EVar "value")), DeclValue (FunctionBind "f" [Match {MatchHeadPrefix, [PVar "z"], EVar "z"}]), DeclValue (PatternBind (PTuple [PVar "a", PVar "b"]) (EVar "pair"))] (EVar "y")
+status: pass
diff --git a/test/Test/Fixtures/golden/expr/proc-parenthesized-bind-fallback.yaml b/test/Test/Fixtures/golden/expr/proc-parenthesized-bind-fallback.yaml
new file mode 100644
--- /dev/null
+++ b/test/Test/Fixtures/golden/expr/proc-parenthesized-bind-fallback.yaml
@@ -0,0 +1,6 @@
+extensions: [Arrows]
+input: |
+  proc x -> do { (Just y) <- f -< x; (z@(Just w)) <- g -< y; ((returnA -< w)) }
+ast: |-
+  EProc (PVar "x") (CmdDo [DoBind (PParen (PCon "Just" [PVar "y"])) (CmdArrApp (EVar "f") HsFirstOrderApp (EVar "x")), DoBind (PParen (PAs UnqualifiedName {"z"} (PParen (PCon "Just" [PVar "w"])))) (CmdArrApp (EVar "g") HsFirstOrderApp (EVar "y")), DoExpr (CmdPar (CmdPar (CmdArrApp (EVar "returnA") HsFirstOrderApp (EVar "w"))))])
+status: pass
diff --git a/test/Test/Fixtures/golden/pattern/list-pattern-fallback.yaml b/test/Test/Fixtures/golden/pattern/list-pattern-fallback.yaml
new file mode 100644
--- /dev/null
+++ b/test/Test/Fixtures/golden/pattern/list-pattern-fallback.yaml
@@ -0,0 +1,6 @@
+extensions: [BangPatterns, ViewPatterns]
+input: |
+  [K !x, K ~y, z@(Just w), id -> [a, b]]
+ast: |-
+  PList [PCon "K" [PStrict (PVar "x")], PCon "K" [PIrrefutable (PVar "y")], PAs UnqualifiedName {"z"} (PParen (PCon "Just" [PVar "w"])), PView (EVar "id") (PList [PVar "a", PVar "b"])]
+status: pass
diff --git a/test/Test/Fixtures/golden/pattern/record-pattern-fallback.yaml b/test/Test/Fixtures/golden/pattern/record-pattern-fallback.yaml
new file mode 100644
--- /dev/null
+++ b/test/Test/Fixtures/golden/pattern/record-pattern-fallback.yaml
@@ -0,0 +1,6 @@
+extensions: [BangPatterns, ViewPatterns]
+input: |
+  Box {first = [[x]], second = id -> K !y, third = z@(Just w)}
+ast: |-
+  PRecord "Box" {"first" = PList [PList [PVar "x"]], "second" = PView (EVar "id") (PCon "K" [PStrict (PVar "y")]), "third" = PAs UnqualifiedName {"z"} (PParen (PCon "Just" [PVar "w"]))}
+status: pass
diff --git a/test/Test/Fixtures/oracle/TypeApplications/at-operator-in-parens.hs b/test/Test/Fixtures/oracle/TypeApplications/at-operator-in-parens.hs
new file mode 100644
--- /dev/null
+++ b/test/Test/Fixtures/oracle/TypeApplications/at-operator-in-parens.hs
@@ -0,0 +1,22 @@
+{- ORACLE_TEST pass -}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeApplications #-}
+module AtOperatorInParens where
+
+-- Regression test: '(@)' is an ordinary parenthesized varsym.
+--
+-- A tight '@' (no preceding whitespace) lexes as TkReservedAt, and
+-- operatorExprNameParser used to reject that token, so '(@)' failed to parse
+-- even though GHC accepts it and only rejects it later, in the renamer.
+-- The pretty-printer already rendered EVar '@' as '(@)', so any generated AST
+-- containing that name failed to round-trip.
+
+f = (@)
+
+g = (@) 1 2
+
+h = (@ ())
+
+i = $(@)
+
+j x = x @Int
diff --git a/test/Test/Performance/Suite.hs b/test/Test/Performance/Suite.hs
--- a/test/Test/Performance/Suite.hs
+++ b/test/Test/Performance/Suite.hs
@@ -6,7 +6,7 @@
 where
 
 import Aihc.Parser
-import Aihc.Parser.Syntax (Extension, parseExtensionName)
+import Aihc.Parser.Syntax (Extension (Arrows, PatternSynonyms, RecursiveDo, ViewPatterns), parseExtensionName)
 import Control.DeepSeq (force)
 import Control.Exception (evaluate)
 import Data.Aeson ((.!=), (.:), (.:?))
@@ -43,6 +43,22 @@
 generatedCaseSize :: Int
 generatedCaseSize = 200
 
+-- | Depth for nested list-pattern cases. Keep the source below 10KiB.
+listPatternSize :: Int
+listPatternSize = 4000
+
+-- | Depth for nested record-pattern cases. Keep the source below 10KiB.
+recordPatternSize :: Int
+recordPatternSize = 2000
+
+-- | Depth for nested view-pattern cases. Keep the source below 10KiB.
+viewPatternSize :: Int
+viewPatternSize = 1200
+
+-- | Depth for nested proc-do command parentheses. Keep the source below 10KiB.
+procDoParenSize :: Int
+procDoParenSize = 2000
+
 parserPerformanceTests :: IO TestTree
 parserPerformanceTests = do
   fixtureCases <- loadPerfCases
@@ -96,13 +112,14 @@
               }
             (perfCaseInput perfCase)
   case (perfCaseStatus perfCase, outcome) of
-    (StatusPass, Nothing) ->
-      assertFailure
-        ( "module parse exceeded "
-            <> show timeoutMicros
-            <> "us for "
-            <> perfCaseId perfCase
-        )
+    (status, Nothing)
+      | status /= StatusXFail ->
+          assertFailure
+            ( "module parse exceeded "
+                <> show timeoutMicros
+                <> "us for "
+                <> perfCaseId perfCase
+            )
     (StatusPass, Just (errs, _))
       | not (null errs) ->
           assertFailure
@@ -111,6 +128,8 @@
                 <> ", got parse error: "
                 <> formatParseErrors (perfCaseSourceName perfCase) (Just (perfCaseInput perfCase)) errs
             )
+    (StatusFail, Just (errs, _))
+      | null errs -> assertFailure ("expected parse failure for performance case " <> perfCaseId perfCase)
     (StatusXFail, Nothing) -> pure ()
     (StatusXFail, Just (errs, _))
       | null errs ->
@@ -175,6 +194,7 @@
     parseStatus fixturePath raw =
       case map toLower (T.unpack (T.strip raw)) of
         "pass" -> Right StatusPass
+        "fail" -> Right StatusFail
         "xfail" -> Right StatusXFail
         _ -> Left ("Invalid [status] in " <> fixturePath <> ": " <> T.unpack raw)
 
@@ -220,7 +240,173 @@
     mkGeneratedPerfCase "type-parameters" (mkTypeModule (typeWithParameters generatedCaseSize)),
     mkGeneratedPerfCase "string-escapes" (mkExprModule (escapedStringExpr (generatedCaseSize * 500))),
     mkGeneratedPerfCase "nested-application" (mkExprModule (nestedAppExpr generatedCaseSize)),
-    mkGeneratedPerfCaseWithStatus "xfail-invalid-module" "module Generated where\nvalue = { x = 1, }\n" StatusXFail "regression coverage"
+    mkGeneratedPerfCaseWithStatus "invalid-module" "module Generated where\nvalue = { x = 1, }\n" StatusFail "",
+    -- Nested block expressions must not be parsed again as patterns.
+    mkGeneratedPerfCase "nested-paren-do" (mkExprModule (nestedParenDoExpr generatedCaseSize)),
+    mkGeneratedPerfCase "nested-paren-do-case" (mkExprModule (nestedParenDoCaseExpr generatedCaseSize)),
+    mkGeneratedPerfCase "nested-paren-do-if" (mkExprModule (nestedParenDoIfExpr generatedCaseSize)),
+    mkGeneratedPerfCase "nested-paren-do-lambda" (mkExprModule (nestedParenDoLambdaExpr generatedCaseSize)),
+    mkGeneratedPerfCase "nested-paren-do-let" (mkExprModule (nestedParenDoLetExpr generatedCaseSize)),
+    mkGeneratedPerfCase "nested-paren-do-comp" (mkCompModule (nestedParenDoExpr generatedCaseSize)),
+    mkGeneratedPerfCase "nested-paren-do-guard" (mkGuardModule (nestedParenDoExpr generatedCaseSize)),
+    mkGeneratedPerfCase
+      "nested-paren-do-bind"
+      (mkExprModule (nestedWrap "do { x <- (" "); pure x }" "pure 1" generatedCaseSize)),
+    mkGeneratedPerfCaseFull
+      "nested-paren-mdo"
+      generatedCaseSize
+      [RecursiveDo]
+      (mkExprModule ("mdo { (" <> nestedParenDoExpr generatedCaseSize <> ") }"))
+      StatusPass
+      "",
+    mkGeneratedPerfCaseFull
+      "malformed-nested-proc-do-blocks"
+      generatedCaseSize
+      [Arrows]
+      (mkProcModule (nestedParenDoExpr generatedCaseSize))
+      StatusFail
+      "",
+    mkGeneratedPerfCaseFull
+      "nested-proc-do-blocks"
+      generatedCaseSize
+      [Arrows]
+      (mkProcModule (nestedWrap "do { (" ") }" "returnA -< x" generatedCaseSize))
+      StatusPass
+      "",
+    mkGeneratedPerfCaseFull
+      "malformed-nested-let"
+      generatedCaseSize
+      []
+      (mkExprModule (malformedNestedLetExpr generatedCaseSize))
+      StatusFail
+      "",
+    -- Nested patterns must reuse the expression parse.
+    mkGeneratedPerfCaseFull
+      "nested-list-pattern"
+      listPatternSize
+      []
+      (mkTuplePatternFunctionModule (nestedListPattern listPatternSize))
+      StatusPass
+      "",
+    mkGeneratedPerfCaseFull
+      "nested-list-pattern-bind"
+      listPatternSize
+      []
+      (mkPatBindModule (nestedListPattern listPatternSize))
+      StatusPass
+      "",
+    mkGeneratedPerfCaseFull
+      "nested-list-pattern-case"
+      listPatternSize
+      []
+      (mkCaseModule (nestedListPattern listPatternSize))
+      StatusPass
+      "",
+    mkGeneratedPerfCaseFull
+      "nested-list-pattern-lambda"
+      listPatternSize
+      []
+      (mkLambdaModule (nestedListPattern listPatternSize))
+      StatusPass
+      "",
+    mkGeneratedPerfCaseFull
+      "nested-list-pattern-do"
+      listPatternSize
+      []
+      (mkDoStmtModule (nestedListPattern listPatternSize))
+      StatusPass
+      "",
+    mkGeneratedPerfCaseFull
+      "nested-list-pattern-guard"
+      listPatternSize
+      []
+      (mkGuardModule (nestedListPattern listPatternSize))
+      StatusPass
+      "",
+    mkGeneratedPerfCaseFull
+      "nested-list-pattern-comp"
+      listPatternSize
+      []
+      (mkCompModule (nestedListPattern listPatternSize))
+      StatusPass
+      "",
+    mkGeneratedPerfCaseFull
+      "nested-list-pattern-where"
+      listPatternSize
+      []
+      (mkWherePatModule (nestedListPattern listPatternSize))
+      StatusPass
+      "",
+    mkGeneratedPerfCaseFull
+      "nested-list-pattern-synonym"
+      listPatternSize
+      [PatternSynonyms]
+      (mkPatSynModule (nestedListPattern listPatternSize))
+      StatusPass
+      "",
+    mkGeneratedPerfCaseFull
+      "nested-list-tuple-pattern"
+      listPatternSize
+      []
+      (mkTuplePatternFunctionModule (nestedWrap "[" "]" "(x, y)" listPatternSize))
+      StatusPass
+      "",
+    mkGeneratedPerfCaseFull
+      "nested-record-pattern"
+      recordPatternSize
+      []
+      (mkTuplePatternFunctionModule (nestedRecordPattern recordPatternSize))
+      StatusPass
+      "",
+    mkGeneratedPerfCaseFull
+      "nested-record-pattern-bind"
+      recordPatternSize
+      []
+      (mkPatBindModule (nestedRecordPattern recordPatternSize))
+      StatusPass
+      "",
+    mkGeneratedPerfCaseFull
+      "nested-record-pattern-case"
+      recordPatternSize
+      []
+      (mkCaseModule (nestedRecordPattern recordPatternSize))
+      StatusPass
+      "",
+    mkGeneratedPerfCaseFull
+      "nested-record-pattern-lambda"
+      recordPatternSize
+      []
+      (mkLambdaModule (nestedRecordPattern recordPatternSize))
+      StatusPass
+      "",
+    mkGeneratedPerfCaseFull
+      "nested-view-pattern"
+      viewPatternSize
+      [ViewPatterns]
+      (mkTuplePatternFunctionModule (nestedViewPattern viewPatternSize))
+      StatusPass
+      "",
+    mkGeneratedPerfCaseFull
+      "nested-view-pattern-bind"
+      viewPatternSize
+      [ViewPatterns]
+      (mkPatBindModule (nestedViewPattern viewPatternSize))
+      StatusPass
+      "",
+    mkGeneratedPerfCaseFull
+      "nested-view-pattern-case"
+      viewPatternSize
+      [ViewPatterns]
+      (mkCaseModule (nestedViewPattern viewPatternSize))
+      StatusPass
+      "",
+    mkGeneratedPerfCaseFull
+      "nested-proc-do-parens"
+      procDoParenSize
+      [Arrows]
+      (mkProcModule ("do { " <> nestedWrap "(" ")" "returnA -< x" procDoParenSize <> " }"))
+      StatusPass
+      ""
   ]
 
 mkGeneratedPerfCase :: String -> Text -> PerfCase
@@ -228,12 +414,16 @@
   mkGeneratedPerfCaseWithStatus label inputText StatusPass ""
 
 mkGeneratedPerfCaseWithStatus :: String -> Text -> ExpectedStatus -> String -> PerfCase
-mkGeneratedPerfCaseWithStatus label inputText status reason =
-  let caseId = "generated/" <> label <> "-" <> show generatedCaseSize <> ".hs"
+mkGeneratedPerfCaseWithStatus label =
+  mkGeneratedPerfCaseFull label generatedCaseSize []
+
+mkGeneratedPerfCaseFull :: String -> Int -> [Extension] -> Text -> ExpectedStatus -> String -> PerfCase
+mkGeneratedPerfCaseFull label size exts inputText status reason =
+  let caseId = "generated/" <> label <> "-" <> show size <> ".hs"
    in PerfCase
         { perfCaseId = caseId,
           perfCaseSourceName = caseId,
-          perfCaseExtensions = [],
+          perfCaseExtensions = exts,
           perfCaseInput = inputText,
           perfCaseStatus = status,
           perfCaseReason = reason
@@ -253,6 +443,65 @@
 
 mkDataModule :: Text -> Text
 mkDataModule decl = T.unlines ["module Generated where", decl]
+
+mkPatBindModule :: Text -> Text
+mkPatBindModule pat = T.unlines ["module Generated where", pat <> " = ()"]
+
+mkCaseModule :: Text -> Text
+mkCaseModule pat = T.unlines ["module Generated where", "fn v = case v of", "  " <> pat <> " -> ()"]
+
+mkLambdaModule :: Text -> Text
+mkLambdaModule pat = T.unlines ["module Generated where", "fn = \\" <> pat <> " -> ()"]
+
+mkDoStmtModule :: Text -> Text
+mkDoStmtModule stmt = T.unlines ["module Generated where", "fn = do", "  " <> stmt, "  pure ()"]
+
+mkGuardModule :: Text -> Text
+mkGuardModule guard = T.unlines ["module Generated where", "fn | " <> guard <> " = ()"]
+
+mkCompModule :: Text -> Text
+mkCompModule qual = T.unlines ["module Generated where", "fn = [() | " <> qual <> "]"]
+
+mkWherePatModule :: Text -> Text
+mkWherePatModule pat = T.unlines ["module Generated where", "fn = ()", "  where", "    " <> pat <> " = ()"]
+
+mkPatSynModule :: Text -> Text
+mkPatSynModule pat = T.unlines ["module Generated where", "pattern P = " <> pat]
+
+mkProcModule :: Text -> Text
+mkProcModule cmd = T.unlines ["module Generated where", "fn = proc x -> " <> cmd]
+
+-- | Wrap an inner term in @n@ copies of an open/close pair.
+nestedWrap :: Text -> Text -> Text -> Int -> Text
+nestedWrap open close inner n =
+  T.concat (replicate n open) <> inner <> T.concat (replicate n close)
+
+nestedParenDoExpr :: Int -> Text
+nestedParenDoExpr = nestedWrap "do { (" ") }" "pure 1"
+
+nestedParenDoCaseExpr :: Int -> Text
+nestedParenDoCaseExpr = nestedWrap "do { (case x of { _ -> " " }) }" "1"
+
+nestedParenDoIfExpr :: Int -> Text
+nestedParenDoIfExpr = nestedWrap "do { (if True then " " else 0) }" "1"
+
+nestedParenDoLambdaExpr :: Int -> Text
+nestedParenDoLambdaExpr = nestedWrap "do { (\\x -> " ") }" "x"
+
+nestedParenDoLetExpr :: Int -> Text
+nestedParenDoLetExpr = nestedWrap "do { (let x = " " in x) }" "1"
+
+malformedNestedLetExpr :: Int -> Text
+malformedNestedLetExpr n = nestedWrap "let x = " " in " "1" n <> "x"
+
+nestedListPattern :: Int -> Text
+nestedListPattern = nestedWrap "[" "]" "x"
+
+nestedRecordPattern :: Int -> Text
+nestedRecordPattern = nestedWrap "T{x=" "}" "y"
+
+nestedViewPattern :: Int -> Text
+nestedViewPattern = nestedWrap "(id -> " ")" "x"
 
 nestedTupleExpr :: Int -> Text
 nestedTupleExpr n =