ghc-lib-parser-ex 0.20210228 → 0.20210331

raw patch · 9 files changed

+113/−29 lines, 9 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +9/−0
• ghc-lib-parser-ex.cabal +1/−1
• src/Language/Haskell/GhclibParserEx/Dump.hs +4/−1
• src/Language/Haskell/GhclibParserEx/Fixity.hs +64/−13
• src/Language/Haskell/GhclibParserEx/GHC/Hs/Expr.hs +3/−1
• src/Language/Haskell/GhclibParserEx/GHC/Hs/ExtendInstances.hs +1/−1
• src/Language/Haskell/GhclibParserEx/GHC/Hs/Pat.hs +15/−7
• src/Language/Haskell/GhclibParserEx/GHC/Parser.hs +4/−0
• test/Test.hs +12/−5

@@ -1,5 +1,14 @@ # Changelog for ghc-lib-parser-ex +## 0.20210331 released 2021-02-31+- Update to `ghc-lib-0.20210331`++## Unreleased+- Upgrade to `ghc-lib-parser-9.0.1.20210324`++## 9.0.0.4 released 2021-03-11+- Bugfix for `GHC.Hs.Dump`+ ## 0.20210228 released 2021-02-28 - Update to `ghc-lib-0.20210228` 

@@ -1,6 +1,6 @@ cabal-version: >= 1.18 name:           ghc-lib-parser-ex-version:        0.20210228+version:        0.20210331 description:    Please see the README on GitHub at <https://github.com/shayne-fletcher/ghc-lib-parser-ex#readme> homepage:       https://github.com/shayne-fletcher/ghc-lib-parser-ex#readme bug-reports:    https://github.com/shayne-fletcher/ghc-lib-parser-ex/issues

@@ -12,7 +12,10 @@ #include "ghclib_api.h" module Language.Haskell.GhclibParserEx.Dump(     showAstData-  , BlankSrcSpan(..),+  , BlankSrcSpan(..)+#if defined(GHCLIB_API_HEAD)+  , BlankEpAnnotations(..)+#endif ) where  #if !defined(MIN_VERSION_ghc_lib_parser)

