diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,8 +1,12 @@ -# 0.1.0.0 +# 0.1.0.2 (2021-11-05) -Initial version. +* Add support for GHC-9.2.1. -# 0.1.0.1 +# 0.1.0.1 (2021-09-09) * Updated tests to use `Wrapped Num` rather than `StockLit`. * Fixed an unused identifier warning when building on older GHCs. + +# 0.1.0.0 (2021-09-08) + +Initial version. diff --git a/dependent-literals-plugin.cabal b/dependent-literals-plugin.cabal --- a/dependent-literals-plugin.cabal +++ b/dependent-literals-plugin.cabal @@ -1,14 +1,12 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.33.0. +-- This file has been generated from package.yaml by hpack version 0.34.4. -- -- see: https://github.com/sol/hpack --- --- hash: 36ec8ae7ecaa56006786e7772271804225d27b9ef511f8a251b9b16812e4ca82 name: dependent-literals-plugin -version: 0.1.0.1 -synopsis: Rewrites integer literals to a pseudo-dependently-typed form. +version: 0.1.0.2 +synopsis: Dependent integer literals description: This plugin implements pseudo-dependently-typed integer literals. . This means the value of an integer literal is available at the type level, @@ -58,13 +56,11 @@ library exposed-modules: DependentLiterals.Plugin - other-modules: - Paths_dependent_literals_plugin hs-source-dirs: src build-depends: - base >=4.12 && <4.16 - , ghc >=8.6 && <9.1 + base >=4.12 && <4.17 + , ghc >=8.6 && <9.3 , syb >=0.1 && <0.8 default-language: Haskell2010 @@ -75,18 +71,23 @@ FinErrors hs-source-dirs: tests - default-extensions: NoStarIsType DataKinds FlexibleContexts ViewPatterns TypeApplications + default-extensions: + NoStarIsType + DataKinds + FlexibleContexts + ViewPatterns + TypeApplications ghc-options: -fplugin=DependentLiterals.Plugin build-depends: - base >=4.12 && <4.16 - , dependent-literals >=0.1.1 && <0.2 + base >=4.12 && <4.17 + , dependent-literals >=0.1.1 && <0.3 , dependent-literals-plugin - , fin-int >=0.1 && <0.2 - , numeric-kinds >=0.1 && <0.2 - , short-vec >=0.1 && <0.2 - , sint >=0.1 && <0.2 - , snumber >=0.1 && <0.2 - , wrapped >=0.1 && <0.2 + , fin-int >=0.1 && <0.3 + , numeric-kinds >=0.1 && <0.3 + , short-vec ==0.1.* + , sint >=0.1 && <0.3 + , snumber >=0.1 && <0.4 + , wrapped ==0.1.* if !flag(error_message_tests) buildable: False default-language: Haskell2010 @@ -98,18 +99,23 @@ IntErrors hs-source-dirs: tests - default-extensions: NoStarIsType DataKinds FlexibleContexts ViewPatterns TypeApplications + default-extensions: + NoStarIsType + DataKinds + FlexibleContexts + ViewPatterns + TypeApplications ghc-options: -fplugin=DependentLiterals.Plugin build-depends: - base >=4.12 && <4.16 - , dependent-literals >=0.1.1 && <0.2 + base >=4.12 && <4.17 + , dependent-literals >=0.1.1 && <0.3 , dependent-literals-plugin - , fin-int >=0.1 && <0.2 - , numeric-kinds >=0.1 && <0.2 - , short-vec >=0.1 && <0.2 - , sint >=0.1 && <0.2 - , snumber >=0.1 && <0.2 - , wrapped >=0.1 && <0.2 + , fin-int >=0.1 && <0.3 + , numeric-kinds >=0.1 && <0.3 + , short-vec ==0.1.* + , sint >=0.1 && <0.3 + , snumber >=0.1 && <0.4 + , wrapped ==0.1.* if !flag(error_message_tests) buildable: False default-language: Haskell2010 @@ -137,18 +143,23 @@ VecExamples hs-source-dirs: tests - default-extensions: NoStarIsType DataKinds FlexibleContexts ViewPatterns TypeApplications + default-extensions: + NoStarIsType + DataKinds + FlexibleContexts + ViewPatterns + TypeApplications ghc-options: -fplugin=DependentLiterals.Plugin build-depends: - base >=4.12 && <4.16 - , dependent-literals >=0.1.1 && <0.2 + base >=4.12 && <4.17 + , dependent-literals >=0.1.1 && <0.3 , dependent-literals-plugin - , fin-int >=0.1 && <0.2 - , numeric-kinds >=0.1 && <0.2 - , short-vec >=0.1 && <0.2 - , sint >=0.1 && <0.2 - , snumber >=0.1 && <0.2 - , wrapped >=0.1 && <0.2 + , fin-int >=0.1 && <0.3 + , numeric-kinds >=0.1 && <0.3 + , short-vec ==0.1.* + , sint >=0.1 && <0.3 + , snumber >=0.1 && <0.4 + , wrapped ==0.1.* default-language: Haskell2010 test-suite PolyErrors-test @@ -158,18 +169,23 @@ PolyErrors hs-source-dirs: tests - default-extensions: NoStarIsType DataKinds FlexibleContexts ViewPatterns TypeApplications + default-extensions: + NoStarIsType + DataKinds + FlexibleContexts + ViewPatterns + TypeApplications ghc-options: -fplugin=DependentLiterals.Plugin build-depends: - base >=4.12 && <4.16 - , dependent-literals >=0.1.1 && <0.2 + base >=4.12 && <4.17 + , dependent-literals >=0.1.1 && <0.3 , dependent-literals-plugin - , fin-int >=0.1 && <0.2 - , numeric-kinds >=0.1 && <0.2 - , short-vec >=0.1 && <0.2 - , sint >=0.1 && <0.2 - , snumber >=0.1 && <0.2 - , wrapped >=0.1 && <0.2 + , fin-int >=0.1 && <0.3 + , numeric-kinds >=0.1 && <0.3 + , short-vec ==0.1.* + , sint >=0.1 && <0.3 + , snumber >=0.1 && <0.4 + , wrapped ==0.1.* if !flag(error_message_tests) buildable: False default-language: Haskell2010 @@ -181,18 +197,23 @@ SIntErrors hs-source-dirs: tests - default-extensions: NoStarIsType DataKinds FlexibleContexts ViewPatterns TypeApplications + default-extensions: + NoStarIsType + DataKinds + FlexibleContexts + ViewPatterns + TypeApplications ghc-options: -fplugin=DependentLiterals.Plugin build-depends: - base >=4.12 && <4.16 - , dependent-literals >=0.1.1 && <0.2 + base >=4.12 && <4.17 + , dependent-literals >=0.1.1 && <0.3 , dependent-literals-plugin - , fin-int >=0.1 && <0.2 - , numeric-kinds >=0.1 && <0.2 - , short-vec >=0.1 && <0.2 - , sint >=0.1 && <0.2 - , snumber >=0.1 && <0.2 - , wrapped >=0.1 && <0.2 + , fin-int >=0.1 && <0.3 + , numeric-kinds >=0.1 && <0.3 + , short-vec ==0.1.* + , sint >=0.1 && <0.3 + , snumber >=0.1 && <0.4 + , wrapped ==0.1.* if !flag(error_message_tests) buildable: False default-language: Haskell2010 @@ -204,18 +225,23 @@ SNumberErrors hs-source-dirs: tests - default-extensions: NoStarIsType DataKinds FlexibleContexts ViewPatterns TypeApplications + default-extensions: + NoStarIsType + DataKinds + FlexibleContexts + ViewPatterns + TypeApplications ghc-options: -fplugin=DependentLiterals.Plugin build-depends: - base >=4.12 && <4.16 - , dependent-literals >=0.1.1 && <0.2 + base >=4.12 && <4.17 + , dependent-literals >=0.1.1 && <0.3 , dependent-literals-plugin - , fin-int >=0.1 && <0.2 - , numeric-kinds >=0.1 && <0.2 - , short-vec >=0.1 && <0.2 - , sint >=0.1 && <0.2 - , snumber >=0.1 && <0.2 - , wrapped >=0.1 && <0.2 + , fin-int >=0.1 && <0.3 + , numeric-kinds >=0.1 && <0.3 + , short-vec ==0.1.* + , sint >=0.1 && <0.3 + , snumber >=0.1 && <0.4 + , wrapped ==0.1.* if !flag(error_message_tests) buildable: False default-language: Haskell2010 @@ -227,18 +253,23 @@ WordErrors hs-source-dirs: tests - default-extensions: NoStarIsType DataKinds FlexibleContexts ViewPatterns TypeApplications + default-extensions: + NoStarIsType + DataKinds + FlexibleContexts + ViewPatterns + TypeApplications ghc-options: -fplugin=DependentLiterals.Plugin build-depends: - base >=4.12 && <4.16 - , dependent-literals >=0.1.1 && <0.2 + base >=4.12 && <4.17 + , dependent-literals >=0.1.1 && <0.3 , dependent-literals-plugin - , fin-int >=0.1 && <0.2 - , numeric-kinds >=0.1 && <0.2 - , short-vec >=0.1 && <0.2 - , sint >=0.1 && <0.2 - , snumber >=0.1 && <0.2 - , wrapped >=0.1 && <0.2 + , fin-int >=0.1 && <0.3 + , numeric-kinds >=0.1 && <0.3 + , short-vec ==0.1.* + , sint >=0.1 && <0.3 + , snumber >=0.1 && <0.4 + , wrapped ==0.1.* if !flag(error_message_tests) buildable: False default-language: Haskell2010 diff --git a/src/DependentLiterals/Plugin.hs b/src/DependentLiterals/Plugin.hs --- a/src/DependentLiterals/Plugin.hs +++ b/src/DependentLiterals/Plugin.hs @@ -44,17 +44,35 @@ #define GHC_Hs_Type HsTypes #endif +-- This one was double-renamed, too. Who knows how I managed to call the macro +-- GHC_Types_SourceText before any released versions actually called it that. +-- Maybe I was looking at the source on GitHub? +#if MIN_VERSION_ghc(9,2,0) +#define GHC_Types_SourceText GHC.Types.SourceText +#elif MIN_VERSION_ghc(9,0,0) +#define GHC_Types_SourceText GHC.Types.Basic +#else +#define GHC_Types_SourceText BasicTypes +#endif + +-- Renames from 9.0 to 9.2 +#if MIN_VERSION_ghc(9,2,0) +#define Language_Haskell_Syntax_Extension Language.Haskell.Syntax.Extension +#else +#define Language_Haskell_Syntax_Extension GHC.Hs.Extension +#endif + -- Renames from 8.10 to 9.0 #if MIN_VERSION_ghc(9,0,0) #define GHC_Plugins GHC.Plugins -#define GHC_Types_SourceText GHC.Types.Basic +#define GHC_Types_Basic GHC.Types.Basic #define GHC_Types_Name_Occurrence GHC.Types.Name.Occurrence #define GHC_Types_Name_Reader GHC.Types.Name.Reader #define GHC_Unit_Module_Name GHC.Unit.Module.Name #define GHC_Utils_Outputable GHC.Utils.Outputable #else #define GHC_Plugins GhcPlugins -#define GHC_Types_SourceText BasicTypes +#define GHC_Types_Basic BasicTypes #define GHC_Types_Name_Occurrence OccName #define GHC_Types_Name_Reader RdrName #define GHC_Unit_Module_Name Module @@ -93,7 +111,7 @@ import GHC_Hs_Pat (LPat, Pat(NPat, ViewPat)) import GHC_Hs_Utils (nlHsVar, nlHsApp) import GHC_Plugins - ( Hsc, HsParsedModule(..) + ( Hsc , Plugin(parsedResultAction, pluginRecompile), defaultPlugin , PluginRecompile(NoForceRecompile) , CommandLineOption @@ -106,14 +124,30 @@ import GHC_Types_Name_Reader (RdrName, mkRdrQual, mkRdrUnqual) import GHC_Types_SourceText (IntegralLit(IL), SourceText(NoSourceText)) import GHC_Unit_Module_Name (ModuleName, mkModuleName) -import GHC_Utils_Outputable - ( (<+>), Outputable, nest, pprPrec, sep, showSDoc, text - ) +import GHC_Utils_Outputable ((<+>), Outputable, nest, ppr, sep, text) -- For semantic changes, we generally try to paper over them by adding -- compatibility shims, e.g. pattern synonyms, to make the code below look like -- it's targeting the most-up-to-date version. +#if MIN_VERSION_ghc(9,2,0) +import GHC_Hs (HsParsedModule(..)) +import GHC.Driver.Ppr (showSDoc) +import GHC.Parser.Annotation + ( SrcAnn, SrcSpanAnn'(..), SrcSpanAnnA + , EpAnn(EpAnnNotUsed), EpaLocation(EpaDelta) + , DeltaPos(SameLine), LocatedN + , noSrcSpanA, noLocA + ) +#else +import GHC_Plugins (HsParsedModule(..)) +import GHC_Utils_Outputable (showSDoc) +#endif + +#if MIN_VERSION_ghc(8,10,0) && !MIN_VERSION_ghc(9,2,0) +import GHC_Plugins (noLoc) +#endif + #if MIN_VERSION_ghc(9,0,0) import GHC_Hs_Pat (Pat(ConPat)) import GHC.Unit.Types (IsBootInterface(..)) @@ -124,22 +158,55 @@ #endif #if MIN_VERSION_ghc(8,10,0) -import GHC.Hs.Extension (NoExtField(..)) import GHC.Hs.ImpExp (ImportDeclQualifiedStyle(..)) -import GHC_Plugins (noLoc) +import Language_Haskell_Syntax_Extension (NoExtField(..)) #else -- Imports for pre-8.10 compatibily shims. import HsExtension (NoExt(..)) #endif #if MIN_VERSION_ghc(8,8,0) -import GHC_Types_SourceText (PromotionFlag(..)) +import GHC_Types_Basic (PromotionFlag(..)) #else -- Imports for pre-8.8 compatibily shims. import GHC_Plugins (noLoc) import HsTypes (Promoted(..)) #endif +-- Pre-9.2 compatibility shims. +#if !MIN_VERSION_ghc(9,2,0) +nl :: a -> Located a +nl = L noSrcSpan + +ieType :: Located name -> IEWrappedName name +ieType = IEType + +type EpAnn = NoExtField + +pattern EpAnnNotUsed :: EpAnn +pattern EpAnnNotUsed = NoExtField + +type SrcSpanAnnA = SrcSpan +toSrcSpanAnnA :: SrcSpan -> SrcSpan +toSrcSpanAnnA = id + +mkPrefixCon :: [arg] -> HsConDetails arg rec +mkPrefixCon = PrefixCon +#else +nl :: a -> GenLocated (SrcAnn ann) a +nl = L noSrcSpanA + +ieType :: LocatedN name -> IEWrappedName name +ieType = IEType (EpaDelta (SameLine 1) []) + +toSrcSpanAnnA :: SrcSpan -> SrcSpanAnnA +toSrcSpanAnnA l = SrcSpanAnn EpAnnNotUsed l + +mkPrefixCon :: [arg] -> HsConDetails tyarg arg rec +mkPrefixCon = PrefixCon [] +#endif + + -- Pre-9.0 compatibility shims. #if !MIN_VERSION_ghc(9,0,0) pattern ConPat :: a -> Located (IdP p) -> HsConPatDetails p -> Pat p @@ -219,7 +286,9 @@ nlPat :: Pat (GhcPass p) -> LPat (GhcPass p) nlPat = id -#if !MIN_VERSION_ghc(8,8,0) || MIN_VERSION_ghc(8,10,0) +#if MIN_VERSION_ghc(9,2,0) + . noLocA +#elif !MIN_VERSION_ghc(8,8,0) || MIN_VERSION_ghc(8,10,0) . noLoc #endif @@ -250,16 +319,13 @@ where df = gopt_set df' Opt_SuppressModulePrefixes - nl :: a -> Located a - nl = L noSrcSpan - litMod, intMod :: ModuleName litMod = mkModuleName "DependentLiterals.Int" intMod = mkModuleName "Kinds.Integer" -- import qualified DependentLiterals.Int mkModImport nm as q imports = nl $ ImportDecl - NoExtField + EpAnnNotUsed NoSourceText (nl nm) Nothing -- no package qualifier @@ -278,8 +344,8 @@ -- TODO can we move this plugin post-renamer and do this by generating names -- that claim to have been originally unqualified? importVar = IEVar NoExtField . nl . IEName .nl - importAll = IEThingAll NoExtField . nl . IEName . nl - importTyOp = IEThingAbs NoExtField . nl . IEType . nl + importAll = IEThingAll EpAnnNotUsed . nl . IEName . nl + importTyOp = IEThingAbs EpAnnNotUsed . nl . ieType . nl unqualLitModImport = mkModImport litMod Nothing NotQualified $ Just [ importVar litHashName , importTyOp minusHashName @@ -303,7 +369,11 @@ mkHsAppType :: LHsExpr GhcPs -> LHsType GhcPs -> HsExpr GhcPs mkHsAppType expr ty = HsAppType #if MIN_VERSION_ghc(8,8,0) +#if MIN_VERSION_ghc(9,2,0) + noSrcSpan +#else NoExtField +#endif expr (HsWC NoExtField ty) #else @@ -313,15 +383,18 @@ infixl 4 `nlHsAppType` nlHsAppType :: LHsExpr GhcPs -> LHsType GhcPs -> LHsExpr GhcPs - nlHsAppType expr ty = L noSrcSpan $ mkHsAppType expr ty + nlHsAppType expr ty = nl $ mkHsAppType expr ty infixl 4 `nlHsApp_` nlHsApp_ = nlHsApp litToTyLit :: IntegralLit -> LHsType GhcPs - litToTyLit (IL txt neg val) = nl $ HsParTy NoExtField $ nl $ HsAppTy NoExtField - (nl $ HsTyVar NoExtField IsPromoted $ nl (if neg then negName else posName)) - (nl $ HsTyLit NoExtField (HsNumTy txt (abs val))) + litToTyLit (IL txt neg val) = + nl $ HsParTy EpAnnNotUsed $ + nl $ HsAppTy NoExtField + (nl $ HsTyVar EpAnnNotUsed IsPromoted $ + nl (if neg then negName else posName)) + (nl $ HsTyLit NoExtField (HsNumTy txt (abs val))) debug :: String -> Hsc () debug s @@ -333,8 +406,8 @@ let r = f x for_ r (\x' -> debug $ showSDoc df $ sep - [ text "Rewrote" <+> text thing <+> pprPrec 11 x <+> text "to" - , nest 2 $ pprPrec 11 x' + [ text "Rewrote" <+> text thing <+> ppr x <+> text "to" + , nest 2 $ ppr x' ]) return $ fromMaybe x r @@ -360,16 +433,17 @@ -- Refabricated literal. in IL txt' neg' val' - buildReprLit :: SrcSpan -> IntegralLit -> HsExpr GhcPs -> LHsExpr GhcPs + buildReprLit :: SrcSpanAnnA -> IntegralLit -> HsExpr GhcPs -> LHsExpr GhcPs buildReprLit l il witness = - L l $ HsOverLit NoExtField $ OverLit NoExtField (HsIntegral il) witness + L l $ HsOverLit EpAnnNotUsed $ OverLit NoExtField (HsIntegral il) witness - rewriteLit :: SrcSpan -> Bool -> IntegralLit -> HsExpr GhcPs -> LHsExpr GhcPs + rewriteLit + :: SrcSpanAnnA -> Bool -> IntegralLit -> HsExpr GhcPs -> LHsExpr GhcPs rewriteLit l negated il witness = let il' = fuseNegation negated il wrapper = nlHsVar litHashName `nlHsAppType` litToTyLit il' lit = buildReprLit l il' witness - in L l $ HsApp NoExtField (nlHsApp wrapper lit) lit + in L l $ HsApp EpAnnNotUsed (nlHsApp wrapper lit) lit foldNegation :: LHsExpr GhcPs -> LHsExpr GhcPs foldNegation (L l (NegApp _ (L _ (extractLit -> Just (il, witness))) _)) = @@ -389,10 +463,10 @@ wrappedLit = nlHsVar matchHashName `nlHsAppType` litToTyLit il' - `nlHsApp_` buildReprLit l il' witness - `nlHsApp_` buildReprLit l il' witness + `nlHsApp_` buildReprLit (toSrcSpanAnnA l) il' witness + `nlHsApp_` buildReprLit (toSrcSpanAnnA l) il' witness - in Just $ nlPat $ ViewPat NoExtField + in Just $ nlPat $ ViewPat EpAnnNotUsed wrappedLit - (nlPat $ ConPat NoExtField (nl cjustConName) (PrefixCon [])) + (nlPat $ ConPat EpAnnNotUsed (nl cjustConName) (mkPrefixCon [])) transformPat _ = Nothing