Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Fix concat-satisfy on GHC 9.2.1 #114

Merged
merged 4 commits into from
Dec 14, 2023
Merged

Fix concat-satisfy on GHC 9.2.1 #114

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
623de1e
Test first release of each major version
sellout Dec 14, 2023
fe7151c
Add an upper bound on constraints dep
sellout Dec 14, 2023
eb734ce
Ensure fields introduced in GHC 9.2.1 are set
sellout Dec 14, 2023
5aa593b
Have `eqTypeM` fall back to `eqType` pre-GHC 9.4
sellout Dec 14, 2023
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
8 changes: 5 additions & 3 deletions .github/workflows/ci.yml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -11,11 +11,13 @@ jobs:
build:
runs-on: ubuntu-latest
strategy:
fail-fast: false
matrix:
ghc:
- "9.0.2"
- "9.2.4"
- "9.4.8"
- "9.0.1"
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I think we should also do the last version of each branch, but we can do that separately.

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

We get the latest release covered in the Nix builds. Nix tends to not keep all the releases around, so I test the newer ones via Nix and the oldest via Cabal directly.

It does seem like the gold tests are passing in 9.4.8 (on Linux), but not in 9.4.1.

- "9.2.1"
- "9.2.2" # has breaking changes relative to 9.2.1
- "9.4.1"
steps:
- uses: actions/checkout@v2
- uses: haskell/actions/setup@v1
Expand Down
6 changes: 3 additions & 3 deletions classes/concat-classes.cabal
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
-- Initial concat.cabal generated by cabal init. For further
-- Initial concat.cabal generated by cabal init. For further
-- documentation, see http://haskell.org/cabal/users-guide/

name: concat-classes
Expand All @@ -25,7 +25,7 @@ library
include-dirs: src
install-includes: ConCat/Ops.inc
build-depends: base >=4.9
, constraints >= 0.8
, constraints >= 0.8 && < 0.14
, containers >= 0.5.7.1
, ghc-prim >= 0.5.0.0
, newtype-generics >= 0.5.3
Expand All @@ -38,7 +38,7 @@ library
, concat-inline
, concat-satisfy
, concat-known
exposed-modules:
exposed-modules:
ConCat.Orphans
ConCat.Misc
ConCat.Rep
Expand Down
2 changes: 1 addition & 1 deletion examples/concat-examples.cabal
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -29,7 +29,7 @@ library
install-includes: ConCat/AbsTy.inc
build-depends: base >=4.9
, newtype-generics >= 0.5.3
, constraints >= 0.8
, constraints >= 0.8 && < 0.14
, containers >= 0.5.7.1
, keys >= 3.11
, pointed
Expand Down
21 changes: 6 additions & 15 deletions plugin/concat-plugin.cabal
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
-- Initial concat.cabal generated by cabal init. For further
-- Initial concat.cabal generated by cabal init. For further
-- documentation, see http://haskell.org/cabal/users-guide/