@@ -44,7 +44,7 @@ import Data.Data hiding (Fixity) import Data.Generics.Uniplate.Data -#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_900) || defined (GHCLIB_API_810)+#if defined (GHCLIB_API_900) || defined (GHCLIB_API_810) noExt :: NoExtField noExt = noExtField #endif@@ -78,7 +78,12 @@  mkConOpPat ::   [(String, Fixity)]-  -> Located RdrName -> Fixity+#if defined (GHCLIB_API_HEAD)+  -> LocatedN RdrName+#else+  -> Located RdrName+#endif+  -> Fixity   -> LPat GhcPs -> LPat GhcPs   -> Pat GhcPs #if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_900)@@ -88,19 +93,25 @@ #else mkConOpPat fs op2 fix2 p1@(dL->L loc (ConPatIn op1 (InfixCon p11 p12))) p2 #endif-#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_900)+#if defined (GHCLIB_API_HEAD)+  | nofix_error = ConPat noAnn op2 (InfixCon p1 p2)+#elif defined (GHCLIB_API_900)   | nofix_error = ConPat noExtField op2 (InfixCon p1 p2) #else   | nofix_error = ConPatIn op2 (InfixCon p1 p2) #endif-#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_900)+#if defined (GHCLIB_API_HEAD)+  | associate_right = ConPat noAnn op1 (InfixCon p11 (L loc (mkConOpPat fs op2 fix2 p12 p2)))+#elif defined (GHCLIB_API_900)   | associate_right = ConPat noExtField op1 (InfixCon p11 (L loc (mkConOpPat fs op2 fix2 p12 p2))) #elif defined (GHCLIB_API_810)   | associate_right = ConPatIn op1 (InfixCon p11 (L loc (mkConOpPat fs op2 fix2 p12 p2))) #else   | associate_right = ConPatIn op1 (InfixCon p11 (cL loc (mkConOpPat fs op2 fix2 p12 p2))) #endif-#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_900)+#if defined (GHCLIB_API_HEAD)+  | otherwise = ConPat noAnn op2 (InfixCon p1 p2)+#elif defined (GHCLIB_API_900)   | otherwise = ConPat noExtField op2 (InfixCon p1 p2) #else   | otherwise = ConPatIn op2 (InfixCon p1 p2)@@ -108,41 +119,75 @@   where     fix1 = findFixity' fs op1     (nofix_error, associate_right) = compareFixity fix1 fix2-#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_900)+#if defined (GHCLIB_API_HEAD)+mkConOpPat _ op _ p1 p2 = ConPat noAnn op (InfixCon p1 p2)+#elif defined (GHCLIB_API_900) mkConOpPat _ op _ p1 p2 = ConPat noExtField op (InfixCon p1 p2) #else mkConOpPat _ op _ p1 p2 = ConPatIn op (InfixCon p1 p2) #endif  mkOpApp ::-  [(String, Fixity)]-  -> SrcSpan-  -> LHsExpr GhcPs -- Left operand; already rearrange.-  -> LHsExpr GhcPs -> Fixity -- Operator and fixity.-  -> LHsExpr GhcPs -- Right operand (not an OpApp, but might be a NegApp).-  -> LHsExpr GhcPs+   [(String, Fixity)]+#if defined(GHCLIB_API_HEAD)+   -> SrcSpanAnnA+#else+   -> SrcSpan+#endif+   -> LHsExpr GhcPs -- Left operand; already rearrange.+   -> LHsExpr GhcPs -> Fixity -- Operator and fixity.+   -> LHsExpr GhcPs -- Right operand (not an OpApp, but might be a NegApp).+   -> LHsExpr GhcPs --      (e11 `op1` e12) `op2` e2 mkOpApp fs loc e1@(L _ (OpApp x1 e11 op1 e12)) op2 fix2 e2+#if defined (GHCLIB_API_HEAD)+  | nofix_error = L loc (OpApp noAnn e1 op2 e2)+#else   | nofix_error = L loc (OpApp noExt e1 op2 e2)+#endif   | associate_right = L loc (OpApp x1 e11 op1 (mkOpApp fs loc' e12 op2 fix2 e2 ))   where+#if defined (GHCLIB_API_HEAD)+    loc'= combineLocsA e12 e2+#else     loc'= combineLocs e12 e2+#endif     fix1 = findFixity fs op1     (nofix_error, associate_right) = compareFixity fix1 fix2 --      (- neg_arg) `op` e2 mkOpApp fs loc e1@(L _ (NegApp _ neg_arg neg_name)) op2 fix2 e2+#if defined(GHCLIB_API_HEAD)+  | nofix_error = L loc (OpApp noAnn e1 op2 e2)+#else   | nofix_error = L loc (OpApp noExt e1 op2 e2)+#endif+#if defined(GHCLIB_API_HEAD)+  | associate_right = L loc (NegApp noAnn (mkOpApp fs loc' neg_arg op2 fix2 e2) neg_name)+#else   | associate_right = L loc (NegApp noExt (mkOpApp fs loc' neg_arg op2 fix2 e2) neg_name)+#endif   where+#if defined (GHCLIB_API_HEAD)+    loc' = combineLocsA neg_arg e2+#else     loc' = combineLocs neg_arg e2+#endif     (nofix_error, associate_right) = compareFixity negateFixity fix2 --      e1 `op` - neg_arg mkOpApp _ loc e1 op1 fix1 e2@(L _ NegApp {}) -- NegApp can occur on the right.+#if defined(GHCLIB_API_HEAD)+  | not associate_right  = L loc (OpApp noAnn e1 op1 e2)-- We *want* right association.+#else   | not associate_right  = L loc (OpApp noExt e1 op1 e2)-- We *want* right association.+#endif   where     (_, associate_right) = compareFixity fix1 negateFixity  --     Default case, no rearrangment.+#if defined(GHCLIB_API_HEAD)+mkOpApp _ loc e1 op _fix e2 = L loc (OpApp noAnn e1 op e2)+#else mkOpApp _ loc e1 op _fix e2 = L loc (OpApp noExt e1 op e2)+#endif  getIdent :: LHsExpr GhcPs -> String getIdent (unLoc -> HsVar _ (L _ n)) = occNameString . rdrNameOcc $ n@@ -155,7 +200,11 @@ findFixity :: [(String, Fixity)] -> LHsExpr GhcPs -> Fixity findFixity fs r = askFix fs (getIdent r) -- Expressions. +#if defined(GHCLIB_API_HEAD)+findFixity' :: [(String, Fixity)] -> LocatedN RdrName -> Fixity+#else findFixity' :: [(String, Fixity)] -> Located RdrName -> Fixity+#endif findFixity' fs r = askFix fs (occNameString . rdrNameOcc . unLoc $ r) -- Patterns.  askFix :: [(String, Fixity)] -> String -> Fixity@@ -218,7 +267,9 @@ #else fixitiesFromModule :: Located (HsModule GhcPs) -> [(String, Fixity)] #endif-#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_900)+#if defined (GHCLIB_API_HEAD)+fixitiesFromModule (L _ (HsModule _ _ _ _ _ decls _ _)) = concatMap f decls+#elif defined (GHCLIB_API_900) fixitiesFromModule (L _ (HsModule _ _ _ _ decls _ _)) = concatMap f decls #else fixitiesFromModule (L _ (HsModule _ _ _ decls _ _)) = concatMap f decls

