bound 0.9.1.1 → 1.0

raw patch · 6 files changed

+172/−5 lines, 6 files

Files

CHANGELOG.markdown +7/−0
bound.cabal +1/−1
src/Bound.hs +1/−1
src/Bound/Class.hs +47/−1
src/Bound/Scope.hs +68/−1
src/Bound/Scope/Simple.hs +48/−1

CHANGELOG.markdown view

@@ -1,3 +1,10 @@+1.0+---+* Added instances for `Bound` for all of the `mtl` monads.+* Added `Data` and `Typeable` support to both versions of `Scope`+* Added the missing `Applictive` instance to `Bound.Scope.Simple`+* Moved `hoistScope`, `bitraverseScope`, `transverseScope`, and `instantiateVars` here from the `ermine` compiler.+ 0.9.1.1 ------- * Updated to work with `bifunctors` 4.0

bound.cabal view

@@ -1,6 +1,6 @@ name:          bound category:      Language, Compilers/Interpreters-version:       0.9.1.1+version:       1.0 license:       BSD3 cabal-version: >= 1.9.2 license-file:  LICENSE

src/Bound.hs view

@@ -67,7 +67,7 @@ -- and the related combinators from "Bound.Name". They are not re-exported -- from this module by default. ----- The approach used in this package was first elaborated upon by Richard Bird +-- The approach used in this package was first elaborated upon by Richard Bird -- and Ross Patterson -- in \"de Bruijn notation as a nested data type\", available from -- <http://www.cs.uwyo.edu/~jlc/courses/5000_fall_08/debruijn_as_nested_datatype.pdf>

src/Bound/Class.hs view

@@ -22,11 +22,21 @@ #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 704 import Control.Monad.Trans.Class #endif+import Data.Monoid+import Control.Monad.Trans.Cont+import Control.Monad.Trans.Error+import Control.Monad.Trans.Identity+import Control.Monad.Trans.List+import Control.Monad.Trans.Maybe+import Control.Monad.Trans.RWS+import Control.Monad.Trans.Reader+import Control.Monad.Trans.State+import Control.Monad.Trans.Writer  infixl 1 >>>=  -- | Instances of 'Bound' generate left modules over monads.--- +-- -- This means they should satisfy the following laws: -- -- > m >>>= return ≡ m@@ -55,6 +65,42 @@   m >>>= f = m >>= lift . f   {-# INLINE (>>>=) #-} #endif++instance Bound (ContT c) where+  m >>>= f = m >>= lift . f+  {-# INLINE (>>>=) #-}++instance Error e => Bound (ErrorT e) where+ m >>>= f = m >>= lift . f+ {-# INLINE (>>>=) #-}++instance Bound IdentityT where+ m >>>= f = m >>= lift . f+ {-# INLINE (>>>=) #-}++instance Bound ListT where+ m >>>= f = m >>= lift . f+ {-# INLINE (>>>=) #-}++instance Bound MaybeT where+ m >>>= f = m >>= lift . f+ {-# INLINE (>>>=) #-}++instance Monoid w => Bound (RWST r w s) where+ m >>>= f = m >>= lift . f+ {-# INLINE (>>>=) #-}++instance Bound (ReaderT r) where+ m >>>= f = m >>= lift . f+ {-# INLINE (>>>=) #-}++instance Bound (StateT s) where+ m >>>= f = m >>= lift . f+ {-# INLINE (>>>=) #-}++instance Monoid w => Bound (WriterT w) where+ m >>>= f = m >>= lift . f+ {-# INLINE (>>>=) #-}  infixr 1 =<<< -- | A flipped version of ('>>>=').

src/Bound/Scope.hs view

