ghc-typelits-knownnat 0.1 → 0.1.1

raw patch · 4 files changed

+12/−8 lines, 4 files

Files

CHANGELOG.md +3/−0
ghc-typelits-knownnat.cabal +1/−1
src/GHC/TypeLits/KnownNat/Solver.hs +7/−6
tests/Main.hs +1/−1

CHANGELOG.md view

@@ -1,4 +1,7 @@ # Changelog for the [`ghc-typelits-knownnat`](http://hackage.haskell.org/package/ghc-typelits-knownnat) package +## 0.1.1 *August 11th 2016*+* Fixes bug: panic on a non-given KnownNat constraint variable+ ## 0.1 *August 10th 2016* * Initial release

ghc-typelits-knownnat.cabal view

@@ -1,5 +1,5 @@ name:                ghc-typelits-knownnat-version:             0.1+version:             0.1.1 synopsis:            Derive KnownNat constraints from other KnownNat constraints description:   A type checker plugin for GHC that can derive \"complex\" @KnownNat@

src/GHC/TypeLits/KnownNat/Solver.hs view

@@ -60,7 +60,7 @@ import Module     (mkModuleName) import OccName    (mkTcOcc) import Outputable (Outputable (..), (<+>), integer, text, vcat)-import Panic      (panic, pgmErrorDoc)+import Panic      (panicDoc, pgmErrorDoc) import Plugins    (Plugin (..), defaultPlugin) import PrelNames  (knownNatClassName) import TcEvidence (EvTerm (..), EvLit (EvNum), mkEvCast, mkTcSymCo, mkTcTransCo)@@ -239,16 +239,17 @@ constraintToEvTerm defs kn_map (ct,cls,op) = (,ct) <$> go op   where     go (I i) = makeLitDict cls (mkNumLitTy i) i-    go (V v) | Just (ct',_,_) <- lookup v kn_map =-      let ct_ev = ctEvidence ct'-          evT   = ctev_evar ct_ev-      in  Just (EvId evT)+    go (V v) = case lookup v kn_map of+      Just (ct',_,_) -> let ct_ev = ctEvidence ct'+                            evT   = ctev_evar ct_ev+                        in  Just (EvId evT)+      Nothing -> Nothing     go e = do       let (x,y,df) = case e of             Add x' y' -> (x',y',knAddDFunId defs)             Mul x' y' -> (x',y',knMulDFunId defs)             Exp x' y' -> (x',y',knExpDFunId defs)-            _ -> panic "GHC.TypeLits.KnownNat.Solver: not an op"+            _ -> panicDoc "GHC.TypeLits.KnownNat.Solver: not an op" (ppr e)       x' <- go x       y' <- go y       makeOpDict df cls (reifyOp x) (reifyOp y) (reifyOp e) x' y'

tests/Main.hs view

@@ -31,7 +31,7 @@     [ testCase "KnownNat 4 + KnownNat 6 ~ 10" $       show (test1 (Proxy @ 4)) @?=       "10"-    , testCase "KnownNat 4 + KnownNat 3 ~ 12" $+    , testCase "KnownNat 4 * KnownNat 3 ~ 12" $       show (test2 (Proxy @ 4)) @?=       "12"     , testCase "KnownNat 2 + KnownNat 7 ~ 9" $