th-abstraction 0.2.6.0 → 0.2.7.0
raw patch · 5 files changed
+58/−15 lines, 5 filesdep ~containersPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: containers
API changes (from Hackage documentation)
Files
- ChangeLog.md +5/−0
- src/Language/Haskell/TH/Datatype.hs +28/−10
- test/Main.hs +19/−2
- test/Types.hs +3/−0
- th-abstraction.cabal +3/−3
ChangeLog.md view
@@ -1,5 +1,10 @@ # Revision history for th-abstraction +## 0.2.7.0 -- 2018-06-17+* Fix bug in which data family instances with duplicate occurrences of type+ variables in the left-hand side would have redundant equality constraints+ in their contexts.+ ## 0.2.6.0 -- 2017-09-04 * Fix bug in which `applySubstitution` and `freeVariables` would ignore type variables in the kinds of type variable binders.
src/Language/Haskell/TH/Datatype.hs view
@@ -929,17 +929,28 @@ (Map Name Name, Cxt) mergeArguments ns ts = foldr aux (Map.empty, []) (zip ns ts) where- aux (SigT x _, y) sc = aux (x,y) sc -- learn about kinds??- aux (x, SigT y _) sc = aux (x,y) sc aux (f `AppT` x, g `AppT` y) sc = aux (x,y) (aux (f,g) sc) aux (VarT n,p) (subst, context) = case p of- VarT m | Map.notMember m subst -> (Map.insert m n subst, context)+ VarT m | m == n -> (subst, context)+ -- If the two variables are the same, don't bother extending+ -- the substitution. (This is purely an optimization.)+ | Just n' <- Map.lookup m subst+ , n == n' -> (subst, context)+ -- If a variable is already in a substitution and it maps+ -- to the variable that we are trying to unify with, then+ -- leave the context alone. (Not doing so caused #46.)+ | Map.notMember m subst -> (Map.insert m n subst, context) _ -> (subst, equalPred (VarT n) p : context) + aux (SigT x _, y) sc = aux (x,y) sc -- learn about kinds??+ -- This matches *after* VarT so that we can compute a substitution+ -- that includes the kind signature.+ aux (x, SigT y _) sc = aux (x,y) sc+ aux _ sc = sc -- | Expand all of the type synonyms in a type.@@ -1255,6 +1266,10 @@ -- | Compute the type variable substitution that unifies a list of types, -- or fail in 'Q'.+--+-- All infix issue should be resolved before using 'unifyTypes'+--+-- Alpha equivalent quantified types are not unified. unifyTypes :: [Type] -> Q (Map Name Type) unifyTypes [] = return Map.empty unifyTypes (t:ts) =@@ -1277,20 +1292,23 @@ unify' (VarT n) (VarT m) | n == m = pure Map.empty unify' (VarT n) t | n `elem` freeVariables t = Left (VarT n, t)- | otherwise = pure (Map.singleton n t)+ | otherwise = Right (Map.singleton n t) unify' t (VarT n) | n `elem` freeVariables t = Left (VarT n, t)- | otherwise = pure (Map.singleton n t)--unify' (ConT n) (ConT m) | n == m = pure Map.empty+ | otherwise = Right (Map.singleton n t) unify' (AppT f1 x1) (AppT f2 x2) = do sub1 <- unify' f1 f2 sub2 <- unify' (applySubstitution sub1 x1) (applySubstitution sub1 x2)- return (combineSubstitutions sub1 sub2)+ Right (combineSubstitutions sub1 sub2) -unify' (TupleT n) (TupleT m) | n == m = pure Map.empty+-- Doesn't unify kind signatures+unify' (SigT t _) u = unify' t u+unify' t (SigT u _) = unify' t u -unify' t u = Left (t,u)+-- only non-recursive cases should remain at this point+unify' t u+ | t == u = Right Map.empty+ | otherwise = Left (t,u) -- | Construct an equality constraint. The implementation of 'Pred' varies
test/Main.hs view
@@ -26,10 +26,8 @@ import Control.Monad (zipWithM_) #endif -#if MIN_VERSION_template_haskell(2,8,0) import Control.Monad (unless) import qualified Data.Map as Map-#endif #if MIN_VERSION_base(4,7,0) import Data.Type.Equality ((:~:)(..))@@ -64,6 +62,7 @@ famLocalDecTest1 famLocalDecTest2 recordFamTest+ t46Test #endif fixityLookupTest #if __GLASGOW_HASKELL__ >= 704@@ -77,6 +76,7 @@ #if MIN_VERSION_template_haskell(2,8,0) kindSubstTest #endif+ regressionTest44 adt1Test :: IO () adt1Test =@@ -512,6 +512,16 @@ recordFamTest = $(do info <- reifyRecord 'famRec1 validateCI info gadtRecFamCI)++t46Test :: IO ()+t46Test =+ $(do info <- reifyDatatype 'MkT46+ case info of+ DatatypeInfo { datatypeCons = [ConstructorInfo { constructorContext = ctxt }]} ->+ unless (null ctxt) (fail "regression test for ticket #46 failed")+ _ -> fail "T46 should have exactly one constructor"+ [| return () |])+ #endif fixityLookupTest :: IO ()@@ -606,3 +616,10 @@ checkFreeVars substTy [k2] [| return () |]) #endif++regressionTest44 :: IO ()+regressionTest44 =+ $(do intToInt <- [t| Int -> Int |]+ unified <- unifyTypes [intToInt, intToInt]+ unless (Map.null unified) (fail "regression test for ticket #44 failed")+ [| return () |])
test/Types.hs view
@@ -95,6 +95,9 @@ data family FamLocalDec1 a data family FamLocalDec2 a b c++data family T46 a b c+data instance T46 (f (p :: *)) (f p) q = MkT46 q #endif #if __GLASGOW_HASKELL__ >= 704
th-abstraction.cabal view
@@ -1,5 +1,5 @@ name: th-abstraction-version: 0.2.6.0+version: 0.2.7.0 synopsis: Nicer interface for reified information about data types description: This package normalizes variations in the interface for inspecting datatype information via Template Haskell@@ -17,7 +17,7 @@ build-type: Simple extra-source-files: ChangeLog.md README.md cabal-version: >=1.10-tested-with: GHC==8.0.2, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2, GHC==7.2.2, GHC==7.0.4+tested-with: GHC==8.4.3, GHC==8.2.2, GHC==8.0.2, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2, GHC==7.2.2, GHC==7.0.4 source-repository head type: git@@ -28,7 +28,7 @@ other-modules: Language.Haskell.TH.Datatype.Internal build-depends: base >=4.3 && <5, ghc-prim,- template-haskell >=2.5 && <2.13,+ template-haskell >=2.5 && <2.14, containers >=0.4 && <0.6 hs-source-dirs: src default-language: Haskell2010