rank1dynamic 0.2.0.1 → 0.3.1.0

raw patch · 6 files changed

+35/−199 lines, 6 filesdep −constraintsdep ~ghc-primnew-uploaderPVP ok

version bump matches the API change (PVP)

Dependencies removed: constraints

Dependency ranges changed: ghc-prim

API changes (from Hackage documentation)

Files

• ChangeLog +4/−0
• LICENSE +1/−0
• rank1dynamic.cabal +6/−15
• src/Data/Rank1Dynamic.hs +0/−7
• src/Data/Rank1Typeable.hs +22/−111
• tests/test.hs +2/−66

@@ -1,3 +1,7 @@+2015-06-15  Facundo Domínguez  <facundo.dominguez@tweag.io>  0.2.1.0++* Loosen upper bound of ghc-prim.+ 2014-05-30  Tim Watson  <watson.timothy@gmail.com>  0.2.0.0  * Fix funResultTy so @funResultTy ANY _ = ANY@

@@ -1,4 +1,5 @@ Copyright (c) 2012, Edsko de Vries+Copyright (c) 2015, Tweag I/O Limited  All rights reserved. 

@@ -1,5 +1,5 @@ Name:                rank1dynamic-Version:             0.2.0.1+Version:             0.3.1.0 Synopsis:            Like Data.Dynamic/Data.Typeable but with support for rank-1 polymorphic types Description:         "Data.Typeable" and "Data.Dynamic" only support monomorphic types.                       In this package we provide similar functionality but with@@ -8,9 +8,9 @@ License:             BSD3 License-File:        LICENSE Author:              Edsko de Vries-Maintainer:          watson.timothy@gmail.com+Maintainer:          Facundo Domínguez <facundo.dominguez@tweag.io> Bug-Reports:         https://cloud-haskell.atlassian.net/browse/RANKNDYN-Copyright:           Well-Typed LLP+Copyright:           Well-Typed LLP, Tweag I/O Limited Category:            Data Build-Type:          Simple Cabal-Version:       >=1.8@@ -24,18 +24,12 @@   Exposed-Modules:     Data.Rank1Dynamic,                        Data.Rank1Typeable   Build-Depends:       base >= 4.4 && < 5,-                       ghc-prim >= 0.2 && < 0.4,+                       ghc-prim >= 0.2 && < 0.5,                        binary >= 0.5 && < 0.8   HS-Source-Dirs:      src   GHC-Options:         -Wall-  Extensions:          ConstraintKinds,-                       EmptyDataDecls,-                       ExistentialQuantification,+  Extensions:          EmptyDataDecls,                        DeriveDataTypeable,-                       KindSignatures,-                       PolyKinds,-                       RankNTypes,-                       StandaloneDeriving,                        ViewPatterns,                        CPP @@ -47,8 +41,5 @@                      rank1dynamic,                      test-framework >= 0.6 && < 0.9,                      test-framework-hunit >= 0.2.0 && < 0.4-  if impl(ghc >= 7.8)-    Build-Depends:   constraints >= 0.4 && < 0.5-  ghc-options:       -Wall -Werror-  Extensions:        CPP+  ghc-options:       -Wall   HS-Source-Dirs:    tests

@@ -22,13 +22,6 @@ -- > -- > > do f <- fromDynamic (toDynamic (id :: ANY -> ANY)) ; return $ (f :: Int) -- > Left "Cannot unify Int and ->"--- >--- > > do f <- fromDynamic (toDynamic (reifyConstraints return :: Dict (Monad Maybe) -> Int -> Maybe Int))--- >      return $ (abstractConstraints (f :: Dict (Monad Maybe) -> Int -> Maybe Int)) 0--- > Right (Just 0)------ Please, see @tests/test.hs@ for examples of how to write the higher-kinded--- case in ghc versions earlier than 7.6.3. -- -- [Examples of dynApply] --

