diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml index 492ab8a..cae1b8c 100644 --- a/.github/workflows/haskell-ci.yml +++ b/.github/workflows/haskell-ci.yml @@ -8,9 +8,9 @@ # # For more information, see https://github.com/haskell-CI/haskell-ci # -# version: 0.16.3 +# version: 0.17.20231219 # -# REGENDATA ("0.16.3",["github","inspection-testing.cabal","--ghcup-jobs","--last-in-series","--no-cabal-check"]) +# REGENDATA ("0.17.20231219",["github","inspection-testing.cabal","--ghcup-jobs","--last-in-series","--no-cabal-check"]) # name: Haskell-CI on: @@ -28,19 +28,24 @@ jobs: strategy: matrix: include: - - compiler: ghc-9.6.2 + - compiler: ghc-9.8.1 compilerKind: ghc - compilerVersion: 9.6.2 + compilerVersion: 9.8.1 setup-method: ghcup allow-failure: false - - compiler: ghc-9.4.5 + - compiler: ghc-9.6.3 compilerKind: ghc - compilerVersion: 9.4.5 + compilerVersion: 9.6.3 setup-method: ghcup allow-failure: false - - compiler: ghc-9.2.7 + - compiler: ghc-9.4.8 compilerKind: ghc - compilerVersion: 9.2.7 + compilerVersion: 9.4.8 + setup-method: ghcup + allow-failure: false + - compiler: ghc-9.2.8 + compilerKind: ghc + compilerVersion: 9.2.8 setup-method: ghcup allow-failure: false - compiler: ghc-9.0.2 @@ -85,10 +90,10 @@ jobs: apt-get update apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5 libnuma-dev mkdir -p "$HOME/.ghcup/bin" - curl -sL https://downloads.haskell.org/ghcup/0.1.19.2/x86_64-linux-ghcup-0.1.19.2 > "$HOME/.ghcup/bin/ghcup" + curl -sL https://downloads.haskell.org/ghcup/0.1.20.0/x86_64-linux-ghcup-0.1.20.0 > "$HOME/.ghcup/bin/ghcup" chmod a+x "$HOME/.ghcup/bin/ghcup" "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false) - "$HOME/.ghcup/bin/ghcup" install cabal 3.10.1.0 || (cat "$HOME"/.ghcup/logs/*.* && false) + "$HOME/.ghcup/bin/ghcup" install cabal 3.10.2.0 || (cat "$HOME"/.ghcup/logs/*.* && false) env: HCKIND: ${{ matrix.compilerKind }} HCNAME: ${{ matrix.compiler }} @@ -100,11 +105,13 @@ jobs: echo "CABAL_DIR=$HOME/.cabal" >> "$GITHUB_ENV" echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV" HCDIR=/opt/$HCKIND/$HCVER - HC=$HOME/.ghcup/bin/$HCKIND-$HCVER + HC=$("$HOME/.ghcup/bin/ghcup" whereis ghc "$HCVER") + HCPKG=$(echo "$HC" | sed 's#ghc$#ghc-pkg#') + HADDOCK=$(echo "$HC" | sed 's#ghc$#haddock#') echo "HC=$HC" >> "$GITHUB_ENV" - echo "HCPKG=$HOME/.ghcup/bin/$HCKIND-pkg-$HCVER" >> "$GITHUB_ENV" - echo "HADDOCK=$HOME/.ghcup/bin/haddock-$HCVER" >> "$GITHUB_ENV" - echo "CABAL=$HOME/.ghcup/bin/cabal-3.10.1.0 -vnormal+nowrap" >> "$GITHUB_ENV" + echo "HCPKG=$HCPKG" >> "$GITHUB_ENV" + echo "HADDOCK=$HADDOCK" >> "$GITHUB_ENV" + echo "CABAL=$HOME/.ghcup/bin/cabal-3.10.2.0 -vnormal+nowrap" >> "$GITHUB_ENV" HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))') echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV" echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV" diff --git a/examples/NS_NP.hs b/examples/NS_NP.hs index 5539016..d3be68f 100644 --- a/examples/NS_NP.hs +++ b/examples/NS_NP.hs @@ -3,13 +3,14 @@ {-# OPTIONS_GHC -O -fplugin-opt=Test.Inspection.Plugin:quiet -Wno-overlapping-patterns #-} module NS_NP (main) where +import Data.Kind import Test.Inspection -data NS (f :: k -> *) (xs :: [k]) where +data NS (f :: k -> Type) (xs :: [k]) where Z :: f x -> NS f (x : xs) S :: !(NS f xs) -> NS f (x : xs) -data NP (f :: k -> *) (xs :: [k]) where +data NP (f :: k -> Type) (xs :: [k]) where Nil :: NP f '[] (:*) :: f x -> !(NP f xs) -> NP f (x : xs) diff --git a/inspection-testing.cabal b/inspection-testing.cabal index 07d13c2..c46735d 100644 --- a/inspection-testing.cabal +++ b/inspection-testing.cabal @@ -34,7 +34,7 @@ copyright: 2017 Joachim Breitner build-type: Simple extra-source-files: ChangeLog.md, README.md cabal-version: >=1.10 -Tested-With: GHC == 8.0.2, GHC == 8.2.*, GHC == 8.4.*, GHC ==8.6.*, GHC ==8.8.*, GHC ==8.10.*, GHC ==9.0.*, GHC ==9.2.*, GHC ==9.4.*, GHC ==9.6.* +Tested-With: GHC == 8.0.2, GHC == 8.2.*, GHC == 8.4.*, GHC ==8.6.*, GHC ==8.8.*, GHC ==8.10.*, GHC ==9.0.*, GHC ==9.2.*, GHC ==9.4.*, GHC ==9.6.*, GHC ==9.8.* source-repository head type: git @@ -45,8 +45,8 @@ library Test.Inspection.Plugin Test.Inspection.Core hs-source-dirs: src - build-depends: base >=4.9 && <4.20 - build-depends: ghc >= 8.0.2 && <9.9 + build-depends: base >=4.9 && <4.21 + build-depends: ghc >= 8.0.2 && <9.11 build-depends: template-haskell build-depends: containers build-depends: transformers diff --git a/src/Test/Inspection/Core.hs b/src/Test/Inspection/Core.hs index 544c1ea..309af59 100644 --- a/src/Test/Inspection/Core.hs +++ b/src/Test/Inspection/Core.hs @@ -188,9 +188,11 @@ type VarPairSet = S.Set VarPair -- (This is mostly to work-around the buggy CSE in GHC-8.0) -- It also breaks if there is shadowing. eqSlice :: Equivalence -> Slice -> Slice -> Bool -eqSlice _ slice1 slice2 | null slice1 || null slice2 = null slice1 == null slice2 +eqSlice _ [] [] = True +eqSlice _ _ [] = False +eqSlice _ [] _ = False -- Mostly defensive programming (slices should not be empty) -eqSlice eqv slice1 slice2 +eqSlice eqv slice1@((head1, _) : _) slice2@((head2, _) : _) -- slices are equal if there exist any result with no "unification" obligations left. = any (S.null . snd) results where @@ -210,7 +212,7 @@ eqSlice eqv slice1 slice2 -- results. If there are no pairs to be equated, all is fine. results :: [((), VarPairSet)] - results = runStateT (loop' (mkRnEnv2 emptyInScopeSet) S.empty (fst (head slice1)) (fst (head slice2))) S.empty + results = runStateT (loop' (mkRnEnv2 emptyInScopeSet) S.empty head1 head2) S.empty -- while there are obligations left, try to equate them. loop :: RnEnv2 -> VarPairSet -> StateT VarPairSet [] () @@ -266,7 +268,7 @@ eqSlice eqv slice1 slice2 essentiallyVar (Lam v e) | it, isTyCoVar v = essentiallyVar e essentiallyVar (Cast e _) | it = essentiallyVar e #if MIN_VERSION_ghc(9,0,0) - essentiallyVar (Case s _ _ [Alt _ _ e]) | it, isUnsafeEqualityProof s = essentiallyVar e + essentiallyVar (Case s b _ alts) | it, Just e <- isUnsafeEqualityCase s b alts = essentiallyVar e #endif essentiallyVar (Var v) = Just v essentiallyVar (Tick HpcTick{} e) | it = essentiallyVar e @@ -294,8 +296,8 @@ eqSlice eqv slice1 slice2 go lv env (Cast e1 _) e2 | it = go lv env e1 e2 go lv env e1 (Cast e2 _) | it = go lv env e1 e2 #if MIN_VERSION_ghc(9,0,0) - go lv env (Case s _ _ [Alt _ _ e1]) e2 | it, isUnsafeEqualityProof s = go lv env e1 e2 - go lv env e1 (Case s _ _ [Alt _ _ e2]) | it, isUnsafeEqualityProof s = go lv env e1 e2 + go lv env (Case s b _ alts) e2 | it, Just e1 <- isUnsafeEqualityCase s b alts = go lv env e1 e2 + go lv env e1 (Case s b _ alts) | it, Just e2 <- isUnsafeEqualityCase s b alts = go lv env e1 e2 #endif go lv env (Cast e1 co1) (Cast e2 co2) = traceBlock lv "CAST" "" $ \lv -> do guard (eqCoercionX env co1 co2) @@ -382,6 +384,13 @@ eqSlice eqv slice1 slice2 -- continue with the rest of bindings, adding a pair as matching one. goBinds lv (rnBndr2 env v1 v2) xs ys +#if !MIN_VERSION_ghc(9,9,0) && MIN_VERSION_ghc(9,0,0) +isUnsafeEqualityCase :: CoreExpr -> Id -> [CoreAlt] -> Maybe CoreExpr +isUnsafeEqualityCase scrut _bndr [Alt _ _ rhs] + | isUnsafeEqualityProof scrut = Just rhs +isUnsafeEqualityCase _ _ _ = Nothing +#endif + #if !MIN_VERSION_ghc(9,2,0) type CoreTickish = Tickish Id #endif