summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorryanglscott <>2017-07-29 03:13:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2017-07-29 03:13:00 (GMT)
commitbbd211caf0e9f1f97bb71e4ed8bffd2ee5698b14 (patch)
tree0e369c73a8a0ae8ba103adda13647e3686167696
parentd593f1a4099513d54a252b3915b135c6d53a3a54 (diff)
version 2.0.1HEAD2.0.1master
-rw-r--r--.travis.yml2
-rw-r--r--CHANGELOG.markdown7
-rw-r--r--Setup.lhs5
-rw-r--r--bound.cabal7
-rw-r--r--src/Bound/Class.hs8
-rw-r--r--src/Bound/Name.hs45
-rw-r--r--src/Bound/Scope.hs50
-rw-r--r--src/Bound/Scope/Simple.hs32
-rw-r--r--src/Bound/TH.hs4
-rw-r--r--src/Bound/Var.hs38
10 files changed, 117 insertions, 81 deletions
diff --git a/.travis.yml b/.travis.yml
index 3c88048..de33de4 100644
--- a/.travis.yml
+++ b/.travis.yml
@@ -68,7 +68,7 @@ install:
# any command which exits with a non-zero exit code causes the build to fail.
script:
- if [ -f configure.ac ]; then autoreconf -i; fi
- - rm -rf dist/
+ - rm -rf dist/ .ghc.environment.*
- cabal sdist # test that a source-distribution can be generated
- cd dist/
- SRCTAR=(${PKGNAME}-*.tar.gz)
diff --git a/CHANGELOG.markdown b/CHANGELOG.markdown
index 3c88e08..373d3cc 100644
--- a/CHANGELOG.markdown
+++ b/CHANGELOG.markdown
@@ -1,3 +1,10 @@
+2.0.1
+-----
+* Add `abstractEither` and `instantiateEither` to `Bound.Scope`, and
+ add `abstractEitherName` and `instantiateEitherName` to `Bound.Scope.Name`
+* Add `Generic(1)` instances for `Name` and `Scope`
+* Support `doctest-0.12`
+
2
-
* GHC 8.0 and 8.2 support
diff --git a/Setup.lhs b/Setup.lhs
index faedcd3..1d80e88 100644
--- a/Setup.lhs
+++ b/Setup.lhs
@@ -21,7 +21,9 @@ main = defaultMainWithDoctests "doctests"
--
-- Probably we are running cabal sdist, when otherwise using new-build
-- workflow
-import Warning ()
+#warning You are configuring this package without cabal-doctest installed. \
+ The doctests test-suite will not work as a result. \
+ To fix this, install cabal-doctest before configuring.
#endif
import Distribution.Simple
@@ -30,5 +32,4 @@ main :: IO ()
main = defaultMain
#endif
-
\end{code}
diff --git a/bound.cabal b/bound.cabal
index a9e31f2..e80db82 100644
--- a/bound.cabal
+++ b/bound.cabal
@@ -1,6 +1,6 @@
name: bound
category: Language, Compilers/Interpreters
-version: 2
+version: 2.0.1
license: BSD3
cabal-version: >= 1.9.2
license-file: LICENSE
@@ -95,7 +95,7 @@ library
cereal >= 0.3.5.2 && < 0.6,
comonad >= 3 && < 6,
hashable >= 1.2.5.0 && < 1.3,
- mmorph >= 1.0 && < 1.1,
+ mmorph >= 1.0 && < 1.2,
deepseq >= 1.1 && < 1.5,
profunctors >= 3.3 && < 6,
template-haskell >= 2.7 && < 3,
@@ -169,6 +169,7 @@ test-suite doctests
ghc-options: -Wall -threaded
build-depends:
base,
- doctest >= 0.11.2 && < 0.12,
+ bound,
+ doctest >= 0.11.2 && < 0.13,
vector >= 0.9 && < 0.13,
void
diff --git a/src/Bound/Class.hs b/src/Bound/Class.hs
index ea8f365..9563bfc 100644
--- a/src/Bound/Class.hs
+++ b/src/Bound/Class.hs
@@ -1,5 +1,5 @@
{-# LANGUAGE CPP #-}
-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 704
+#if defined(__GLASGOW_HASKELL__)
{-# LANGUAGE DefaultSignatures #-}
#endif
{-# OPTIONS -fno-warn-deprecations #-}
@@ -20,10 +20,8 @@ module Bound.Class
, (=<<<)
) where
-#if __GLASGOW_HASKELL__ >= 704
import Control.Monad.Trans.Class
-#endif
-#if __GLASGOW_HASKELL__ < 710
+#if !MIN_VERSION_base(4,8,0)
import Data.Monoid
#endif
import Control.Monad.Trans.Cont
@@ -67,7 +65,7 @@ class Bound t where
--
-- @m '>>>=' f = m '>>=' 'lift' '.' f@
(>>>=) :: Monad f => t f a -> (a -> f c) -> t f c
-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 704
+#if defined(__GLASGOW_HASKELL__)
default (>>>=) :: (MonadTrans t, Monad f, Monad (t f)) =>
t f a -> (a -> f c) -> t f c
m >>>= f = m >>= lift . f
diff --git a/src/Bound/Name.hs b/src/Bound/Name.hs
index 76eb642..9e4d623 100644
--- a/src/Bound/Name.hs
+++ b/src/Bound/Name.hs
@@ -1,16 +1,10 @@
{-# LANGUAGE CPP #-}
#ifdef __GLASGOW_HASKELL__
{-# LANGUAGE DeriveDataTypeable #-}
-
-# if __GLASGOW_HASKELL__ >= 704
{-# LANGUAGE DeriveGeneric #-}
-# endif
-
-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Trustworthy #-}
#endif
-#endif
-----------------------------------------------------------------------------
-- |
-- Copyright : (C) 2012 Edward Kmett
@@ -37,23 +31,23 @@ module Bound.Name
, name
, abstractName
, abstract1Name
+ , abstractEitherName
, instantiateName
, instantiate1Name
+ , instantiateEitherName
) where
import Bound.Scope
import Bound.Var
-#if __GLASGOW_HASKELL__ < 710
+#if !MIN_VERSION_base(4,8,0)
import Control.Applicative
-#endif
-import Control.Comonad
-import Control.DeepSeq
-import Control.Monad (liftM, liftM2)
-#if __GLASGOW_HASKELL__ < 710
import Data.Foldable
import Data.Monoid
import Data.Traversable
#endif
+import Control.Comonad
+import Control.DeepSeq
+import Control.Monad (liftM, liftM2)
import Data.Bifunctor
import Data.Bifoldable
import qualified Data.Binary as Binary
@@ -63,9 +57,7 @@ import Data.Bytes.Serial
import Data.Functor.Classes
#ifdef __GLASGOW_HASKELL__
import Data.Data
-# if __GLASGOW_HASKELL__ >= 704
import GHC.Generics
-# endif
#endif
import Data.Hashable (Hashable(..))
import Data.Hashable.Lifted (Hashable1(..), Hashable2(..))
@@ -88,9 +80,10 @@ data Name n b = Name n b deriving
#ifdef __GLASGOW_HASKELL__
, Typeable
, Data
-# if __GLASGOW_HASKELL__ >= 704
, Generic
-# endif
+# if __GLASGOW_HASKELL__ >= 706
+ , Generic1
+#endif
#endif
)
@@ -231,9 +224,8 @@ instance (Serialize b, Serialize a) => Serialize (Name b a) where
put = serializeWith2 Serialize.put Serialize.put
get = deserializeWith2 Serialize.get Serialize.get
-# if __GLASGOW_HASKELL__ >= 704
-instance (NFData b, NFData a) => NFData (Name b a)
-# endif
+instance (NFData b, NFData a) => NFData (Name b a) where
+ rnf (Name a b) = rnf a `seq` rnf b
-------------------------------------------------------------------------------
-- Abstraction
@@ -252,6 +244,15 @@ abstract1Name :: (Monad f, Eq a) => a -> f a -> Scope (Name a ()) f a
abstract1Name a = abstractName (\b -> if a == b then Just () else Nothing)
{-# INLINE abstract1Name #-}
+-- | Capture some free variables in an expression to yield
+-- a 'Scope' with named bound variables. Optionally change the
+-- types of the remaining free variables.
+abstractEitherName :: Monad f => (a -> Either b c) -> f a -> Scope (Name a b) f c
+abstractEitherName f e = Scope (liftM k e) where
+ k y = case f y of
+ Left z -> B (Name y z)
+ Right y' -> F (return y')
+
-------------------------------------------------------------------------------
-- Instantiation
-------------------------------------------------------------------------------
@@ -270,3 +271,9 @@ instantiateName k e = unscope e >>= \v -> case v of
instantiate1Name :: Monad f => f a -> Scope n f a -> f a
instantiate1Name = instantiate1
{-# INLINE instantiate1Name #-}
+
+instantiateEitherName :: (Monad f, Comonad n) => (Either b a -> f c) -> Scope (n b) f a -> f c
+instantiateEitherName k e = unscope e >>= \v -> case v of
+ B b -> k (Left (extract b))
+ F a -> a >>= k . Right
+{-# INLINE instantiateEitherName #-}
diff --git a/src/Bound/Scope.hs b/src/Bound/Scope.hs
index 16351c6..2e118a9 100644
--- a/src/Bound/Scope.hs
+++ b/src/Bound/Scope.hs
@@ -6,15 +6,8 @@
{-# 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
+{-# LANGUAGE DeriveGeneric #-}
#endif
-----------------------------------------------------------------------------
@@ -34,9 +27,9 @@
module Bound.Scope
( Scope(..)
-- * Abstraction
- , abstract, abstract1
+ , abstract, abstract1, abstractEither
-- * Instantiation
- , instantiate, instantiate1
+ , instantiate, instantiate1, instantiateEither
-- * Traditional de Bruijn
, fromScope
, toScope
@@ -90,6 +83,13 @@ import Data.Serialize (Serialize)
import Data.Traversable
import Prelude hiding (foldr, mapM, mapM_)
import Data.Data
+#if defined(__GLASGOW_HASKELL__)
+#if __GLASGOW_HASKELL__ >= 706
+import GHC.Generics ( Generic, Generic1 )
+#else
+import GHC.Generics ( Generic )
+#endif
+#endif
-- $setup
-- >>> import Bound.Var
@@ -118,8 +118,14 @@ import Data.Data
-- @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
+#if defined(__GLASGOW_HASKELL__)
+ deriving (Generic)
+#if (__GLASGOW_HASKELL__ >= 707) && (__GLASGOW_HASKELL__ < 800)
+deriving instance Typeable Scope
+#endif
+#if __GLASGOW_HASKELL__ >= 706
+deriving instance Functor f => Generic1 (Scope b f)
+#endif
#endif
-------------------------------------------------------------------------------
@@ -148,7 +154,7 @@ instance (Functor f, Monad f) => Applicative (Scope b f) where
-- | The monad permits substitution on free variables, while preserving
-- bound variables
instance Monad f => Monad (Scope b f) where
-#if __GLASGOW_HASKELL__ < 710
+#if !MIN_VERSION_base(4,8,0)
return a = Scope (return (F (return a)))
{-# INLINE return #-}
#endif
@@ -162,7 +168,7 @@ instance MonadTrans (Scope b) where
{-# INLINE lift #-}
instance MFunctor (Scope b) where
-#if __GLASGOW_HASKELL__ < 710
+#if !MIN_VERSION_base(4,8,0)
hoist t (Scope b) = Scope $ t (liftM (liftM t) b)
#else
hoist = hoistScope
@@ -270,6 +276,15 @@ abstract1 :: (Monad f, Eq a) => a -> f a -> Scope () f a
abstract1 a = abstract (\b -> if a == b then Just () else Nothing)
{-# INLINE abstract1 #-}
+-- | Capture some free variables in an expression to yield
+-- a 'Scope' with bound variables in @b@. Optionally change the
+-- types of the remaining free variables.
+abstractEither :: Monad f => (a -> Either b c) -> f a -> Scope b f c
+abstractEither f e = Scope (liftM k e) where
+ k y = case f y of
+ Left z -> B z
+ Right y' -> F (return y')
+
-------------------------------------------------------------------------------
-- Instantiation
-------------------------------------------------------------------------------
@@ -293,6 +308,13 @@ instantiate1 :: Monad f => f a -> Scope n f a -> f a
instantiate1 e = instantiate (const e)
{-# INLINE instantiate1 #-}
+-- | Enter a scope, and instantiate all bound and free variables in one go.
+instantiateEither :: Monad f => (Either b a -> f c) -> Scope b f a -> f c
+instantiateEither f s = unscope s >>= \v -> case v of
+ B b -> f (Left b)
+ F ea -> ea >>= f . Right
+{-# INLINE instantiateEither #-}
+
-------------------------------------------------------------------------------
-- Traditional de Bruijn
-------------------------------------------------------------------------------
diff --git a/src/Bound/Scope/Simple.hs b/src/Bound/Scope/Simple.hs
index c8c43d9..d5f89a5 100644
--- a/src/Bound/Scope/Simple.hs
+++ b/src/Bound/Scope/Simple.hs
@@ -4,18 +4,12 @@
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveGeneric #-}
{-# 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
@@ -67,6 +61,7 @@ module Bound.Scope.Simple
import Bound.Class
import Bound.Var
import Control.Applicative
+import Control.DeepSeq
import Control.Monad hiding (mapM, mapM_)
import Control.Monad.Morph
import Data.Bifunctor
@@ -87,6 +82,13 @@ import qualified Data.Serialize as Serialize
import Data.Serialize (Serialize)
import Data.Traversable
import Prelude hiding (foldr, mapM, mapM_)
+#if defined(__GLASGOW_HASKELL__)
+#if __GLASGOW_HASKELL__ >= 706
+import GHC.Generics (Generic, Generic1)
+#else
+import GHC.Generics (Generic)
+#endif
+#endif
-- $setup
-- >>> import Bound.Var
@@ -110,14 +112,24 @@ import Prelude hiding (foldr, mapM, mapM_)
-- 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__)
+ deriving Generic
+#endif
#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ > 707
- deriving Typeable
+deriving instance Typeable Scope
+#endif
+
+#if __GLASGOW_HASKELL__ >= 706
+deriving instance Functor f => Generic1 (Scope b f)
#endif
-------------------------------------------------------------------------------
-- Instances
-------------------------------------------------------------------------------
+instance NFData (f (Var b a)) => NFData (Scope b f a) where
+ rnf (Scope x) = rnf x
+
instance Functor f => Functor (Scope b f) where
fmap f (Scope a) = Scope (fmap (fmap f) a)
{-# INLINE fmap #-}
@@ -131,7 +143,7 @@ instance Traversable f => Traversable (Scope b f) where
traverse f (Scope a) = Scope <$> traverse (traverse f) a
{-# INLINE traverse #-}
-#if __GLASGOW_HASKELL__ < 710
+#if !MIN_VERSION_base(4,8,0)
instance (Functor f, Monad f) => Applicative (Scope b f) where
#else
instance Monad f => Applicative (Scope b f) where
@@ -158,7 +170,7 @@ instance MonadTrans (Scope b) where
{-# INLINE lift #-}
instance MFunctor (Scope b) where
-#if __GLASGOW_HASKELL__ < 710
+#if !MIN_VERSION_base(4,8,0)
hoist f = hoistScope f
#else
hoist = hoistScope
diff --git a/src/Bound/TH.hs b/src/Bound/TH.hs
index 4f66e91..fe571c9 100644
--- a/src/Bound/TH.hs
+++ b/src/Bound/TH.hs
@@ -23,7 +23,7 @@ module Bound.TH
) where
#ifdef MIN_VERSION_template_haskell
-import Data.List (intercalate, foldr1)
+import Data.List (intercalate)
import Data.Traversable (for)
import Control.Monad (foldM, mzero, guard)
import Bound.Class (Bound((>>>=)))
@@ -379,7 +379,7 @@ getPure _name tyvr cons= do
(conName, [ t1, t2 ])
ForallC _ _ conName ->
allTypeArgs conName
-#if MIN_VERSION_template_haskell(0,2,11)
+#if MIN_VERSION_template_haskell(2,11,0)
_ -> error "Not implemented"
#endif
diff --git a/src/Bound/Var.hs b/src/Bound/Var.hs
index 0c9a104..e2d58e8 100644
--- a/src/Bound/Var.hs
+++ b/src/Bound/Var.hs
@@ -2,16 +2,9 @@
#ifdef __GLASGOW_HASKELL__
{-# LANGUAGE DeriveDataTypeable #-}
-
-#if __GLASGOW_HASKELL__ >= 704
{-# LANGUAGE DeriveGeneric #-}
-#endif
-
-#if __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Trustworthy #-}
#endif
-
-#endif
-----------------------------------------------------------------------------
-- |
-- Copyright : (C) 2012 Edward Kmett
@@ -29,16 +22,15 @@ module Bound.Var
, _F
) where
-#if __GLASGOW_HASKELL__ < 710
+#if !MIN_VERSION_base(4,8,0)
import Control.Applicative
-#endif
-import Control.DeepSeq
-import Control.Monad (liftM, ap)
-#if __GLASGOW_HASKELL__ < 710
import Data.Foldable
import Data.Traversable
import Data.Monoid (Monoid(..))
+import Data.Word
#endif
+import Control.DeepSeq
+import Control.Monad (liftM, ap)
import Data.Hashable (Hashable(..))
import Data.Hashable.Lifted (Hashable1(..), Hashable2(..))
import Data.Bifunctor
@@ -50,17 +42,12 @@ import Data.Bytes.Get
import Data.Bytes.Put
import Data.Bytes.Serial
import Data.Functor.Classes
-#ifdef __GLASGOW_HASKELL__
-import Data.Data
-# if __GLASGOW_HASKELL__ >= 704
-import GHC.Generics
-# endif
-#endif
import Data.Profunctor
import qualified Data.Serialize as Serialize
import Data.Serialize (Serialize)
-#if __GLASGOW_HASKELL__ < 710
-import Data.Word
+#ifdef __GLASGOW_HASKELL__
+import Data.Data
+import GHC.Generics
#endif
----------------------------------------------------------------------------
@@ -84,9 +71,10 @@ data Var b a
#ifdef __GLASGOW_HASKELL__
, Data
, Typeable
-# if __GLASGOW_HASKELL__ >= 704
, Generic
-# endif
+# if __GLASGOW_HASKELL__ >= 706
+ , Generic1
+#endif
#endif
)
@@ -251,6 +239,6 @@ instance Show b => Show1 (Var b) where showsPrec1 = showsPrec
instance Read b => Read1 (Var b) where readsPrec1 = readsPrec
#endif
-# if __GLASGOW_HASKELL__ >= 704
-instance (NFData a, NFData b) => NFData (Var b a)
-# endif
+instance (NFData a, NFData b) => NFData (Var b a) where
+ rnf (B b) = rnf b
+ rnf (F f) = rnf f