@@ -177,7 +177,9 @@ varToStr _ = ""  strToVar :: String -> LHsExpr GhcPs-#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_900) || defined (GHCLIB_API_810)+#if defined (GHCLIB_API_HEAD)+strToVar x = noLocA $ HsVar noExtField (noLocA $ mkRdrUnqual (mkVarOcc x))+#elif defined (GHCLIB_API_900) || defined (GHCLIB_API_810) strToVar x = noLoc $ HsVar noExtField (noLoc $ mkRdrUnqual (mkVarOcc x)) #else strToVar x = noLoc $ HsVar noExt (noLoc $ mkRdrUnqual (mkVarOcc x))

@@ -43,7 +43,7 @@ toStr :: Data a => HsExtendInstances a -> String toStr (HsExtendInstances e) = #if defined(GHCLIB_API_HEAD)-  showPprUnsafe $ showAstData BlankSrcSpan e+  showPprUnsafe $ showAstData BlankSrcSpan BlankEpAnnotations e #else   showSDocUnsafe $ showAstData BlankSrcSpan e #endif

@@ -56,40 +56,48 @@ strToPat :: String -> LPat GhcPs strToPat z   | z == "True"  =-#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_900) || defined (GHCLIB_API_810)+#if defined (GHCLIB_API_HEAD)+  noLocA $+#elif defined (GHCLIB_API_900) || defined (GHCLIB_API_810)   noLoc $ #endif #if defined (GHCLIB_API_HEAD)-    ConPat noExtField (noLoc true_RDR) (PrefixCon [] [])+    ConPat noAnn (noLocA true_RDR) (PrefixCon [] []) #elif defined (GHCLIB_API_900)     ConPat noExtField (noLoc true_RDR) (PrefixCon []) #else     ConPatIn (noLoc true_RDR) (PrefixCon []) #endif   | z == "False" =-#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_900) || defined (GHCLIB_API_810)+#if defined (GHCLIB_API_HEAD)+  noLocA $+#elif defined (GHCLIB_API_900) || defined (GHCLIB_API_810)   noLoc $ #endif #if defined (GHCLIB_API_HEAD)-    ConPat noExtField (noLoc false_RDR) (PrefixCon [] [])+    ConPat noAnn (noLocA false_RDR) (PrefixCon [] []) #elif defined (GHCLIB_API_900)     ConPat noExtField (noLoc false_RDR) (PrefixCon []) #else     ConPatIn (noLoc false_RDR) (PrefixCon []) #endif   | z == "[]"    =-#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_900) || defined (GHCLIB_API_810)+#if defined (GHCLIB_API_HEAD)+  noLocA $+#elif defined (GHCLIB_API_900) || defined (GHCLIB_API_810)   noLoc $ #endif #if defined (GHCLIB_API_HEAD)-    ConPat noExtField (noLoc $ nameRdrName nilDataConName) (PrefixCon [] [])+    ConPat noAnn (noLocA $ nameRdrName nilDataConName) (PrefixCon [] []) #elif defined (GHCLIB_API_900)     ConPat noExtField (noLoc $ nameRdrName nilDataConName) (PrefixCon []) #else     ConPatIn (noLoc $ nameRdrName nilDataConName) (PrefixCon []) #endif   | otherwise =-#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_900) || defined (GHCLIB_API_810)+#if defined (GHCLIB_API_HEAD)+      noLocA $ VarPat noExtField (noLocA $ mkVarUnqual (fsLit z))+#elif defined (GHCLIB_API_900) || defined (GHCLIB_API_810)       noLoc $ VarPat noExtField (noLoc $ mkVarUnqual (fsLit z)) #else       VarPat noExt (noLoc $ mkVarUnqual (fsLit z))

