aihc-parser 1.0.0.5 → 1.0.0.6

raw patch · 8 files changed

+118/−24 lines, 8 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +7/−0
• aihc-parser.cabal +1/−1
• src/Aihc/Parser.hs +0/−1
• src/Aihc/Parser/Internal/Common.hs +26/−0
• src/Aihc/Parser/Internal/Decl.hs +2/−2
• src/Aihc/Parser/Internal/FromTokens.hs +7/−4
• src/Aihc/Parser/Internal/Module.hs +30/−15
• test/Spec.hs +45/−1

@@ -6,6 +6,13 @@  ## [Unreleased] +## [1.0.0.6] - 2026-09-02++### Changed++- Deferred module declaration parsing until declarations, parse errors, or the+  module span are demanded.+ ## [1.0.0.5] - 2026-07-27  ### Fixed

@@ -1,6 +1,6 @@ cabal-version: 3.8 name: aihc-parser-version: 1.0.0.5+version: 1.0.0.6 build-type: Simple license: Unlicense license-file: LICENSE

@@ -166,7 +166,6 @@   let ts = mkTokStreamModule (parserSourceName cfg) (applyImpliedExtensions (parserExtensions cfg)) input       parser = do         modu <- moduleParser-        _ <- eofTok         errs <- drainParseErrors         pure (errs, modu)    in case runParser parser (parserSourceName cfg) ts of

@@ -37,6 +37,7 @@     optionalSuffix,     parens,     braces,+    closeAndExpectRBrace,     thQuoteParser,     skipSemicolons,     bracedSemiSep,@@ -61,6 +62,7 @@     layoutSepEndBy,     layoutSepBy1,     drainParseErrors,+    lazy,     startsWithContextType,     startsWithTypeSig,     startsWithAsPattern,@@ -967,6 +969,30 @@   let errs = MP.stateParseErrors st   MP.updateParserState (\s -> s {MP.stateParseErrors = []})   pure errs++-- | Run a terminal parser from a copy of the current state when its result is+-- demanded. The outer parser does not advance. Recovered errors are retained+-- in the returned state; a complete failure returns 'mempty'.+lazy :: (Monoid a) => TokParser a -> TokParser (a, MP.State TokStream ParserErrorComponent)+lazy parser = do+  initialState <- MP.getParserState+  let ~(value, finalState) =+        case MP.runParser' captureResult initialState of+          (_, Right parsed) -> parsed+          (failedState, Left bundle) ->+            ( mempty,+              failedState+                { MP.stateParseErrors =+                    reverse (NE.toList (MPE.bundleErrors bundle))+                }+            )+  pure (value, finalState)+  where+    captureResult = do+      value <- parser+      finalState <- MP.getParserState+      MP.updateParserState (\state -> state {MP.stateParseErrors = []})+      pure (value, finalState)  -- | Non-consuming lookahead dispatch for optional context types. -- Uses scanning to probe for @=>@ at top bracket depth.

@@ -1504,14 +1504,14 @@ bangTypeParserWith typeP = withSpan $ do   pragmas <- MP.option [] (fmap (: []) unpackPragmaParser)   strict <- MP.option False (expectedTok TkPrefixBang >> pure True)-  lazy <- MP.option False (expectedTok TkPrefixTilde >> pure True)+  isLazy <- MP.option False (expectedTok TkPrefixTilde >> pure True)   ty <- typeP   pure $ \span' ->     BangType       { bangAnns = [mkAnnotation span'],         bangPragmas = pragmas,         bangStrict = strict,-        bangLazy = lazy,+        bangLazy = isLazy,         bangType = ty       } 

