summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorChristiaanBaaij <>2018-09-14 13:31:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2018-09-14 13:31:00 (GMT)
commit6bc71b0bac700c3be38785eb798a272a7b2b8535 (patch)
tree3ff6f42b56bb1afd849a1f5528329dc68280cb97
parent6b85c1967df3b8a209dbaf76e4db4dfb5b4786e4 (diff)
version 0.3HEAD0.3master
-rwxr-xr-x[-rw-r--r--]CHANGELOG.md3
-rwxr-xr-x[-rw-r--r--]README.md0
-rw-r--r--ghc-typelits-extra.cabal6
-rw-r--r--src/GHC/TypeLits/Extra.hs8
-rw-r--r--src/GHC/TypeLits/Extra/Solver.hs4
5 files changed, 13 insertions, 8 deletions
diff --git a/CHANGELOG.md b/CHANGELOG.md
index 387dd68..0c5a2d4 100644..100755
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,5 +1,8 @@
# Changelog for the [`ghc-typelits-extra`](http://hackage.haskell.org/package/ghc-typelits-extra) package
+# 0.3 *September 14th 2018*
+* Move `KnownNat2` instances for GHC 8.4's `Div` and `Mod` from `ghc-typelits-extra` to `ghc-typelits-knownnat`
+
# 0.2.6 *Julty 10th 2018*
* Add support for GHC-8.6.1-alpha1
diff --git a/README.md b/README.md
index d38f07f..d38f07f 100644..100755
--- a/README.md
+++ b/README.md
diff --git a/ghc-typelits-extra.cabal b/ghc-typelits-extra.cabal
index 01c4a0c..2e99550 100644
--- a/ghc-typelits-extra.cabal
+++ b/ghc-typelits-extra.cabal
@@ -1,5 +1,5 @@
name: ghc-typelits-extra
-version: 0.2.6
+version: 0.3
synopsis: Additional type-level operations on GHC.TypeLits.Nat
description:
Additional type-level operations on @GHC.TypeLits.Nat@:
@@ -69,7 +69,7 @@ library
ghc >= 7.10 && <8.8,
ghc-prim >= 0.5 && <1.0,
ghc-tcplugins-extra >= 0.2,
- ghc-typelits-knownnat >= 0.5 && <0.6,
+ ghc-typelits-knownnat >= 0.6 && <0.7,
ghc-typelits-natnormalise >= 0.6 && <0.7,
integer-gmp >= 1.0 && <1.1,
transformers >= 0.4.2.0 && <0.6
@@ -98,7 +98,7 @@ test-suite test-ghc-typelits-extra
Other-Modules: ErrorTests
build-depends: base >= 4.8 && <5,
ghc-typelits-extra,
- ghc-typelits-knownnat >= 0.2,
+ ghc-typelits-knownnat >= 0.6,
ghc-typelits-natnormalise >= 0.4.1,
tasty >= 0.10,
tasty-hunit >= 0.9,
diff --git a/src/GHC/TypeLits/Extra.hs b/src/GHC/TypeLits/Extra.hs
index 567aaf0..f28ae2d 100644
--- a/src/GHC/TypeLits/Extra.hs
+++ b/src/GHC/TypeLits/Extra.hs
@@ -129,14 +129,14 @@ instance (KnownNat x, KnownNat y) => KnownNat2 $(nameToSymbol ''Min) x y where
-- "GHC.TypeLits.Extra.Solver".
type family Div (x :: Nat) (y :: Nat) :: Nat where
Div x 1 = x
+
+instance (KnownNat x, KnownNat y, 1 <= y) => KnownNat2 $(nameToSymbol ''Div) x y where
+ natSing2 = SNatKn (quot (N.natVal (Proxy @x)) (N.natVal (Proxy @y)))
#endif
-- | A variant of 'Div' that rounds up instead of down
type DivRU n d = Div (n + (d - 1)) d
-instance (KnownNat x, KnownNat y, 1 <= y) => KnownNat2 $(nameToSymbol ''Div) x y where
- natSing2 = SNatKn (quot (N.natVal (Proxy @x)) (N.natVal (Proxy @y)))
-
#if !MIN_VERSION_ghc(8,4,0)
-- | Type-level 'mod'
--
@@ -144,10 +144,10 @@ instance (KnownNat x, KnownNat y, 1 <= y) => KnownNat2 $(nameToSymbol ''Div) x y
-- "GHC.TypeLits.Extra.Solver".
type family Mod (x :: Nat) (y :: Nat) :: Nat where
Mod x 1 = 0
-#endif
instance (KnownNat x, KnownNat y, 1 <= y) => KnownNat2 $(nameToSymbol ''Mod) x y where
natSing2 = SNatKn (rem (N.natVal (Proxy @x)) (N.natVal (Proxy @y)))
+#endif
-- | Type-level `divMod`
type DivMod n d = '(Div n d, Mod n d)
diff --git a/src/GHC/TypeLits/Extra/Solver.hs b/src/GHC/TypeLits/Extra/Solver.hs
index 30a6fb0..9bfa235 100644
--- a/src/GHC/TypeLits/Extra/Solver.hs
+++ b/src/GHC/TypeLits/Extra/Solver.hs
@@ -135,7 +135,9 @@ simplifyExtra eqs = tcPluginTrace "simplifyExtra" (ppr eqs) >> simples [] eqs
tcPluginTrace "unifyExtra result" (ppr ur)
case ur of
Win -> simples (((,) <$> evMagic ct <*> pure ct):evs) eqs'
- Lose -> return (Impossible eq)
+ Lose -> if null evs && null eqs'
+ then return (Impossible eq)
+ else simples evs eqs'
Draw -> simples evs eqs'
simples evs (eq@(Right (ct,u,v,b)):eqs') = do
tcPluginTrace "unifyExtra leq result" (ppr (u,v,b))