name: concat-plugin
Expand Down Expand Up @@ -36,7 +36,7 @@ library
, finite-typelits, vector-sized >= 1.0.0.0
, concat-classes
, concat-satisfy
exposed-modules:
exposed-modules:
ConCat
ConCat.Translators
ConCat.OkType
Expand All @@ -60,18 +60,16 @@ Executable misc-examples
Build-Depends: base<5
, Cabal >= 1.24.0.0
, ghc-prim
, constraints >= 0.8
, constraints >= 0.8 && < 0.14
, newtype-generics >= 0.5.3
, pointed, keys
, distributive, adjunctions
, concat-inline
, concat-classes
, concat-plugin
, concat-examples
, ghc-prim
, integer-gmp
, distributive, adjunctions
, constraints >= 0.8
, constraints >= 0.8 && < 0.14
-- Array/vector experiments
, finite-typelits, vector-sized >= 1.0.0.0
ghc-options: -O2
Expand All @@ -88,19 +86,15 @@ Executable misc-trace
Build-Depends: base<5
, Cabal >= 1.24.0.0
, ghc-prim
, constraints >= 0.8
, constraints >= 0.8 && < 0.14
, newtype-generics >= 0.5.3
, pointed, keys
, distributive, adjunctions
, concat-inline
, concat-classes
, concat-plugin
, concat-examples
, ghc-prim
, integer-gmp
, keys
, distributive, adjunctions
, constraints >= 0.8
-- Array/vector experiments
, finite-typelits, vector-sized
ghc-options: -O2
Expand All @@ -119,7 +113,7 @@ Test-Suite gold-tests
Build-Depends: base<5
, Cabal >= 1.24.0.0
, ghc-prim
, constraints >= 0.8
, constraints >= 0.8 && < 0.14
, newtype-generics >= 0.5.3
, pointed, keys
, distributive, adjunctions
Expand All @@ -128,10 +122,7 @@ Test-Suite gold-tests
, concat-classes
, concat-plugin
, concat-examples
, ghc-prim
, integer-gmp
, distributive, adjunctions
, constraints >= 0.8
, bytestring
, tasty
, tasty-golden
Expand Down
35 changes: 21 additions & 14 deletions plugin/src/ConCat/NormaliseType.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,7 +1,10 @@
{-# LANGUAGE CPP #-}

-- | Utility functions for normalising, comparing types modulo type families.
module ConCat.NormaliseType(runDsM, normaliseTypeM, eqTypeM, runTcForSolver) where
module ConCat.NormaliseType (eqTypeM) where

import GHC.Plugins
#if MIN_VERSION_GLASGOW_HASKELL(9,4,0,0)
import GHC.HsToCore.Monad
import Data.Maybe (maybe)
import GHC.HsToCore.Monad
Expand All @@ -10,6 +13,20 @@ import GHC.Tc.Instance.Family (tcGetFamInstEnvs)
import GHC.Core.FamInstEnv (normaliseType)
import GHC.Core.Reduction (reductionReducedType)
import GHC.Tc.Types (TcM)
#endif

-- | compare two types after first normalising out type families
eqTypeM :: HscEnv -> DynFlags -> ModGuts -> Type -> Type -> IO Bool
#if MIN_VERSION_GLASGOW_HASKELL(9,4,0,0)
eqTypeM env dflags guts ty1 ty2 =
if ty1 `eqType` ty2
then return True
else
runTcForSolver env dflags guts $ do
famInstEnvs <- tcGetFamInstEnvs
let reduction1 = normaliseType famInstEnvs Nominal ty1
let reduction2 = normaliseType famInstEnvs Nominal ty2
return (reductionReducedType reduction1 `eqType` reductionReducedType reduction2)

-- | run a DsM program inside IO
runDsM :: HscEnv -> DynFlags -> ModGuts -> DsM a -> IO a
Expand All @@ -31,16 +48,6 @@ normaliseTypeM env dflags guts ty =
famInstEnvs <- tcGetFamInstEnvs
let reduction = normaliseType famInstEnvs Nominal ty
return (reductionReducedType reduction)

-- | compare two types after first normalising out type families
eqTypeM :: HscEnv -> DynFlags -> ModGuts -> Type -> Type -> IO Bool
eqTypeM env dflags guts ty1 ty2 =
if ty1 `eqType` ty2
then return True
else
runTcForSolver env dflags guts $ do
famInstEnvs <- tcGetFamInstEnvs
let reduction1 = normaliseType famInstEnvs Nominal ty1
let reduction2 = normaliseType famInstEnvs Nominal ty2
return (reductionReducedType reduction1 `eqType` reductionReducedType reduction2)

#else
eqTypeM _ _ _ ty1 ty2 = pure $ ty1 `eqType` ty2
#endif
4 changes: 3 additions & 1 deletion plugin/src/ConCat/Plugin.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1682,9 +1682,11 @@ install opts todos =
, sm_eta_expand = False -- ??
, sm_case_case = True
, sm_dflags = dflags
#if MIN_VERSION_GLASGOW_HASKELL(9,2,2,0)
, sm_cast_swizzle = True
#endif
#if MIN_VERSION_GLASGOW_HASKELL(9,2,0,0)
, sm_uf_opts = unfoldingOpts dflags
, sm_cast_swizzle = True
, sm_pre_inline = gopt Opt_SimplPreInlining dflags
, sm_logger = hsc_logger hsc_env
#endif
Expand Down
2 changes: 2 additions & 0 deletions satisfy/src/ConCat/Satisfy/Plugin.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -80,6 +80,8 @@ install _opts todos =
, sm_case_case = True
#if MIN_VERSION_GLASGOW_HASKELL(9,2,2,0)
, sm_cast_swizzle = True
#endif
#if MIN_VERSION_GLASGOW_HASKELL(9,2,0,0)
, sm_uf_opts = defaultUnfoldingOpts
, sm_pre_inline = False
, sm_logger = logger
Expand Down
Loading