@@ -35,12 +35,15 @@ import Aihc.Parser.Types import Text.Megaparsec (runParser) -parseFromTokens :: TokParser a -> FilePath -> [LexToken] -> ParseResult a-parseFromTokens parser sourceName toks =-  case runParser (parser <* eofTok) sourceName (mkTokStreamFromTokens toks) of+runParserFromTokens :: TokParser a -> FilePath -> [LexToken] -> ParseResult a+runParserFromTokens parser sourceName toks =+  case runParser parser sourceName (mkTokStreamFromTokens toks) of     Left bundle -> ParseErr (parseErrorBundleToSpannedText bundle)     Right parsed -> ParseOk parsed +parseFromTokens :: TokParser a -> FilePath -> [LexToken] -> ParseResult a+parseFromTokens parser = runParserFromTokens (parser <* eofTok)+ parseExprFromTokens :: FilePath -> [LexToken] -> ParseResult Expr parseExprFromTokens = parseFromTokens exprParser @@ -54,7 +57,7 @@ parseTypeFromTokens = parseFromTokens typeParser  parseModuleFromTokens :: FilePath -> [LexToken] -> ParseResult Module-parseModuleFromTokens = parseFromTokens moduleParser+parseModuleFromTokens = runParserFromTokens moduleParser  parseDeclFromTokens :: FilePath -> [LexToken] -> ParseResult Decl parseDeclFromTokens = parseFromTokens declParser

@@ -10,11 +10,20 @@   ) where -import Aihc.Parser.Internal.Common (TokParser, braces, expectedTok, skipSemicolons, withSpan)+import Aihc.Parser.Internal.Common+  ( TokParser,+    closeAndExpectRBrace,+    eofTok,+    expectedTok,+    inputStartSpan,+    lazy,+    skipSemicolons,+  ) import Aihc.Parser.Internal.Decl (declParser) import Aihc.Parser.Internal.Import (importDeclParser, languagePragmaParser, moduleHeaderParser)-import Aihc.Parser.Lex (LexTokenKind (..), lexTokenKind)-import Aihc.Parser.Syntax (Decl, ImportDecl, Module (..), mkAnnotation)+import Aihc.Parser.Lex (LexToken (lexTokenSpan), LexTokenKind (..), lexTokenKind)+import Aihc.Parser.Syntax (Decl, ImportDecl, Module (..), mergeSourceSpans, mkAnnotation, noSourceSpan)+import Aihc.Parser.Types (TokStream (tokStreamPrevToken)) import Control.Monad (void) import Text.Megaparsec qualified as MP @@ -23,27 +32,33 @@   | RecoverParsed !a   | RecoverFailed +-- | Parse the header and imports now, leaving declarations, their errors, and+-- the whole-module span suspended until the corresponding result is demanded. moduleParser :: TokParser Module-moduleParser = withSpan $ do+moduleParser = do+  startInput <- MP.getInput   languagePragmas <- MP.many (languagePragmaParser <* MP.many (expectedTok TkSpecialSemicolon))   mHeader <- MP.optional (moduleHeaderParser <* MP.many (expectedTok TkSpecialSemicolon))-  (imports, decls) <- moduleBodyParser-  pure $ \span' ->+  expectedTok TkSpecialLBrace+  imports <- importDeclsWithRecovery+  (decls, finalState) <-+    lazy+      ( declsWithRecovery+          <* skipSemicolons+          <* closeAndExpectRBrace+          <* MP.lookAhead eofTok+      )+  MP.updateParserState (\state -> state {MP.stateParseErrors = MP.stateParseErrors finalState})+  let endSpan = maybe noSourceSpan lexTokenSpan (tokStreamPrevToken (MP.stateInput finalState))+      moduleSpan = mergeSourceSpans (inputStartSpan startInput) endSpan+  pure     Module-      { moduleAnns = [mkAnnotation span'],+      { moduleAnns = [mkAnnotation moduleSpan],         moduleHead = mHeader,         moduleLanguagePragmas = concat languagePragmas,         moduleImports = imports,         moduleDecls = decls       }--moduleBodyParser :: TokParser ([ImportDecl], [Decl])-moduleBodyParser = braces $ do-  skipSemicolons-  imports <- importDeclsWithRecovery-  decls <- declsWithRecovery-  skipSemicolons-  pure (imports, decls)  importDeclsWithRecovery :: TokParser [ImportDecl] importDeclsWithRecovery = recoverDeclLike importDeclParser

