rank1dynamic 0.1.0.2 → 0.2.0.0
raw patch · 4 files changed
+102/−80 lines, 4 filesdep ~basedep ~binarynew-uploaderPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base, binary
API changes (from Hackage documentation)
Files
- ChangeLog +17/−0
- rank1dynamic.cabal +11/−5
- src/Data/Rank1Dynamic.hs +21/−21
- src/Data/Rank1Typeable.hs +53/−54
+ ChangeLog view
@@ -0,0 +1,17 @@+2014-05-30 Tim Watson <watson.timothy@gmail.com> 0.2.0.0++* Fix funResultTy so @funResultTy ANY _ = ANY@+* Ensure the result of funResultTy is consistent with unification+* Bump binary version to include 0.7.*++2012-11-22 Edsko de Vries <edsko@well-typed.com> 0.1.0.2++* Relax package bounds to allow for Binary 0.6++2012-09-27 Edsko de Vries <edsko@well-typed.com> 0.1.0.1++* Relax lower bound of base to 4.4 (ghc 7.2)++2012-08-10 Edsko de Vries <edsko@well-typed.com> 0.1.0.0++* Initial release.
rank1dynamic.cabal view
@@ -1,25 +1,31 @@ Name: rank1dynamic-Version: 0.1.0.2+Version: 0.2.0.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 support for rank-1 polymorphic types. -Homepage: http://github.com/haskell-distributed/distributed-process+Homepage: http://haskell-distributed.github.com License: BSD3 License-File: LICENSE Author: Edsko de Vries-Maintainer: edsko@well-typed.com+Maintainer: watson.timothy@gmail.com+Bug-Reports: https://cloud-haskell.atlassian.net/browse/RANKNDYN Copyright: Well-Typed LLP Category: Data Build-Type: Simple Cabal-Version: >=1.8+extra-source-files: ChangeLog +Source-Repository head+ Type: git+ Location: https://github.com/haskell-distributed/rank1dynamic+ Library Exposed-Modules: Data.Rank1Dynamic, Data.Rank1Typeable- Build-Depends: base >= 4.4 && < 4.7,+ Build-Depends: base >= 4.4 && < 5, ghc-prim >= 0.2 && < 0.4,- binary >= 0.5 && < 0.7 + binary >= 0.5 && < 0.8 HS-Source-Dirs: src GHC-Options: -Wall Extensions: EmptyDataDecls,
src/Data/Rank1Dynamic.hs view
@@ -5,42 +5,42 @@ -- These examples correspond to the 'Data.Rank1Typeable.isInstanceOf' examples -- in "Data.Rank1Typeable". ----- > > do f <- fromDynamic (toDynamic (even :: Int -> Bool)) ; return $ (f :: Int -> Int) 0 +-- > > do f <- fromDynamic (toDynamic (even :: Int -> Bool)) ; return $ (f :: Int -> Int) 0 -- > Left "Cannot unify Int and Bool"--- > +-- > -- > > do f <- fromDynamic (toDynamic (const 1 :: ANY -> Int)) ; return $ (f :: Int -> Int) 0 -- > Right 1--- > +-- > -- > > do f <- fromDynamic (toDynamic (unsafeCoerce :: ANY1 -> ANY2)) ; return $ (f :: Int -> Int) 0 -- > Right 0--- > +-- > -- > > do f <- fromDynamic (toDynamic (id :: ANY -> ANY)) ; return $ (f :: Int -> Bool) 0 -- > Left "Cannot unify Bool and Int"--- > +-- > -- > > do f <- fromDynamic (toDynamic (undefined :: ANY)) ; return $ (f :: Int -> Int) 0 -- > Right *** Exception: Prelude.undefined--- > +-- > -- > > do f <- fromDynamic (toDynamic (id :: ANY -> ANY)) ; return $ (f :: Int) -- > Left "Cannot unify Int and ->" -- -- [Examples of dynApply]--- +-- -- These examples correspond to the 'Data.Rank1Typeable.funResultTy' examples -- in "Data.Rank1Typeable". -- -- > > do app <- toDynamic (id :: ANY -> ANY) `dynApply` toDynamic True ; f <- fromDynamic app ; return $ (f :: Bool) -- > Right True--- > +-- > -- > > do app <- toDynamic (const :: ANY -> ANY1 -> ANY) `dynApply` toDynamic True ; f <- fromDynamic app ; return $ (f :: Int -> Bool) 0 -- > Right True--- > +-- > -- > > do app <- toDynamic (($ True) :: (Bool -> ANY) -> ANY) `dynApply` toDynamic (id :: ANY -> ANY) ; f <- fromDynamic app ; return (f :: Bool) -- > Right True--- > +-- > -- > > app <- toDynamic (const :: ANY -> ANY1 -> ANY) `dynApply` toDynamic (id :: ANY -> ANY) ; f <- fromDynamic app ; return $ (f :: Int -> Bool -> Bool) 0 True -- > Right True--- > --- > > do app <- toDynamic ((\f -> f . f) :: (ANY -> ANY) -> ANY -> ANY) `dynApply` toDynamic (even :: Int -> Bool) ; f <- fromDynamic app ; return (f :: ()) +-- >+-- > > do app <- toDynamic ((\f -> f . f) :: (ANY -> ANY) -> ANY -> ANY) `dynApply` toDynamic (even :: Int -> Bool) ; f <- fromDynamic app ; return (f :: ()) -- > Left "Cannot unify Int and Bool" -- -- [Using toDynamic]@@ -48,30 +48,30 @@ -- When using polymorphic values you need to give an explicit type annotation: -- -- > > toDynamic id--- > +-- > -- > <interactive>:46:1: -- > Ambiguous type variable `a0' in the constraint: -- > (Typeable a0) arising from a use of `toDynamic' -- > Probable fix: add a type signature that fixes these type variable(s) -- > In the expression: toDynamic id -- > In an equation for `it': it = toDynamic id--- +-- -- versus -- -- > > toDynamic (id :: ANY -> ANY) -- > <<ANY -> ANY>>--- +-- -- Note that these type annotation are checked by ghc like any other: -- -- > > toDynamic (id :: ANY -> ANY1)--- > +-- > -- > <interactive>:45:12: -- > Couldn't match expected type `V1' with actual type `V0' -- > Expected type: ANY -> ANY1 -- > Actual type: ANY -> ANY -- > In the first argument of `toDynamic', namely `(id :: ANY -> ANY1)' -- > In the expression: toDynamic (id :: ANY -> ANY1)-module Data.Rank1Dynamic +module Data.Rank1Dynamic ( Dynamic , toDynamic , fromDynamic@@ -81,7 +81,7 @@ ) where import qualified GHC.Prim as GHC (Any)-import Data.Rank1Typeable +import Data.Rank1Typeable ( Typeable , TypeRep , typeOf@@ -95,16 +95,16 @@ data Dynamic = Dynamic TypeRep GHC.Any instance Show Dynamic where- showsPrec _ (Dynamic t _) = showString "<<" . shows t . showString ">>" + showsPrec _ (Dynamic t _) = showString "<<" . shows t . showString ">>" --- | Introduce a dynamic value +-- | Introduce a dynamic value toDynamic :: Typeable a => a -> Dynamic toDynamic x = Dynamic (typeOf x) (unsafeCoerce x) -- | Eliminate a dynamic value fromDynamic :: Typeable a => Dynamic -> Either TypeError a fromDynamic (Dynamic t v) =- case unsafeCoerce v of + case unsafeCoerce v of r -> case typeOf r `isInstanceOf` t of Left err -> Left err Right () -> Right r
src/Data/Rank1Typeable.hs view
@@ -1,7 +1,7 @@ -- | Runtime type representation of terms with support for rank-1 polymorphic -- types with type variables of kind *. ----- The essence of this module is that we use the standard 'Typeable' +-- The essence of this module is that we use the standard 'Typeable' -- representation of "Data.Typeable" but we introduce a special (empty) data -- type 'TypVar' which represents type variables. 'TypVar' is indexed by an -- arbitrary other data type, giving you an unbounded number of type variables;@@ -12,23 +12,23 @@ -- > -- We CANNOT use a term of type 'Int -> Bool' as 'Int -> Int' -- > > typeOf (undefined :: Int -> Int) `isInstanceOf` typeOf (undefined :: Int -> Bool) -- > Left "Cannot unify Int and Bool"--- > +-- > -- > -- We CAN use a term of type 'forall a. a -> Int' as 'Int -> Int' -- > > typeOf (undefined :: Int -> Int) `isInstanceOf` typeOf (undefined :: ANY -> Int) -- > Right ()--- > +-- > -- > -- We CAN use a term of type 'forall a b. a -> b' as 'forall a. a -> a' -- > > typeOf (undefined :: ANY -> ANY) `isInstanceOf` typeOf (undefined :: ANY -> ANY1) -- > Right ()--- > +-- > -- > -- We CANNOT use a term of type 'forall a. a -> a' as 'forall a b. a -> b' -- > > typeOf (undefined :: ANY -> ANY1) `isInstanceOf` typeOf (undefined :: ANY -> ANY) -- > Left "Cannot unify Succ and Zero"--- > +-- > -- > -- We CAN use a term of type 'forall a. a' as 'forall a. a -> a' -- > > typeOf (undefined :: ANY -> ANY) `isInstanceOf` typeOf (undefined :: ANY) -- > Right ()--- > +-- > -- > -- 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 ->"@@ -37,14 +37,14 @@ -- -- [Examples of funResultTy] ----- > -- Apply fn of type (forall a. a -> a) to arg of type Bool gives Bool +-- > -- Apply fn of type (forall a. a -> a) to arg of type Bool gives Bool -- > > funResultTy (typeOf (undefined :: ANY -> ANY)) (typeOf (undefined :: Bool)) -- > Right Bool--- > +-- > -- > -- Apply fn of type (forall a b. a -> b -> a) to arg of type Bool gives forall a. a -> Bool -- > > funResultTy (typeOf (undefined :: ANY -> ANY1 -> ANY)) (typeOf (undefined :: Bool)) -- > Right (ANY -> Bool) -- forall a. a -> Bool--- > +-- > -- > -- Apply fn of type (forall a. (Bool -> a) -> a) to argument of type (forall a. a -> a) gives Bool -- > > funResultTy (typeOf (undefined :: (Bool -> ANY) -> ANY)) (typeOf (undefined :: ANY -> ANY)) -- > Right Bool@@ -56,14 +56,14 @@ -- > -- 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"-module Data.Rank1Typeable - ( -- * Basic types +module Data.Rank1Typeable+ ( -- * Basic types TypeRep , typeOf , splitTyConApp , mkTyConApp , underlyingTypeRep- -- * Operations on type representations + -- * Operations on type representations , isInstanceOf , funResultTy , TypeError@@ -105,7 +105,7 @@ import Data.Typeable.Internal (listTc, funTc, TyCon(TyCon), tyConName) import Data.Binary (Binary(get, put)) import GHC.Fingerprint.Type (Fingerprint(..))-import qualified Data.Typeable as Typeable +import qualified Data.Typeable as Typeable ( TypeRep , typeOf , splitTyConApp@@ -117,15 +117,15 @@ -------------------------------------------------------------------------------- -- | Dynamic type representation with support for rank-1 types-newtype TypeRep = TypeRep { +newtype TypeRep = TypeRep { -- | Return the underlying standard ("Data.Typeable") type representation- underlyingTypeRep :: Typeable.TypeRep + underlyingTypeRep :: Typeable.TypeRep } -- | Compare two type representations -- -- For base >= 4.6 this compares fingerprints, but older versions of base--- have a bug in the fingerprint construction +-- have a bug in the fingerprint construction -- (<http://hackage.haskell.org/trac/ghc/ticket/5962>) instance Eq TypeRep where #if ! MIN_VERSION_base(4,6,0)@@ -138,7 +138,7 @@ -- Binary instance for 'TypeRep', avoiding orphan instances instance Binary TypeRep where put (splitTyConApp -> (TyCon (Fingerprint hi lo) package modul name, ts)) = do- put hi + put hi put lo put package put modul@@ -164,16 +164,16 @@ -- | Split a type representation into the application of -- a type constructor and its argument splitTyConApp :: TypeRep -> (TyCon, [TypeRep])-splitTyConApp t = +splitTyConApp t = let (c, ts) = Typeable.splitTyConApp (underlyingTypeRep t) in (c, map TypeRep ts) -- | Inverse of 'splitTyConApp' mkTyConApp :: TyCon -> [TypeRep] -> TypeRep-mkTyConApp c ts +mkTyConApp c ts = TypeRep (Typeable.mkTyConApp c (map underlyingTypeRep ts)) -isTypVar :: TypeRep -> Maybe Var +isTypVar :: TypeRep -> Maybe Var isTypVar (splitTyConApp -> (c, [t])) | c == typVar = Just t isTypVar _ = Nothing @@ -190,7 +190,7 @@ -- Type variables -- -------------------------------------------------------------------------------- -data TypVar a deriving Typeable +data TypVar a deriving Typeable data Skolem a deriving Typeable data Zero deriving Typeable data Succ a deriving Typeable@@ -206,7 +206,7 @@ type V8 = Succ V7 type V9 = Succ V8 -type ANY = TypVar V0 +type ANY = TypVar V0 type ANY1 = TypVar V1 type ANY2 = TypVar V2 type ANY3 = TypVar V3@@ -224,18 +224,17 @@ -- | If 'isInstanceOf' fails it returns a type error type TypeError = String --- | @t1 `isInstanceOf` t2@ checks if @t1@ is an instance of @t2@ -isInstanceOf :: TypeRep -> TypeRep -> Either TypeError () +-- | @t1 `isInstanceOf` t2@ checks if @t1@ is an instance of @t2@+isInstanceOf :: TypeRep -> TypeRep -> Either TypeError () isInstanceOf t1 t2 = void (unify (skolemize t1) t2) -- | @funResultTy t1 t2@ is the type of the result when applying a function -- of type @t1@ to an argument of type @t2@-funResultTy :: TypeRep -> TypeRep -> Either TypeError TypeRep -funResultTy (splitTyConApp -> (fc, [farg, fres])) x | fc == funTc = do - s <- unify (alphaRename "f" farg) (alphaRename "x" x)- return (normalize (subst s (alphaRename "f" fres)))-funResultTy f _ = - Left $ show f ++ " is not a function"+funResultTy :: TypeRep -> TypeRep -> Either TypeError TypeRep+funResultTy t1 t2 = do+ let anyTy = mkTypVar $ typeOf (undefined :: V0)+ s <- unify (alphaRename "f" t1) $ mkTyConApp funTc [alphaRename "x" t2, anyTy]+ return $ normalize $ subst s anyTy -------------------------------------------------------------------------------- -- Alpha-renaming and normalization --@@ -251,7 +250,7 @@ tvars (isTypVar -> Just x) = [x] tvars (splitTyConApp -> (_, ts)) = concatMap tvars ts -normalize :: TypeRep -> TypeRep +normalize :: TypeRep -> TypeRep normalize t = subst (zip (tvars t) anys) t where anys :: [TypeRep]@@ -261,7 +260,7 @@ succ = mkTyConApp succTyCon . (:[]) zero :: TypeRep- zero = mkTyConApp zeroTyCon [] + zero = mkTyConApp zeroTyCon [] mkTyCon :: String -> TyCon mkTyCon = mkTyCon3 "rank1typeable" "Data.Rank1Typeable"@@ -281,38 +280,38 @@ type Var = TypeRep skolemize :: TypeRep -> TypeRep-skolemize (isTypVar -> Just x) = mkTyConApp skolem [x] +skolemize (isTypVar -> Just x) = mkTyConApp skolem [x] skolemize (splitTyConApp -> (c, ts)) = mkTyConApp c (map skolemize ts) occurs :: Var -> TypeRep -> Bool-occurs x (isTypVar -> Just x') = x == x' +occurs x (isTypVar -> Just x') = x == x' occurs x (splitTyConApp -> (_, ts)) = any (occurs x) ts subst :: Substitution -> TypeRep -> TypeRep subst s (isTypVar -> Just x) = fromMaybe (mkTypVar x) (lookup x s) subst s (splitTyConApp -> (c, ts)) = mkTyConApp c (map (subst s) ts) -unify :: TypeRep - -> TypeRep - -> Either TypeError Substitution +unify :: TypeRep+ -> TypeRep+ -> Either TypeError Substitution unify = \t1 t2 -> go [] [(t1, t2)] where- go :: Substitution - -> [Equation] - -> Either TypeError Substitution - go acc [] = + go :: Substitution+ -> [Equation]+ -> Either TypeError Substitution+ go acc [] = return acc go acc ((t1, t2) : eqs) | t1 == t2 = -- Note: equality check is fast go acc eqs go acc ((isTypVar -> Just x, t) : eqs) =- if x `occurs` t + if x `occurs` t then Left "Occurs check"- else go ((x, t) : map (second $ subst [(x, t)]) acc) + else go ((x, t) : map (second $ subst [(x, t)]) acc) (map (subst [(x, t)] *** subst [(x, 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 + go acc ((splitTyConApp -> (c1, ts1), splitTyConApp -> (c2, ts2)) : eqs) =+ if c1 /= c2 then Left $ "Cannot unify " ++ show c1 ++ " and " ++ show c2 else go acc (zip ts1 ts2 ++ eqs) @@ -324,14 +323,14 @@ showsPrec p (splitTyConApp -> (tycon, tys)) = case tys of [] -> showsPrec p tycon- [anyIdx -> Just i] | tycon == typVar -> showString "ANY" . showIdx i - [x] | tycon == listTc -> + [anyIdx -> Just i] | tycon == typVar -> showString "ANY" . showIdx i+ [x] | tycon == listTc -> showChar '[' . shows x . showChar ']'- [a,r] | tycon == funTc -> - showParen (p > 8) $ showsPrec 9 a - . showString " -> " + [a,r] | tycon == funTc ->+ showParen (p > 8) $ showsPrec 9 a+ . showString " -> " . showsPrec 8 r- xs | isTupleTyCon tycon -> + xs | isTupleTyCon tycon -> showTuple xs _ -> showParen (p > 9) $ showsPrec p tycon@@ -344,16 +343,16 @@ showArgs :: Show a => [a] -> ShowS showArgs [] = id showArgs [a] = showsPrec 10 a-showArgs (a:as) = showsPrec 10 a . showString " " . showArgs as +showArgs (a:as) = showsPrec 10 a . showString " " . showArgs as -anyIdx :: TypeRep -> Maybe Int +anyIdx :: TypeRep -> Maybe Int anyIdx (splitTyConApp -> (c, [])) | c == zeroTyCon = Just 0 anyIdx (splitTyConApp -> (c, [t])) | c == succTyCon = (+1) <$> anyIdx t anyIdx _ = Nothing showTuple :: [TypeRep] -> ShowS showTuple args = showChar '('- . foldr (.) id ( intersperse (showChar ',') + . foldr (.) id ( intersperse (showChar ',') $ map (showsPrec 10) args ) . showChar ')'