@@ -32,32 +32,9 @@ -- > -- We CANNOT use a term of type 'forall a. a -> a' as 'forall a. a' -- > > typeOf (undefined :: ANY) `isInstanceOf` typeOf (undefined :: ANY -> ANY) -- > Left "Cannot unify Skolem and ->"--- >--- > -- We CAN use a term of type 'forall a. a -> m a' as 'Int -> Maybe Int'--- > > typeOf (undefined :: Int -> Maybe Int)--- >     `isInstanceOf` typeOf (undefined :: ANY1 -> ANY ANY1)--- > Left "Cannot unify Skolem and ->"--- >--- > -- We CAN use a term of type 'forall a. Monad a => a -> m a' as 'Int -> Maybe Int'--- > -- 'Dict' comes from "Data.Constraint" in the package "constraints".--- > > typeOf ((\Dict -> return) :: Dict (Monad Maybe) -> Int -> Maybe Int)--- >     `isInstanceOf` typeOf ((\Dict -> return) :: Dict (Monad ANY) -> ANY1 -> ANY ANY1)--- > Right () -- -- (Admittedly, the quality of the type errors could be improved.) ----- When using @-XPolyKinds@, the type signatures with higher-kinded variables--- need to be given as------ > (\Dict -> return) `asTypeOf` (undefined :: Dict (Monad ANY) -> ANY1 -> ANY ANY1)------ or------ > (\Dict -> return) :: Dict (Monad ANY) -> ANY1 -> ANY (ANY1 :: *)------ Please, see @tests/test.hs@ for examples of how to write the higher-kinded--- cases in ghc versions earlier than 7.8.3.--- -- [Examples of funResultTy] -- -- > -- Apply fn of type (forall a. a -> a) to arg of type Bool gives Bool@@ -79,7 +56,6 @@ -- > -- Cannot apply function of type (forall a. (a -> a) -> a -> a) to arg of type (Int -> Bool) -- > > funResultTy (typeOf (undefined :: (ANY -> ANY) -> (ANY -> ANY))) (typeOf (undefined :: Int -> Bool)) -- > Left "Cannot unify Int and Bool"-{-# OPTIONS_GHC -fno-warn-orphans #-} module Data.Rank1Typeable   ( -- * Basic types     TypeRep@@ -126,21 +102,9 @@ import Data.List (intersperse, isPrefixOf) import Data.Maybe (fromMaybe) import Data.Typeable (Typeable, mkTyCon3)-#if !MIN_VERSION_base(4,7,0)-import Data.Typeable-  ( Typeable1(..)-  , Typeable2(..)-  , Typeable3(..)-  , Typeable4(..)-  , Typeable5(..)-  , Typeable6(..)-  , Typeable7(..)-  )-#endif import Data.Typeable.Internal (listTc, funTc, TyCon(TyCon), tyConName) import Data.Binary (Binary(get, put)) import GHC.Fingerprint.Type (Fingerprint(..))-import GHC.Exts(Any) import qualified Data.Typeable as Typeable   ( TypeRep   , typeOf@@ -209,23 +173,16 @@ mkTyConApp c ts   = TypeRep (Typeable.mkTyConApp c (map underlyingTypeRep ts)) -isTypVarApp :: TypeRep -> Maybe (Var, [TypeRep])-isTypVarApp (splitTyConApp -> (c, (t0:t:ts)))-    | c == typVar && t0 == typTag = Just (t,ts)-isTypVarApp _ = Nothing--mkTypVarApp :: Var -> [TypeRep] -> TypeRep-mkTypVarApp x = mkTyConApp typVar . (typTag :) . (x :)+isTypVar :: TypeRep -> Maybe Var+isTypVar (splitTyConApp -> (c, [t])) | c == typVar = Just t+isTypVar _ = Nothing -mkTyApp :: TypeRep -> [TypeRep] -> TypeRep-mkTyApp (splitTyConApp -> (c, ts)) = mkTyConApp c . (ts++)+mkTypVar :: Var -> TypeRep+mkTypVar x = mkTyConApp typVar [x]  typVar :: TyCon typVar = let (c, _) = splitTyConApp (typeOf (undefined :: TypVar V0)) in c -typTag :: TypeRep-typTag = typeOf (undefined :: T)- skolem :: TyCon skolem = let (c, _) = splitTyConApp (typeOf (undefined :: Skolem V0)) in c @@ -233,41 +190,10 @@ -- Type variables                                                             -- -------------------------------------------------------------------------------- --- | Internal tag to distinguish our uses of Any from user's.-data T               deriving Typeable--type TypVar = Any T-data Skolem (a :: *) deriving Typeable-data Zero            deriving Typeable-data Succ   (a :: *) deriving Typeable--#if MIN_VERSION_base(4,7,0)-deriving instance Typeable Any-#else-instance Typeable Any where-  typeOf _ = Typeable.mkTyConApp (mkTyCon3 "ghc-prim" "GHC.Prim" "Any") []--instance Typeable1 Any where-  typeOf1 _ = Typeable.mkTyConApp (mkTyCon3 "ghc-prim" "GHC.Prim" "Any") []--instance Typeable2 Any where-  typeOf2 _ = Typeable.mkTyConApp (mkTyCon3 "ghc-prim" "GHC.Prim" "Any") []--instance Typeable3 Any where-  typeOf3 _ = Typeable.mkTyConApp (mkTyCon3 "ghc-prim" "GHC.Prim" "Any") []--instance Typeable4 Any where-  typeOf4 _ = Typeable.mkTyConApp (mkTyCon3 "ghc-prim" "GHC.Prim" "Any") []--instance Typeable5 Any where-  typeOf5 _ = Typeable.mkTyConApp (mkTyCon3 "ghc-prim" "GHC.Prim" "Any") []--instance Typeable6 Any where-  typeOf6 _ = Typeable.mkTyConApp (mkTyCon3 "ghc-prim" "GHC.Prim" "Any") []--instance Typeable7 Any where-  typeOf7 _ = Typeable.mkTyConApp (mkTyCon3 "ghc-prim" "GHC.Prim" "Any") []-#endif+data TypVar a deriving Typeable+data Skolem a deriving Typeable+data Zero     deriving Typeable+data Succ a   deriving Typeable  type V0 = Zero type V1 = Succ V0@@ -306,7 +232,7 @@ -- of type @t1@ to an argument of type @t2@ funResultTy :: TypeRep -> TypeRep -> Either TypeError TypeRep funResultTy t1 t2 = do-  let anyTy = mkTypVarApp (typeOf (undefined :: V0)) []+  let anyTy = mkTypVar $ typeOf (undefined :: V0)   s <- unify (alphaRename "f" t1) $ mkTyConApp funTc [alphaRename "x" t2, anyTy]   return $ normalize $ subst s anyTy @@ -315,20 +241,20 @@ --------------------------------------------------------------------------------  alphaRename :: String -> TypeRep -> TypeRep-alphaRename prefix (isTypVarApp -> Just (x,ts)) =-  mkTypVarApp (mkTyConApp (mkTyCon prefix) [x]) (map (alphaRename prefix) ts)+alphaRename prefix (isTypVar -> Just x) =+  mkTypVar (mkTyConApp (mkTyCon prefix) [x]) alphaRename prefix (splitTyConApp -> (c, ts)) =   mkTyConApp c (map (alphaRename prefix) ts)  tvars :: TypeRep -> [Var]-tvars (isTypVarApp -> Just (x, ts)) =  x : concatMap tvars ts+tvars (isTypVar -> Just x)       = [x] tvars (splitTyConApp -> (_, ts)) = concatMap tvars ts  normalize :: TypeRep -> TypeRep normalize t = subst (zip (tvars t) anys) t   where     anys :: [TypeRep]-    anys = map (flip mkTypVarApp []) (iterate succ zero)+    anys = map mkTypVar (iterate succ zero)      succ :: TypeRep -> TypeRep     succ = mkTyConApp succTyCon . (:[])@@ -354,16 +280,15 @@ type Var          = TypeRep  skolemize :: TypeRep -> TypeRep-skolemize (isTypVarApp -> Just (x, ts)) = mkTyConApp skolem $ x : map skolemize ts-skolemize (splitTyConApp -> (c, ts))    = mkTyConApp c (map skolemize ts)+skolemize (isTypVar -> Just x)       = mkTyConApp skolem [x]+skolemize (splitTyConApp -> (c, ts)) = mkTyConApp c (map skolemize ts)  occurs :: Var -> TypeRep -> Bool-occurs x (isTypVarApp -> Just (x', ts)) = x == x' || any (occurs x) ts+occurs x (isTypVar -> Just x')      = x == x' occurs x (splitTyConApp -> (_, ts)) = any (occurs x) ts  subst :: Substitution -> TypeRep -> TypeRep-subst s (isTypVarApp -> Just (x, ts)) =-     flip mkTyApp (map (subst s) ts) $ fromMaybe (mkTypVarApp x []) (lookup x s)+subst s (isTypVar -> Just x)       = fromMaybe (mkTypVar x) (lookup x s) subst s (splitTyConApp -> (c, ts)) = mkTyConApp c (map (subst s) ts)  unify :: TypeRep@@ -378,23 +303,13 @@       return acc     go acc ((t1, t2) : eqs) | t1 == t2 = -- Note: equality check is fast       go acc eqs-    go acc ((isTypVarApp -> Just (x, []), t) : eqs) =+    go acc ((isTypVar -> Just x, t) : eqs) =       if x `occurs` t         then Left "Occurs check"         else go ((x, t) : map (second $ subst [(x, t)]) acc)                 (map (subst [(x, t)] *** subst [(x, t)]) eqs)-    -- The left-hand side of the equation is a type variable application.-    -- Decompose the right-hand side of the equation.-    go acc ((t1@(isTypVarApp -> Just (x, ts)), t2) : eqs) =-      let (t,ts') = case isTypVarApp t2 of-                      Just (x', ts'') -> (mkTypVarApp x' [], ts'')-                      Nothing        -> let (c,ts'') = splitTyConApp t2-                                         in (mkTyConApp c [], ts'')-       in if length ts == length ts'-            then go acc ((mkTypVarApp x [], t) : zip ts ts' ++ eqs)-            else Left $ "Cannot unify " ++ show t1 ++ " and " ++ show t2-    go acc ((t, isTypVarApp -> Just (x, ts)) : eqs) =-      go acc ((mkTypVarApp x ts, t) : eqs)+    go acc ((t, isTypVar -> Just x) : eqs) =+      go acc ((mkTypVar x, t) : eqs)     go acc ((splitTyConApp -> (c1, ts1), splitTyConApp -> (c2, ts2)) : eqs) =       if c1 /= c2         then Left $ "Cannot unify " ++ show c1 ++ " and " ++ show c2@@ -408,11 +323,7 @@   showsPrec p (splitTyConApp -> (tycon, tys)) =       case tys of         [] -> showsPrec p tycon-        (t0 : (anyIdx -> Just i) : ts) | tycon == typVar && t0 == typTag ->-          if null ts-            then showString "ANY" . showIdx i-            else showParen (p > 9) $ showString "ANY" . showIdx i .-                                     showChar ' ' . showArgs ts+        [anyIdx -> Just i] | tycon == typVar -> showString "ANY" . showIdx i         [x] | tycon == listTc ->           showChar '[' . shows x . showChar ']'         [a,r] | tycon == funTc ->

@@ -1,22 +1,7 @@-#if !MIN_VERSION_base(4,7,0)-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE ExistentialQuantification #-}-#if !MIN_VERSION_base(4,6,0)-{-# LANGUAGE KindSignatures #-}-#endif-#endif-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}-+{-# LANGUAGE CPP #-} import Data.Rank1Typeable import Data.Rank1Dynamic -#if MIN_VERSION_base(4,7,0)-import Data.Constraint (Dict(..))-#else-import qualified Data.Typeable as Typeable (Typeable(..),Typeable1(..), mkTyCon3, mkTyConApp)-#endif import Test.HUnit hiding (Test) import Test.Framework import Test.Framework.Providers.HUnit@@ -26,19 +11,6 @@ main :: IO () main = defaultMain tests -#if MIN_VERSION_base(4,7,0)-deriving instance Typeable Monad-#else-data MonadDict m = Monad m => MonadDict--instance Typeable.Typeable1 m => Typeable (MonadDict m) where-  typeOf _ = Typeable.mkTyConApp (Typeable.mkTyCon3 "main" "Main" "MonadDict")-               [ Typeable.typeOf1 (undefined :: m a) ]--returnD :: MonadDict m -> a -> m a-returnD MonadDict = return-#endif- tests :: [Test] tests =   [ testGroup "Examples of isInstanceOf"@@ -68,33 +40,7 @@           @?= Left "Cannot unify Skolem and (->)" #else           @?= Left "Cannot unify Skolem and ->"-#endif--      , testCase "CAN use a term of type 'forall a. a -> m a' as 'Int -> Maybe Int'" $-          typeOf (undefined :: Int -> Maybe Int)-            `isInstanceOf`-#if MIN_VERSION_base(4,6,0)-               typeOf (undefined :: ANY1 -> ANY ANY1)-#else-               typeOf (undefined :: ANY1 -> ANY (ANY1 :: *))-#endif-          @?= Right ()--      , testCase "CAN use a term of type 'forall a. Monad a => a -> m a' as 'Int -> Maybe Int'" $-#if MIN_VERSION_base(4,7,0)-          typeOf ((\Dict -> return) :: Dict (Monad Maybe) -> Int -> Maybe Int)-            `isInstanceOf`-               typeOf ((\Dict -> return) :: Dict (Monad ANY) -> ANY1 -> ANY ANY1)-#else-          typeOf (returnD :: MonadDict Maybe -> Int -> Maybe Int)-            `isInstanceOf`-#if MIN_VERSION_base(4,6,0)-               typeOf (returnD :: MonadDict ANY -> ANY1 -> ANY ANY1)-#else-               typeOf (returnD :: MonadDict ANY -> ANY1 -> ANY (ANY1 :: *))-#endif-#endif-          @?= Right ()+#endif        ]    , testGroup "Examples of funResultTy"@@ -154,16 +100,6 @@ #else           @?= Left "Cannot unify Int and ->" #endif--      , testCase "CAN use a term of type 'forall a. Monad a => a -> m a' as 'Int -> Maybe Int'" $-#if MIN_VERSION_base(4,7,0)-          do f <- fromDynamic (toDynamic ((\Dict -> return) :: Dict (Monad Maybe) -> Int -> Maybe Int))-             return $ (f :: Dict (Monad Maybe) -> Int -> Maybe Int) Dict 0-#else-          do f <- fromDynamic (toDynamic (returnD :: MonadDict Maybe -> Int -> Maybe Int))-             return $ ((f :: MonadDict Maybe -> Int -> Maybe Int) MonadDict) 0-#endif-          @?= Right (Just 0)       ]    , testGroup "Examples of dynApply"