@@ -125,7 +125,11 @@ parseStmt :: String -> DynFlags -> ParseResult (Maybe (LStmt GhcPs (LHsExpr GhcPs))) parseStmt = parse Parser.parseStmt +#if defined(GHCLIB_API_HEAD)+parseIdentifier :: String -> DynFlags -> ParseResult (LocatedN RdrName)+#else parseIdentifier :: String -> DynFlags -> ParseResult (Located RdrName)+#endif parseIdentifier = parse Parser.parseIdentifier  parseType :: String -> DynFlags -> ParseResult (LHsType GhcPs)

@@ -48,7 +48,9 @@ import GHC.Types.SrcLoc import GHC.Driver.Session import GHC.Parser.Lexer+# if !defined (GHCLIB_API_HEAD) import GHC.Utils.Outputable+#endif #  if !defined (GHCLIB_API_900) import GHC.Driver.Ppr import GHC.Parser.Errors.Ppr@@ -70,11 +72,6 @@ import Bag #endif -#if defined (GHCLIB_API_HEAD)-showSDocUnsafe :: SDoc -> String-showSDocUnsafe = showPprUnsafe-#endif- main :: IO () main = do   setEnv "TASTY_NUM_THREADS" "1"@@ -211,15 +208,25 @@       exprTest "1 + 2 * 3" flags         (\e ->             assertBool "parse tree not affected" $+#if defined(GHCLIB_API_HEAD)+              showSDocUnsafe (showAstData BlankSrcSpan BlankEpAnnotations e) /=+              showSDocUnsafe (showAstData BlankSrcSpan BlankEpAnnotations (applyFixities [] e))+#else               showSDocUnsafe (showAstData BlankSrcSpan e) /=               showSDocUnsafe (showAstData BlankSrcSpan (applyFixities [] e))+#endif         )   , testCase "Pattern" $       case parseDeclaration "f (1 : 2 :[]) = 1" flags of         POk _ d ->           assertBool "parse tree not affected" $+#if defined(GHCLIB_API_HEAD)+          showSDocUnsafe (showAstData BlankSrcSpan BlankEpAnnotations d) /=+          showSDocUnsafe (showAstData BlankSrcSpan BlankEpAnnotations (applyFixities [] d))+#else           showSDocUnsafe (showAstData BlankSrcSpan d) /=           showSDocUnsafe (showAstData BlankSrcSpan (applyFixities [] d))+#endif         PFailed{} -> assertFailure "parse error"   , testCase "fixitiesFromModule" $       case parseModule "infixl 4 <*!" flags of