ghc-typelits-natnormalise 0.4.4 → 0.4.5

raw patch · 3 files changed

+35/−8 lines, 3 files

Files

• CHANGELOG.md +4/−0
• ghc-typelits-natnormalise.cabal +1/−1
• src/GHC/TypeLits/Normalise/Unify.hs +30/−7

@@ -1,5 +1,9 @@ # Changelog for the [`ghc-typelits-natnormalise`](http://hackage.haskell.org/package/ghc-typelits-natnormalise) package +## 0.4.5 *July 20th 2016*+* Fixes bugs:+  * Reifying negative exponent causes GHC panic+ ## 0.4.4 *July 19th 2016* * Fixes bugs:   * Rounding error in `logBase` calculation

@@ -1,5 +1,5 @@ name:                ghc-typelits-natnormalise-version:             0.4.4+version:             0.4.5 synopsis:            GHC typechecker plugin for types of kind GHC.TypeLits.Nat description:   A type checker plugin for GHC that can solve /equalities/ of types of kind

@@ -107,14 +107,37 @@                                  p  reifyProduct :: CoreProduct -> Type-reifyProduct = foldr1 (\t1 t2 -> mkTyConApp typeNatMulTyCon [t1,t2])-             . map reifySymbol . unP+reifyProduct (P ps) =+    let ps' = map reifySymbol (foldr mergeExp [] ps)+    in  foldr (\t1 t2 -> mkTyConApp typeNatMulTyCon [t1,t2]) (head ps') (tail ps')+  where+    -- "2 ^ -1 * 2 ^ a" must be merged into "2 ^ (a-1)", otherwise GHC barfs+    -- at the "2 ^ -1" because of the negative exponent.+    mergeExp :: CoreSymbol -> [Either CoreSymbol (CoreSOP,CoreProduct,Integer)]+                           -> [Either CoreSymbol (CoreSOP,CoreProduct,Integer)]+    mergeExp (E s1 (P [I i])) (y:ys)+      | i < 0+      , Left (E s2 p2) <- y+      , s1 == s2+      = Right (s1,p2,negate i) : ys+      | i < 0+      , Right (s2,p2,j) <- y+      , s1 == s2+      = Right (s1,p2,j+negate i) : ys+    mergeExp x ys = Left x:ys -reifySymbol :: CoreSymbol -> Type-reifySymbol (I i)   = mkNumLitTy i-reifySymbol (C c)   = c-reifySymbol (V v)   = mkTyVarTy v-reifySymbol (E s p) = mkTyConApp typeNatExpTyCon [reifySOP s,reifyProduct p]+reifySymbol :: Either CoreSymbol (CoreSOP,CoreProduct,Integer) -> Type+reifySymbol (Left (I i)  )  = mkNumLitTy i+reifySymbol (Left (C c)  )  = c+reifySymbol (Left (V v)  )  = mkTyVarTy v+reifySymbol (Left (E s p))  = mkTyConApp typeNatExpTyCon [reifySOP s,reifyProduct p]+reifySymbol (Right (s,p,i)) = mkTyConApp typeNatExpTyCon+                                         [reifySOP s+                                         ,mkTyConApp typeNatSubTyCon+                                                     [reifyProduct p+                                                     ,mkNumLitTy i+                                                     ]+                                         ]  -- | A substitution is essentially a list of (variable, 'SOP') pairs, -- but we keep the original 'Ct' that lead to the substitution being