Merge branch '9.6' into 9.8

Author: Tritlo

.github/workflows/build-test-deploy.yml

@@ -12,6 +12,7 @@ on:
       - '.github/workflows/*.yml'
     branches:
       - 'master'
+      - '9.6'
   pull_request:
     branches:
       - 'master'
@@ -29,8 +30,8 @@ jobs:
     strategy:
       fail-fast: false
       matrix:
-        ghc: ['8.10.7']
-        cabal: ['3.4.0.0']
+        ghc: ['9.6.3']
+        cabal: ['3.10.2.1']
 
     steps:
     - uses: actions/checkout@v2
@@ -120,7 +121,7 @@ jobs:
         with:
           context: .
           build-args: |
-            "HASKELL_VERSION=8.10.7"
+            "HASKELL_VERSION=9.6.4"
             "PROPR_VERSION=1.0.0"
           push: ${{ github.event_name != 'pull_request' }}
           tags: ${{ steps.meta.outputs.tags }}

src/PropR/Check.hs

@@ -22,7 +22,7 @@ import qualified Data.Set as Set
 import Debug.Trace (trace, traceShow)
 import GHC.Data.FastString (fsLit)
 import GHC
-import GHC.Plugins (Outputable (ppr), occName, showSDocUnsafe, mkVarOcc, mkRdrUnqual, DoPmc(..))
+import GHC.Plugins (Outputable (ppr), occName, showSDocUnsafe, mkVarOcc, mkRdrUnqual)
 import GHC.Data.Bag (emptyBag, listToBag, unionManyBags, unitBag)
 import GHC.Types.Basic (Origin (..), PromotionFlag (..))
 import GHC.Types.SourceText (IntegralLit (..), SourceText (..))
@@ -80,8 +80,8 @@ checkPackages = ["base", "check-helpers"]
 -- | Looks up the given Name in a LHsExpr
 baseFun :: RdrName -> LHsExpr GhcPs -> LHsBind GhcPs
 baseFun nm val =
-  --                                                DoPmc or SkipPmc?
-  noLocA $ FunBind NoExtField (noLocA nm) (MG (Generated DoPmc) (noLocA [base_case]))
+  -- Note: Generated DoPmc in 9.8
+  noLocA $ FunBind NoExtField (noLocA nm) (MG (Generated) (noLocA [base_case]))
   where
     base_case =
       noLocA $

src/PropR/Plugin.hs

@@ -94,7 +94,8 @@ synthPlug CompConf {..} useCache local_exprs plugRef =
                       gbl_env <- getGlobalRdrEnv
                       let lcl_env =
                             case th_hole h of
-                              Just (Hole{..}) -> ctl_rdr $ ctLocEnv hole_loc
+                              -- Note: ctl_rdr in 9.8
+                              Just (Hole{..}) -> tcl_rdr $ ctLocEnv hole_loc
                               _ -> emptyLocalRdrEnv
                           -- A name is in scope if it's in the local or global environment
                           inScope e_id
@@ -106,8 +107,8 @@ synthPlug CompConf {..} useCache local_exprs plugRef =
                                     inLocalRdrEnvScope e_name lcl_env
                                   else -- A global variable is in scope if it's not shadowed by a local:
                                   -- or if it's wired in.
-
-                                    not (null (lookupGRE gbl_env (LookupOccName e_occ SameNameSpace)))
+                                    -- Note: lookupGRE gbl_env (LookupOccName e_occ SameNameSpace) in 9.8
+                                    not (null (lookupGlobalRdrEnv gbl_env  e_occ))
                                       && isNothing (lookupLocalRdrOcc lcl_env e_occ)
                       case holeHash defaults h >>= (cache Map.!?) . (num_calls,) of
                         Just cached | useCache -> liftIO $ do
@@ -138,13 +139,13 @@ synthPlug CompConf {..} useCache local_exprs plugRef =
                               isOk HoleFit {..}
                                 | GreHFCand elt <- hfCand,
                                   occ <- greOccName elt,
-                                  [_] <- lookupGRE gbl_env (LookupOccName occ SameNameSpace),
+                                  [_] <- lookupGlobalRdrEnv gbl_env occ,
                                   Nothing <- lookupLocalRdrOcc lcl_env occ =
                                   True
                               isOk HoleFit {..}
                                 | GreHFCand elt <- hfCand,
                                   occ <- greOccName elt,
-                                  [g@GRE {..}] <- lookupGRE gbl_env (LookupOccName occ SameNameSpace),
+                                  [g@GRE {..}] <- lookupGlobalRdrEnv gbl_env occ,
                                   Just n <- lookupLocalRdrOcc lcl_env occ =
                                   nameSrcSpan n == greSrcSpan g
                               isOk HoleFit {..} | inScope hfId = True

src/PropR/Repair.hs

@@ -68,7 +68,6 @@ import GHC.Exts (unsafeCoerce#)
 import GHC.Plugins
 import Numeric (showHex)
 import GHC.Builtin.Names (mkMainModule, mkMainModule_)
-import GHC.Types.Error (pprDiagnostic)
 import PropR.Check
 import PropR.Configuration
 import PropR.Eval
@@ -89,6 +88,10 @@ import System.Process
 import qualified System.Timeout (timeout)
 import GHC.Tc.Errors.Hole.FitTypes (HoleFit (..), TypedHole (..))
 import Text.Read (readMaybe)
+-- PPrDiagnostic
+import GHC.Driver.Errors.Ppr ()
+import GHC.Driver.Errors.Types (GhcMessage)
+import GHC.Types.Error (diagnosticMessage, defaultDiagnosticOpts, DecoratedSDoc(..))
 
 -- | Runs the whole compiler chain to get the fits for a hole, i.e. possible
 -- replacement-elements for the holes
@@ -141,6 +144,10 @@ getHoleFits' cc@CompConf {..} plugRef exprs = do
           liftIO $ logOut ll ovnd
           liftIO $ logStr ll "The errors were:"
           let toB msg = listToBag [msg]
+              -- Not needed in 9.8:
+              pprDiagnostic :: GhcMessage -> [SDoc]
+              pprDiagnostic msg = unDecorated $
+                                    diagnosticMessage (defaultDiagnosticOpts @GhcMessage) msg
           liftIO $ mapM_ (logOut ll . pprDiagnostic) oerrs
           -- We try the default defaults and some other defaults
           let different_defaults =