@@ -6,12 +6,15 @@  import Aihc.Cpp (resultOutput) import Aihc.Parser+import Aihc.Parser.Internal.Common (TokParser, lazy) import Aihc.Parser.Lex (LexToken (..), LexTokenKind (..), lexTokens, lexTokensWithExtensions) import Aihc.Parser.Parens (addDeclParens, addExprParens, addTypeParens) import Aihc.Parser.Pretty () import Aihc.Parser.Shorthand (Shorthand (shorthand)) import Aihc.Parser.Syntax+import Aihc.Parser.Types (mkTokStreamFromTokens) import Control.DeepSeq (rnf)+import Control.Exception (ErrorCall, evaluate, try) import CppSupport (preprocessForParserWithoutIncludesIfEnabled) import Data.Char (ord) import Data.Data (Data, dataTypeConstrs, dataTypeOf, gmapQl, isAlgType, showConstr, toConstr)@@ -83,6 +86,9 @@ import Test.Tasty import Test.Tasty.HUnit import Test.Tasty.QuickCheck qualified as QC+import Text.Megaparsec (runParser)+import Text.Megaparsec qualified as MP+import Text.Megaparsec.Error qualified as MPE import Text.Read (readMaybe)  tenMinutes :: Timeout@@ -158,6 +164,38 @@     ParseErr bundle ->       assertFailure ("expected pretty-printed expression to reparse, got:\n" <> formatParseErrors "<test>" Nothing bundle) +lazyExceptionParser :: TokParser ()+lazyExceptionParser = error "lazy parser was forced"++test_lazyDoesNotForceParser :: Assertion+test_lazyDoesNotForceParser =+  case runParser parser "<lazy-test>" (mkTokStreamFromTokens []) of+    Left bundle -> assertFailure (show bundle)+    Right () -> pure ()+  where+    parser = do+      _ <- lazy lazyExceptionParser+      pure ()++test_lazyForcesParserWhenResultIsForced :: Assertion+test_lazyForcesParserWhenResultIsForced =+  case runParser (fst <$> lazy lazyExceptionParser) "<lazy-test>" (mkTokStreamFromTokens []) of+    Left bundle -> assertFailure (show bundle)+    Right value -> do+      result <- try (evaluate value) :: IO (Either ErrorCall ())+      case result of+        Left _ -> pure ()+        Right () -> assertFailure "expected the lazy parser to be forced"++test_lazyPreservesErrors :: Assertion+test_lazyPreservesErrors =+  case runParser (snd <$> lazy lazyErrorParser) "<lazy-test>" (mkTokStreamFromTokens []) of+    Left bundle -> assertFailure (show bundle)+    Right finalState -> assertEqual "error count" 1 (length (MP.stateParseErrors finalState))+  where+    lazyErrorParser :: TokParser ()+    lazyErrorParser = MP.registerParseError (MPE.TrivialError 0 Nothing Set.empty)+ main :: IO () main = buildTests >>= defaultMain @@ -178,7 +216,13 @@         lexer,         testGroup           "parser"-          [ testCase "emits lexer error token for unterminated strings" test_unterminatedStringProducesErrorToken,+          [ testGroup+              "lazy"+              [ testCase "does not run the parser until its result is forced" test_lazyDoesNotForceParser,+                testCase "runs the parser when its result is forced" test_lazyForcesParserWhenResultIsForced,+                testCase "preserves errors from the lazy parser" test_lazyPreservesErrors+              ],+            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,             testCase "applies gcc-style hash line directives to subsequent tokens" test_gccHashLineDirectiveUpdatesSpan,