@@ -1,7 +1,22 @@ {-# LANGUAGE CPP #-}-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702+{-# LANGUAGE Rank2Types #-}+#ifdef __GLASGOW_HASKELL__+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE UndecidableInstances #-}++#if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif++#endif++#ifndef MIN_VERSION_base+#define MIN_VERSION_base(x,y,z) 1+#endif+ ----------------------------------------------------------------------------- -- | -- Copyright   :  (C) 2012-2013 Edward Kmett@@ -44,6 +59,10 @@   , mapMScope   , serializeScope   , deserializeScope+  , hoistScope+  , bitraverseScope+  , transverseScope+  , instantiateVars   ) where  import Bound.Class@@ -68,6 +87,7 @@ import Data.Traversable import Prelude.Extras import Prelude hiding (foldr, mapM, mapM_)+import Data.Data  ------------------------------------------------------------------------------- -- Scopes@@ -93,7 +113,11 @@ -- @f (Var b a)@, but the extra @f a@ inside permits us a cheaper 'lift'. -- newtype Scope b f a = Scope { unscope :: f (Var b (f a)) }+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 707+  deriving Typeable+#endif + ------------------------------------------------------------------------------- -- Instances -------------------------------------------------------------------------------@@ -373,6 +397,28 @@ deserializeScope gb gv = liftM Scope $ deserializeWith (deserializeWith2 gb $ deserializeWith gv) {-# INLINE deserializeScope #-} +-- | This allows you to 'bitraverse' a 'Scope'.+bitraverseScope :: (Bitraversable t, Applicative f) => (k -> f k') -> (a -> f a') -> Scope b (t k) a -> f (Scope b (t k') a')+bitraverseScope f g = fmap Scope . bitraverse f (traverse (bitraverse f g)) . unscope+{-# INLINE bitraverseScope #-}++-- | This is a higher-order analogue of 'traverse'.+transverseScope :: (Applicative f, Monad f, Traversable g)+                => (forall r. g r -> f (h r))+                -> Scope b g a -> f (Scope b h a)+transverseScope tau (Scope e) = Scope <$> (tau =<< traverse (traverse tau) e)++-- | instantiate bound variables using a list of new variables+instantiateVars :: Monad t => [a] -> Scope Int t a -> t a+instantiateVars as = instantiate (vs !!) where+  vs = map return as+{-# INLINE instantiateVars #-}++-- | Lift a natural transformation from @f@ to @g@ into one between scopes.+hoistScope :: Functor f => (forall x. f x -> g x) -> Scope b f a -> Scope b g a+hoistScope t (Scope b) = Scope $ t (fmap t <$> b)+{-# INLINE hoistScope #-}+ instance (Serial b, Serial1 f) => Serial1 (Scope b f) where   serializeWith = serializeScope serialize   deserializeWith = deserializeScope deserialize@@ -388,3 +434,24 @@ instance (Serialize b, Serial1 f, Serialize a) => Serialize (Scope b f a) where   put = serializeScope Serialize.put Serialize.put   get = deserializeScope Serialize.get Serialize.get++#ifdef __GLASGOW_HASKELL__++#if __GLASGOW_HASKELL__ < 707+instance (Typeable b, Typeable1 f) => Typeable1 (Scope b f) where+  typeOf1 _ = mkTyConApp scopeTyCon [typeOf (undefined :: b), typeOf1 (undefined :: f ())]++scopeTyCon :: TyCon+#if MIN_VERSION_base(4,4,0)+scopeTyCon = mkTyCon3 "bound" "Bound.Scope" "Scope"+#else+scopeTyCon = mkTyCon "Bound.Scope.Scope"+#endif++#else+#define Typeable1 Typeable+#endif++deriving instance (Typeable b, Typeable1 f, Data a, Data (f (Var b (f a)))) => Data (Scope b f a)++#endif

src/Bound/Scope/Simple.hs view

@@ -1,7 +1,20 @@ {-# LANGUAGE CPP #-}-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702+#if defined(__GLASGOW_HASKELL__)+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE UndecidableInstances #-}++#if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif++#endif++#ifndef MIN_VERSION_base+#define MIN_VERSION_base(x,y,z) 1+#endif ----------------------------------------------------------------------------- -- | -- Copyright   :  (C) 2013 Edward Kmett@@ -58,6 +71,7 @@ import Data.Bytes.Get import Data.Bytes.Put import Data.Bytes.Serial+import Data.Data import Data.Foldable import Data.Hashable import Data.Hashable.Extras@@ -87,6 +101,9 @@ -- Another use case is for syntaxes not stable under substitution, -- therefore with only a 'Functor' instance and no 'Monad' instance. newtype Scope b f a = Scope { unscope :: f (Var b a) }+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ > 707+  deriving Typeable+#endif  ------------------------------------------------------------------------------- -- Instances@@ -105,6 +122,12 @@   traverse f (Scope a) = Scope <$> traverse (traverse f) a   {-# INLINE traverse #-} +instance (Functor f, Monad f) => Applicative (Scope b f) where+  pure = return+  {-# INLINE pure #-}+  (<*>) = ap+  {-# INLINE (<*>) #-}+ -- | The monad permits substitution on free variables, while preserving -- bound variables instance Monad f => Monad (Scope b f) where@@ -366,3 +389,27 @@ instance (Serialize b, Serial1 f, Serialize a) => Serialize (Scope b f a) where   put = serializeScope Serialize.put Serialize.put   get = deserializeScope Serialize.get Serialize.get++#ifdef __GLASGOW_HASKELL__++#if __GLASGOW_HASKELL__ < 707+instance (Typeable b, Typeable1 f) => Typeable1 (Scope b f) where+  typeOf1 _ = mkTyConApp scopeTyCon [typeOf (undefined :: b), typeOf1 (undefined :: f ())]++scopeTyCon :: TyCon+#if MIN_VERSION_base(4,4,0)+scopeTyCon = mkTyCon3 "bound" "Bound.Scope" "Scope"+#else+scopeTyCon = mkTyCon "Bound.Scope.Scope"+#endif++#else++-- only needed for ghc7.8.1rc1 compatibility+#define Typeable1 Typeable++#endif++deriving instance (Typeable b, Typeable1 f, Data a, Data (f (Var b a))) => Data (Scope b f a)++#endif