bound 0.2 → 0.2.1

raw patch · 6 files changed

+100/−54 lines, 6 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Bound.hs +4/−4
• Bound/Class.hs +14/−3
• Bound/Scope.hs +68/−38
• Bound/Term.hs +3/−1
• Bound/Var.hs +8/−5
• bound.cabal +3/−3

@@ -9,10 +9,10 @@ -- Portability :  portable -- -- We represent the target language itself as an ideal monad supplied by the--- user, and provide a 'Scope' monad transformer for introducing bound variables--- in user supplied terms. Users supply a 'Monad' and 'Traversable' instance, and we--- traverse to find free variables, and use the 'Monad' to perform substitution--- that avoids bound variables.+-- user, and provide a 'Scope' monad transformer for introducing bound +-- variables in user supplied terms. Users supply a 'Monad' and 'Traversable'+-- instance, and we traverse to find free variables, and use the 'Monad' to+-- perform substitution that avoids bound variables. -- -- An untyped lambda calculus: --

@@ -1,3 +1,7 @@+{-# LANGUAGE CPP #-}+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 704+{-# LANGUAGE DefaultSignatures #-}+#endif ----------------------------------------------------------------------------- -- | -- Module      :  Bound.Class@@ -14,9 +18,13 @@   , (=<<<)   ) where +#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 704+import Control.Monad.Trans.Class+#endif+ infixl 1 >>>= --- | Instantces may or may not be monad transformers.+-- | Instances may or may not be monad transformers. -- -- If they are, then you can use @m >>>= f = m >>= lift . f@ --@@ -26,8 +34,11 @@  class Bound t where   (>>>=) :: Monad f => t f a -> (a -> f c) -> t f c-  -- default (>>>=) :: (MonadTrans t, Monad f) => t f a -> (a -> f c) -> t f c-  -- m >>>= f = m >>= lift . f+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 704+  default (>>>=) :: (MonadTrans t, Monad f, Monad (t f)) =>+                    t f a -> (a -> f c) -> t f c+  m >>>= f = m >>= lift . f+#endif  infixr 1 =<<< (=<<<) :: (Bound t, Monad f) => (a -> f c) -> t f a -> t f c

@@ -51,20 +51,24 @@ import Prelude.Extras import Prelude hiding (foldr, mapM, mapM_) --- | @'Scope' b f a@ is an @f@ expression with bound variables in @b@, and free variables in @a@+-- | @'Scope' b f a@ is an @f@ expression with bound variables in @b@,+-- and free variables in @a@ ----- We store bound variables as their generalized de Bruijn representation,--- in that we're allowed to 'lift' (using 'F') an entire tree rather than only succ individual variables,--- but we're still only allowed to do so once per 'Scope'. Weakening trees permits /O(1)/ weakening--- permits more sharing opportunities. Here the deBruijn 0 is represented by the 'B' constructor of--- 'Var', while the de Bruijn 'succ' (which may be applied to an entire tree!) is handled by 'F'.+-- We store bound variables as their generalized de Bruijn+-- representation in that we're allowed to 'lift' (using 'F') an entire+-- tree rather than only succ individual variables, but we're still+-- only allowed to do so once per 'Scope'. Weakening trees permits+-- /O(1)/ weakening and permits more sharing opportunities. Here the+-- deBruijn 0 is represented by the 'B' constructor of 'Var', while the+-- de Bruijn 'succ' (which may be applied to an entire tree!) is handled+-- by 'F'. ----- NB: equality and comparison quotient out the distinct 'F' placements allowed by--- the generalized de Bruijn representation and return the same result as a traditional de Bruijn--- representation would.+-- NB: equality and comparison quotient out the distinct 'F' placements+-- allowed by the generalized de Bruijn representation and return the+-- same result as a traditional de Bruijn representation would. ----- Logically you can think of this as if the shape were the traditional @f (Var b a)@, but the extra --- 'f a' inside permits us a cheaper 'lift'.+-- Logically you can think of this as if the shape were the traditional+-- @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)) } @@ -78,7 +82,8 @@ instance Traversable f => Traversable (Scope b f) where   traverse f (Scope a) = Scope <$> traverse (traverse (traverse f)) a --- | The monad permits substitution on free variables, while preserving bound variables+-- | The monad permits substitution on free variables, while preserving+-- bound variables instance Monad f => Monad (Scope b f) where   return a = Scope (return (F (return a)))   Scope e >>= f = Scope $ e >>= \v -> case v of@@ -88,21 +93,26 @@ instance MonadTrans (Scope b) where   lift m = Scope (return (F m)) -instance (Monad f, Eq b, Eq1 f, Eq a) => Eq  (Scope b f a) where (==) = (==#)+instance (Monad f, Eq b, Eq1 f, Eq a) => Eq  (Scope b f a) where+  (==) = (==#) instance (Monad f, Eq b, Eq1 f)       => Eq1 (Scope b f)   where   a ==# b = liftM Lift2 (fromScope a) ==# liftM Lift2 (fromScope b)   -- a ==# b = mangleScope a ==# mangleScope b -instance (Monad f, Ord b, Ord1 f, Ord a) => Ord  (Scope b f a) where compare = compare1+instance (Monad f, Ord b, Ord1 f, Ord a) => Ord  (Scope b f a) where+  compare = compare1 instance (Monad f, Ord b, Ord1 f)        => Ord1 (Scope b f) where   compare1 a b = liftM Lift2 (fromScope a) `compare1` liftM Lift2 (fromScope b)   -- compare1 a b = compare1 (mangleScope a) (mangleScope b) -instance (Functor f, Show b, Show1 f, Show a) => Show  (Scope b f a) where showsPrec = showsPrec1-instance (Functor f, Show b, Show1 f)         => Show1 (Scope b f)   where-  showsPrec1 d a = showParen (d > 10) $ showString "Scope " . showsPrec1 11 (fmap (Lift2 . fmap Lift1) (unscope a))+instance (Functor f, Show b, Show1 f, Show a) => Show (Scope b f a) where+  showsPrec = showsPrec1+instance (Functor f, Show b, Show1 f) => Show1 (Scope b f) where+  showsPrec1 d a = showParen (d > 10) $+    showString "Scope " . showsPrec1 11 (fmap (Lift2 . fmap Lift1) (unscope a)) -instance (Functor f, Read b, Read1 f, Read a) => Read  (Scope b f a) where readsPrec = readsPrec1+instance (Functor f, Read b, Read1 f, Read a) => Read  (Scope b f a) where+  readsPrec = readsPrec1 instance (Functor f, Read b, Read1 f)         => Read1 (Scope b f) where   readsPrec1 d = readParen (d > 10) $ \r -> do     ("Scope", r') <- lex r@@ -112,7 +122,8 @@ instance Bound (Scope b) where   m >>>= f = m >>= lift . f --- | Capture some free variables in an expression to yield a 'Scope' with bound variables in @b@+-- | Capture some free variables in an expression to yield+-- a 'Scope' with bound variables in @b@ abstract :: Monad f => (a -> Maybe b) -> f a -> Scope b f a abstract f e = Scope (liftM k e) where   k y = case f y of@@ -120,11 +131,6 @@     Nothing -> F (return y) {-# INLINE abstract #-} --- | Abstract over a single variable-abstract1 :: (Monad f, Eq a) => a -> f a -> Scope () f a-abstract1 a = abstract (\b -> if a == b then Just () else Nothing)-{-# INLINE abstract1 #-}- -- | Enter a scope, instantiating all bound variables instantiate :: Monad f => (b -> f a) -> Scope b f a -> f a instantiate k e = unscope e >>= \v -> case v of@@ -132,6 +138,13 @@   F a -> a {-# INLINE instantiate #-} +-- * Special purpose combinators++-- | Abstract over a single variable+abstract1 :: (Monad f, Eq a) => a -> f a -> Scope () f a+abstract1 a = abstract (\b -> if a == b then Just () else Nothing)+{-# INLINE abstract1 #-}+ -- | Enter a 'Scope' that binds one variable, instantiating it instantiate1 :: Monad f => f a -> Scope () f a -> f a instantiate1 e = instantiate (const e)@@ -151,6 +164,9 @@   B b -> return (B b) {-# INLINE fromScope #-} +-- | Convert from traditional de Bruijn to generalized de Bruijn indices.+--+-- This requires a full tree traversal toScope :: Monad f => f (Var b a) -> Scope b f a toScope e = Scope (liftM (fmap return) e) {-# INLINE toScope #-}@@ -181,38 +197,45 @@ mapScope f g (Scope s) = Scope $ fmap (bimap f (fmap g)) s {-# INLINE mapScope #-} --- | Perform a change of variables on bound variables given only a 'Monad' instance+-- | Perform a change of variables on bound variables given only a 'Monad'+-- instance liftMBound :: Monad m => (b -> b') -> Scope b m a -> Scope b' m a liftMBound f (Scope s) = Scope (liftM f' s) where   f' (B b) = B (f b)   f' (F a) = F a {-# INLINE liftMBound #-} --- | A version of 'mapScope' that can be used when you only have the 'Monad' instance+-- | A version of 'mapScope' that can be used when you only have the 'Monad'+-- instance liftMScope :: Monad m => (b -> d) -> (a -> c) -> Scope b m a -> Scope d m c liftMScope f g (Scope s) = Scope $ liftM (bimap f (liftM g)) s {-# INLINE liftMScope #-} --- | Obtain a result by collecting information from both bound and free variables+-- | Obtain a result by collecting information from both bound and free+-- variables foldMapBound :: (Foldable f, Monoid r) => (b -> r) -> Scope b f a -> r foldMapBound f (Scope s) = foldMap f' s where   f' (B a) = f a   f' _     = mempty {-# INLINE foldMapBound #-} --- | Obtain a result by collecting information from both bound and free variables-foldMapScope :: (Foldable f, Monoid r) => (b -> r) -> (a -> r) -> Scope b f a -> r+-- | Obtain a result by collecting information from both bound and free+-- variables+foldMapScope :: (Foldable f, Monoid r) =>+                (b -> r) -> (a -> r) -> Scope b f a -> r foldMapScope f g (Scope s) = foldMap (bifoldMap f (foldMap g)) s {-# INLINE foldMapScope #-} -traverseBound_ :: (Applicative g, Foldable f) => (b -> g d) -> Scope b f a -> g ()+traverseBound_ :: (Applicative g, Foldable f) =>+                  (b -> g d) -> Scope b f a -> g () traverseBound_ f (Scope s) = traverse_ f' s   where f' (B a) = () <$ f a         f' _     = pure () {-# INLINE traverseBound_ #-}  --- | Traverse both the variables bound by this scope and any free variables.-traverseScope_ :: (Applicative g, Foldable f) => (b -> g d) -> (a -> g c) -> Scope b f a -> g ()+traverseScope_ :: (Applicative g, Foldable f) =>+                  (b -> g d) -> (a -> g c) -> Scope b f a -> g () traverseScope_ f g (Scope s) = traverse_ (bitraverse_ f (traverse_ g)) s {-# INLINE traverseScope_ #-} @@ -223,32 +246,39 @@   f' _     = return () {-# INLINE mapMBound_ #-} ---- | A 'traverseScope_' that can be used when you only have a 'Monad' instance-mapMScope_ :: (Monad m, Foldable f) => (b -> m d) -> (a -> m c) -> Scope b f a -> m ()+-- | A 'traverseScope_' that can be used when you only have a 'Monad'+-- instance+mapMScope_ :: (Monad m, Foldable f) =>+              (b -> m d) -> (a -> m c) -> Scope b f a -> m () mapMScope_ f g (Scope s) = mapM_ (bimapM_ f (mapM_ g)) s {-# INLINE mapMScope_ #-}  --- | Traverse both bound and free variables-traverseBound :: (Applicative g, Traversable f) => (b -> g c) -> Scope b f a -> g (Scope c f a)+traverseBound :: (Applicative g, Traversable f) =>+                 (b -> g c) -> Scope b f a -> g (Scope c f a) traverseBound f (Scope s) = Scope <$> traverse f' s where   f' (B b) = B <$> f b   f' (F a) = pure (F a) {-# INLINE traverseBound #-}  --- | Traverse both bound and free variables-traverseScope :: (Applicative g, Traversable f) => (b -> g d) -> (a -> g c) -> Scope b f a -> g (Scope d f c)+traverseScope :: (Applicative g, Traversable f) =>+                 (b -> g d) -> (a -> g c) -> Scope b f a -> g (Scope d f c) traverseScope f g (Scope s) = Scope <$> traverse (bitraverse f (traverse g)) s {-# INLINE traverseScope #-}  --- | mapM over both bound and free variables-mapMBound :: (Monad m, Traversable f) => (b -> m c) -> Scope b f a -> m (Scope c f a)+mapMBound :: (Monad m, Traversable f) =>+             (b -> m c) -> Scope b f a -> m (Scope c f a) mapMBound f (Scope s) = liftM Scope (mapM f' s) where   f' (B b) = liftM B (f b)   f' (F a) = return (F a) {-# INLINE mapMBound #-} ---- | A 'traverseScope' that can be used when you only have a 'Monad' instance-mapMScope :: (Monad m, Traversable f) => (b -> m d) -> (a -> m c) -> Scope b f a -> m (Scope d f c)+--- | A 'traverseScope' that can be used when you only have a 'Monad'+-- instance+mapMScope :: (Monad m, Traversable f) =>+             (b -> m d) -> (a -> m c) -> Scope b f a -> m (Scope d f c) mapMScope f g (Scope s) = liftM Scope (mapM (bimapM f (mapM g)) s) {-# INLINE mapMScope #-} 

@@ -24,11 +24,13 @@ substitute p a w = w >>= \b -> if a == b then p else return b {-# INLINE substitute #-} --- | If a term has no free variables, you can freely change the type of free variables it uses+-- | If a term has no free variables, you can freely change the type of+-- free variables it is parameterized on. closed :: Traversable f => f a -> Maybe (f b) closed = traverse (const Nothing) {-# INLINE closed #-} +-- | A closed term has no free variables. isClosed :: Foldable f => f a -> Bool isClosed = all (const False) {-# INLINE isClosed #-}

@@ -9,7 +9,9 @@ -- Portability :  portable -- -----------------------------------------------------------------------------module Bound.Var (Var(..)) where+module Bound.Var+  ( Var(..)+  ) where  import Data.Foldable import Data.Traversable@@ -23,12 +25,13 @@  -- | \"I am not a number, I am a /free monad/!\" ----- @Var b a@ represents variables that may either be "bound" (@B@) or "free" (@F@)+-- A @Var b a@ is a variable that may either be \"bound\" or \"free\". ----- It is also technically a free monad in the same near trivial sense as 'Either'+-- (It is also technically a free monad in the same near trivial sense as+-- 'Either'.) data Var b a-  = B b -- this is a bound variable-  | F a -- this is a free variable+  = B b -- ^ this is a bound variable+  | F a -- ^ this is a free variable   deriving (Eq,Ord,Show,Read)  instance Functor (Var b) where

@@ -1,6 +1,6 @@ name:          bound category:      Language, Compilers/Interpreters-version:       0.2+version:       0.2.1 license:       BSD3 cabal-version: >= 1.6 license-file:  LICENSE@@ -49,7 +49,7 @@    > whnf e = e    .    The classes from Prelude.Extras are used to facilitate the automatic deriving-   of 'Eq', 'Ord', 'Show, and 'Read' in the presence of polymorphic recursion used+   of 'Eq', 'Ord', 'Show', and 'Read' in the presence of polymorphic recursion used    inside 'Scope'.    .    The goal of this package is to make it as easy as possible to deal with name@@ -116,4 +116,4 @@     Bound.Term     Bound.Var -  ghc-options: -Wall+  ghc-options: -Wall -O2 -fspec-constr -fdicts-cheap