bound 2.0.3 → 2.0.4
raw patch · 15 files changed
+83/−351 lines, 15 filesdep −functor-classes-compatdep −ghc-primdep ~basedep ~bifunctorsdep ~binaryPVP ok
version bump matches the API change (PVP)
Dependencies removed: functor-classes-compat, ghc-prim
Dependency ranges changed: base, bifunctors, binary, bytes, cereal, comonad, deepseq, hashable, template-haskell, transformers, vector
API changes (from Hackage documentation)
Files
- CHANGELOG.markdown +7/−0
- bound.cabal +17/−26
- doc/BoundLaws.hs +8/−8
- doc/bound-laws.cabal +5/−9
- examples/Deriving.hs +8/−17
- examples/Imperative.hs +0/−7
- examples/Overkill.hs +8/−11
- examples/Simple.hs +9/−6
- src/Bound.hs +4/−2
- src/Bound/Class.hs +1/−4
- src/Bound/Name.hs +0/−25
- src/Bound/Scope.hs +1/−68
- src/Bound/Scope/Simple.hs +1/−70
- src/Bound/TH.hs +14/−75
- src/Bound/Var.hs +0/−23
CHANGELOG.markdown view
@@ -1,3 +1,10 @@+2.0.4 [2021.11.07]+------------------+* Allow building with `template-haskell-2.18` (GHC 9.2).+* The `Bound.TH` module no longer requires the `TemplateHaskell` extension+ (only `TemplateHaskellQuotes`) when building with GHC 9.0 or later.+* Drop support for pre-8.0 versions of GHC.+ 2.0.3 [2021.02.05] ------------------ * Allow the examples to build with `vector-0.12.2` or later.
bound.cabal view
@@ -1,6 +1,6 @@ name: bound category: Language, Compilers/Interpreters-version: 2.0.3+version: 2.0.4 license: BSD3 cabal-version: >= 1.10 license-file: LICENSE@@ -44,16 +44,14 @@ AUTHORS.markdown tested-with:- GHC==7.4.2,- GHC==7.6.3,- GHC==7.8.4,- GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.4, GHC==8.6.5,- GHC==8.8.3,- GHC==8.10.1+ GHC==8.8.4,+ GHC==8.10.7,+ GHC==9.0.1,+ GHC==9.2.1 flag template-haskell description:@@ -81,30 +79,26 @@ Bound.Var build-depends:- base >= 4.5 && < 5,- bifunctors >= 3 && < 6,- binary >= 0.5 && < 0.9,- bytes >= 0.4 && < 1,- cereal >= 0.3.5.2 && < 0.6,- comonad >= 3 && < 6,+ base >= 4.9 && < 5,+ bifunctors >= 5 && < 6,+ binary >= 0.8.3 && < 0.9,+ bytes >= 0.15.2 && < 1,+ cereal >= 0.4.1 && < 0.6,+ comonad >= 5 && < 6, hashable >= 1.2.5.0 && < 1.4,- mmorph >= 1.0 && < 1.2,- deepseq >= 1.1 && < 1.5,+ mmorph >= 1.0 && < 1.3,+ deepseq >= 1.4.2 && < 1.5, profunctors >= 3.3 && < 6,- template-haskell >= 2.7 && < 3, th-abstraction >= 0.4 && < 0.5,- transformers >= 0.2 && < 0.6,+ transformers >= 0.5 && < 0.6, transformers-compat >= 0.5 && < 1 ghc-options: -Wall -O2 -fspec-constr -fdicts-cheap -funbox-strict-fields default-language: Haskell2010 - if impl(ghc >=7.4 && < 7.6)- build-depends: ghc-prim- if flag(template-haskell) && impl(ghc)- build-depends: template-haskell >= 2.7 && < 3.0+ build-depends: template-haskell >= 2.11.1 && < 3.0 test-suite Simple type: exitcode-stdio-1.0@@ -117,7 +111,7 @@ build-depends: base >= 4.5 && < 5, bound,- deriving-compat >= 0.3.4 && < 0.6,+ deriving-compat >= 0.3.4 && < 0.7, transformers, transformers-compat @@ -126,16 +120,13 @@ main-is: Overkill.hs hs-source-dirs: examples ghc-options: -Wall -threaded- if impl(ghc >= 8.6)- ghc-options: -Wno-star-is-type default-language: Haskell2010 build-depends: base >= 4.5 && < 5, bound, transformers, transformers-compat,- functor-classes-compat,- vector+ vector >= 0.12 if !impl(ghc >= 7.8) buildable: False
doc/BoundLaws.hs view
@@ -3,10 +3,8 @@ module BoundLaws where import Bound.Class-#if !(MIN_VERSION_base(4,8,0))-import Control.Applicative hiding (Const(..))-#endif import Control.Monad+import Data.Kind {- @@ -18,25 +16,25 @@ -} -newtype Const x (m :: * -> *) a = Const x+newtype Const x (m :: Type -> Type) a = Const x instance Bound (Const x) where Const x >>>= _ = Const x -newtype Identity (m :: * -> *) a = Id (m a)+newtype Identity (m :: Type -> Type) a = Id (m a) instance Bound Identity where Id ma >>>= f = Id (ma >>= f) -data Product f g (m :: * -> *) a = f m a :*: g m a+data Product f g (m :: Type -> Type) a = f m a :*: g m a instance (Bound f, Bound g) => Bound (Product f g) where (fma :*: gma) >>>= f = (fma >>>= f) :*: (gma >>>= f) -data Sum f g (m :: * -> *) a = Inl (f m a) | Inr (g m a)+data Sum f g (m :: Type -> Type) a = Inl (f m a) | Inr (g m a) instance (Bound f, Bound g) => Bound (Sum f g) where Inl fma >>>= f = Inl (fma >>>= f)@@ -51,7 +49,7 @@ -} -data Exp (f :: (* -> *) -> * -> *) a = Var a | Branch (f (Exp f) a)+data Exp (f :: (Type -> Type) -> Type -> Type) a = Var a | Branch (f (Exp f) a) instance Bound f => Functor (Exp f) where fmap = liftM@@ -61,7 +59,9 @@ (<*>) = ap instance Bound f => Monad (Exp f) where+#if !(MIN_VERSION_base(4,11,0)) return = Var+#endif Var a >>= f = f a Branch fE >>= f = Branch (fE >>>= f)
doc/bound-laws.cabal view
@@ -15,16 +15,14 @@ description: Some laws for the @Bound@ class tested-with:- GHC==7.4.2,- GHC==7.6.3,- GHC==7.8.4,- GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.4, GHC==8.6.5,- GHC==8.8.3,- GHC==8.10.1+ GHC==8.8.4,+ GHC==8.10.7,+ GHC==9.0.1,+ GHC==9.2.1 source-repository head type: git@@ -34,9 +32,7 @@ exposed-modules: BoundLaws hs-source-dirs: . ghc-options: -Wall- if impl(ghc >= 8.6)- ghc-options: -Wno-star-is-type default-language: Haskell2010 build-depends:- base >= 4.5 && < 5,+ base >= 4.9 && < 5, bound
examples/Deriving.hs view
@@ -1,11 +1,8 @@ {-# LANGUAGE CPP, DeriveFunctor, DeriveFoldable, DeriveTraversable #-} module Main where -import Data.List-import Data.Foldable-import Data.Traversable+import qualified Data.List as L import Control.Monad-import Control.Applicative import Data.Functor.Classes import Bound @@ -24,14 +21,15 @@ (<*>) = ap instance Monad Exp where+#if !(MIN_VERSION_base(4,11,0)) return = V+#endif V a >>= f = f a (x :@ y) >>= f = (x >>= f) :@ (y >>= f) Lam n p e >>= f = Lam n (p >>>= f) (e >>>= f) Let n bs e >>= f = Let n (map (>>>= f) bs) (e >>>= f) Case e as >>= f = Case (e >>= f) (map (>>>= f) as) -#if MIN_VERSION_transformers(0,5,0) || !MIN_VERSION_transformers(0,4,0) instance Eq1 Exp where liftEq eq (V a) (V b) = eq a b liftEq eq (a :@ a') (b :@ b') = liftEq eq a b && liftEq eq a' b'@@ -39,9 +37,6 @@ liftEq eq (Let n bs e) (Let n' bs' e') = n == n' && liftEq (liftEq eq) bs bs' && liftEq eq e e' liftEq eq (Case e as) (Case e' as') = liftEq eq e e' && liftEq (liftEq eq) as as' liftEq _ _ _ = False-#else-instance Eq1 Exp-#endif -- And "similarly" for Ord1, Show1 and Read1 data Pat f a@@ -52,7 +47,6 @@ | ViewP (Scope Int f a) (Pat f a) deriving (Eq,Ord,Show,Read,Functor,Foldable,Traversable) -#if MIN_VERSION_transformers(0,5,0) || !MIN_VERSION_transformers(0,4,0) instance (Eq1 f, Monad f) => Eq1 (Pat f) where liftEq _ VarP VarP = True liftEq _ WildP WildP = True@@ -60,7 +54,6 @@ liftEq eq (ConP g ps) (ConP g' ps') = g == g' && liftEq (liftEq eq) ps ps' liftEq eq (ViewP e p) (ViewP e' p') = liftEq eq e e' && liftEq eq p p' liftEq _ _ _ = False-#endif instance Bound Pat where VarP >>>= _ = VarP@@ -72,11 +65,9 @@ data Alt f a = Alt {-# UNPACK #-} !Int (Pat f a) (Scope Int f a) deriving (Eq,Functor,Foldable,Traversable) -#if MIN_VERSION_transformers(0,5,0) || !MIN_VERSION_transformers(0,4,0) instance (Eq1 f, Monad f) => Eq1 (Alt f) where liftEq eq (Alt n p b) (Alt n' p' b') = n == n' && liftEq eq p p' && liftEq eq b b'-#endif instance Bound Alt where Alt n p b >>>= f = Alt n (p >>>= f) (b >>>= f)@@ -103,12 +94,12 @@ conp :: String -> [P a] -> P a conp g ps = P (ConP g . go ps) (ps >>= bindings) where- go (P p as:ps) bs = p bs : go ps (bs ++ as)+ go (P p as:ps') bs = p bs : go ps' (bs ++ as) go [] _ = [] -- | view patterns can view variables that are bound earlier than them in the pattern viewp :: Eq a => Exp a -> P a -> P a-viewp t (P p as) = P (\bs -> ViewP (abstract (`elemIndex` bs) t) (p bs)) as+viewp t (P p as) = P (\bs -> ViewP (abstract (`L.elemIndex` bs) t) (p bs)) as -- | smart lam constructor --@@ -121,20 +112,20 @@ -- >>> lam (conp "F" [varp "x", viewp (V "y") $ varp "y"]) (V "y") -- Lam 2 (ConP "F" [VarP,ViewP (Scope (V (F (V "y")))) VarP]) (Scope (V (B 1))) lam :: Eq a => P a -> Exp a -> Exp a-lam (P p as) t = Lam (length as) (p []) (abstract (`elemIndex` as) t)+lam (P p as) t = Lam (length as) (p []) (abstract (`L.elemIndex` as) t) -- | smart let constructor let_ :: Eq a => [(a, Exp a)] -> Exp a -> Exp a let_ bs b = Let (length bs) (map (abstr . snd) bs) (abstr b) where vs = map fst bs- abstr = abstract (`elemIndex` vs)+ abstr = abstract (`L.elemIndex` vs) -- | smart alt constructor -- -- >>> lam (varp "x") $ Case (V "x") [alt (conp "Hello" [varp "z",wildp]) (V "x"), alt (varp "y") (V "y")] -- Lam 1 VarP (Scope (Case (V (B 0)) [Alt 1 (ConP "Hello" [VarP,WildP]) (Scope (V (F (V (B 0))))),Alt 1 VarP (Scope (V (B 0)))])) alt :: Eq a => P a -> Exp a -> Alt Exp a-alt (P p as) t = Alt (length as) (p []) (abstract (`elemIndex` as) t)+alt (P p as) t = Alt (length as) (p []) (abstract (`L.elemIndex` as) t) main :: IO () main = return ()
examples/Imperative.hs view
@@ -7,19 +7,12 @@ -- are used in positions where it would make no sense to replace them by another -- statement. -import Bound.Class import Bound.Scope -- .Simple-import Bound.Term import Bound.Var-import Control.Applicative import Control.Monad (ap)-import Control.Monad.Trans.Class (lift)-import Data.Foldable import Data.Functor.Identity import Data.IORef-import Data.Traversable import Data.Void (Void, absurd)- -- PART 1: We want to model a tiny assembly language. --
examples/Overkill.hs view
@@ -5,24 +5,20 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE TypeOperators #-} -{-# OPTIONS_GHC -fwarn-incomplete-patterns -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wincomplete-patterns -Wno-orphans #-} module Main where --- Dara.Functor.Classes in transformers 0.4.0 are totally different-#if MIN_VERSION_transformers(0,5,0) || !MIN_VERSION_transformers(0,4,0)-+import Data.Kind import qualified Data.Vector as Vector import Data.Vector (Vector) import qualified Data.List as List import Data.Foldable import Data.Traversable-import Data.Monoid (Monoid(..)) import Control.Monad import Control.Applicative import Prelude hiding (foldr) import Data.Functor.Classes-import Data.Vector.Functor.Classes () import Data.Type.Equality import Bound @@ -37,24 +33,24 @@ data Index = VarI | WildI | AsI Index | ConI [Index] -data Pat :: Index -> (* -> *) -> * -> * where+data Pat :: Index -> (Type -> Type) -> Type -> Type where VarP :: Pat 'VarI f a WildP :: Pat 'WildI f a AsP :: Pat i f a -> Pat ('AsI i) f a ConP :: String -> Pats bs f a -> Pat ('ConI bs) f a ViewP :: f a -> Pat b f a -> Pat b f a -- TODO: allow references to earlier variables -data Pats :: [Index] -> (* -> *) -> * -> * where+data Pats :: [Index] -> (Type -> Type) -> Type -> Type where NilP :: Pats '[] f a (:>) :: Pat b f a -> Pats bs f a -> Pats (b ': bs) f a -data Path :: Index -> * where+data Path :: Index -> Type where V :: Path 'VarI L :: Path ('AsI a) R :: Path a -> Path ('AsI a) C :: MPath as -> Path ('ConI as) -data MPath :: [Index] -> * where+data MPath :: [Index] -> Type where H :: Path a -> MPath (a ':as) T :: MPath as -> MPath (a ':as) @@ -75,7 +71,9 @@ traverse f (Let bs e) = Let <$> traverse (traverse f) bs <*> traverse f e instance Monad Exp where+#if !(MIN_VERSION_base(4,11,0)) return = Var+#endif Var a >>= f = f a (x :@ y) >>= f = (x >>= f) :@ (y >>= f) Lam p e >>= f = Lam (p >>>= f) (e >>>= f)@@ -342,6 +340,5 @@ -- -- >>> lam (conp "Hello" [varp "x", wildp]) (Var "y") -- Lam (ConP "Hello" (VarP :> WildP :> NilP)) (Scope (Var (F (Var "y"))))-#endif main :: IO () main = return ()
examples/Simple.hs view
@@ -53,7 +53,9 @@ traverse f (Let bs b) = Let <$> traverse (traverse f) bs <*> traverse f b instance Monad Exp where+#if !(MIN_VERSION_base(4,11,0)) return = V+#endif V a >>= f = f a (x :@ y) >>= f = (x >>= f) :@ (y >>= f) Lam e >>= f = Lam (e >>>= f)@@ -144,18 +146,19 @@ -- TODO: use a real pretty printer prettyPrec :: [String] -> Bool -> Int -> Exp String -> ShowS-prettyPrec _ d n (V a) = showString a-prettyPrec vs d n (x :@ y) = showParen d $ +prettyPrec _ _ _ (V a) = showString a+prettyPrec vs d n (x :@ y) = showParen d $ prettyPrec vs False n x . showChar ' ' . prettyPrec vs True n y-prettyPrec (v:vs) d n (Lam b) = showParen d $ +prettyPrec (v:vs) d n (Lam b) = showParen d $ showString v . showString ". " . prettyPrec vs False n (instantiate1 (V v) b)-prettyPrec vs d n (Let bs b) = showParen d $ +prettyPrec [] _ _ (Lam _) = error "Ran out of variable names"+prettyPrec vs d n (Let bs b) = showParen d $ showString "let" . foldr (.) id (zipWith showBinding xs bs) . showString " in " . indent . prettyPrec ys False n (inst b) where (xs,ys) = splitAt (length bs) vs- inst = instantiate (\n -> V (xs !! n))+ inst = instantiate (\n' -> V (xs !! n')) indent = showString ('\n' : replicate (n + 4) ' ')- showBinding x b = indent . showString x . showString " = " . prettyPrec ys False (n + 4) (inst b)+ showBinding x b' = indent . showString x . showString " = " . prettyPrec ys False (n + 4) (inst b') prettyWith :: [String] -> Exp String -> String prettyWith vs t = prettyPrec (filter (`notElem` toList t) vs) False 0 t ""
src/Bound.hs view
@@ -26,7 +26,7 @@ -- import Data.Foldable -- import Data.Traversable -- -- This is from deriving-compat package--- import Data.Deriving (deriveEq1, deriveOrd1, deriveRead1, deriveShow1) +-- import Data.Deriving (deriveEq1, deriveOrd1, deriveRead1, deriveShow1) -- @ -- -- @@@ -128,8 +128,10 @@ , Var(..) , fromScope , toScope- -- * Deriving instances +#ifdef MIN_VERSION_template_haskell+ -- * Deriving instances , makeBound+#endif ) where import Bound.Var
src/Bound/Class.hs view
@@ -2,7 +2,7 @@ #if defined(__GLASGOW_HASKELL__) {-# LANGUAGE DefaultSignatures #-} #endif-{-# OPTIONS -fno-warn-deprecations #-}+{-# OPTIONS -Wno-deprecations #-} ----------------------------------------------------------------------------- -- | -- Copyright : (C) 2012-2015 Edward Kmett@@ -21,9 +21,6 @@ ) where import Control.Monad.Trans.Class-#if !MIN_VERSION_base(4,8,0)-import Data.Monoid-#endif import Control.Monad.Trans.Cont import Control.Monad.Trans.Error import Control.Monad.Trans.Identity
src/Bound/Name.hs view
@@ -39,12 +39,6 @@ import Bound.Scope import Bound.Var-#if !MIN_VERSION_base(4,8,0)-import Control.Applicative-import Data.Foldable-import Data.Monoid-import Data.Traversable-#endif import Control.Comonad import Control.DeepSeq import Control.Monad (liftM, liftM2)@@ -78,13 +72,10 @@ ( Show , Read #ifdef __GLASGOW_HASKELL__- , Typeable , Data , Generic-# if __GLASGOW_HASKELL__ >= 706 , Generic1 #endif-#endif ) -- | Extract the 'name'.@@ -157,8 +148,6 @@ extend f w@(Name n _) = Name n (f w) {-# INLINE extend #-} -#if MIN_VERSION_transformers(0,5,0) || !MIN_VERSION_transformers(0,4,0)- instance Eq2 Name where liftEq2 _ g (Name _ b) (Name _ d) = g b d @@ -182,20 +171,6 @@ instance Read b => Read1 (Name b) where liftReadsPrec f _ = readsData $ readsBinaryWith readsPrec f "Name" Name--#else--instance Eq1 (Name b) where eq1 = (==)-instance Ord1 (Name b) where compare1 = compare-instance Show b => Show1 (Name b) where showsPrec1 = showsPrec-instance Read b => Read1 (Name b) where readsPrec1 = readsPrec----instance Eq2 Name where eq2 = (==)---instance Ord2 Name where compare2 = compare---instance Show2 Name where showsPrec2 = showsPrec---instance Read2 Name where readsPrec2 = readsPrec--#endif instance Serial2 Name where serializeWith2 pb pf (Name b a) = pb b >> pf a
src/Bound/Scope.hs view
@@ -84,12 +84,8 @@ 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@@ -120,13 +116,8 @@ newtype Scope b f a = Scope { unscope :: f (Var b (f a)) } #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 ------------------------------------------------------------------------------- -- Instances@@ -154,10 +145,6 @@ -- | The monad permits substitution on free variables, while preserving -- bound variables instance Monad f => Monad (Scope b f) where-#if !MIN_VERSION_base(4,8,0)- return a = Scope (return (F (return a)))- {-# INLINE return #-}-#endif Scope e >>= f = Scope $ e >>= \v -> case v of B b -> return (B b) F ea -> ea >>= unscope . f@@ -168,18 +155,12 @@ {-# INLINE lift #-} instance MFunctor (Scope b) where-#if !MIN_VERSION_base(4,8,0)- hoist t (Scope b) = Scope $ t (liftM (liftM t) b)-#else hoist = hoistScope-#endif {-# INLINE hoist #-} instance (Monad f, Eq b, Eq1 f, Eq a) => Eq (Scope b f a) where (==) = eq1 instance (Monad f, Ord b, Ord1 f, Ord a) => Ord (Scope b f a) where compare = compare1 -#if MIN_VERSION_transformers(0,5,0) || !(MIN_VERSION_transformers(0,4,0))- -------------------------------------------------------------------------------- -- * transformers 0.5 Data.Functor.Classes --------------------------------------------------------------------------------@@ -203,37 +184,6 @@ f' = liftReadsPrec f g g' = liftReadList f g -#else------------------------------------------------------------------------------------- * transformers 0.4 Data.Functor.Classes-----------------------------------------------------------------------------------instance (Functor f, Read b, Read1 f, Read a) => Read (Scope b f a) where readsPrec = readsPrec1-instance (Functor f, Show b, Show1 f, Show a) => Show (Scope b f a) where showsPrec = showsPrec1--instance (Monad f, Eq b, Eq1 f) => Eq1 (Scope b f) where- eq1 a b = eq1 (fromScope a) (fromScope b)--instance (Monad f, Ord b, Ord1 f) => Ord1 (Scope b f) where- compare1 a b = fromScope a `compare1` fromScope b--newtype Lift1 f a = Lift1 { lower1 :: f a }-instance (Show1 f, Show a) => Show (Lift1 f a) where showsPrec d (Lift1 m) = showsPrec1 d m-instance (Read1 f, Read a) => Read (Lift1 f a) where- readsPrec d m = fmap (first Lift1) $ readsPrec1 d m--instance (Functor f, Show b, Show1 f) => Show1 (Scope b f) where- showsPrec1 d a = showParen (d > 10) $- showString "Scope " . showsPrec1 11 (fmap (fmap Lift1) (unscope a))--instance (Functor f, Read b, Read1 f) => Read1 (Scope b f) where- readsPrec1 d = readParen (d > 10) $ \r -> do- ("Scope", r') <- lex r- (s, r'') <- readsPrec1 11 r'- return (Scope (fmap (fmap lower1) s), r'')-#endif- instance Bound (Scope b) where Scope m >>>= f = Scope (liftM (fmap (>>= f)) m) {-# INLINE (>>>=) #-}@@ -511,22 +461,5 @@ 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)-+deriving instance (Typeable b, Typeable f, Data a, Data (f (Var b (f a)))) => Data (Scope b f a) #endif
src/Bound/Scope/Simple.hs view
@@ -83,12 +83,8 @@ 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@@ -115,13 +111,7 @@ #if defined(__GLASGOW_HASKELL__) deriving Generic #endif-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ > 707-deriving instance Typeable Scope-#endif--#if __GLASGOW_HASKELL__ >= 706 deriving instance Functor f => Generic1 (Scope b f)-#endif ------------------------------------------------------------------------------- -- Instances@@ -143,11 +133,7 @@ traverse f (Scope a) = Scope <$> traverse (traverse f) a {-# INLINE traverse #-} -#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-#endif pure a = Scope (return (F a)) {-# INLINE pure #-} (<*>) = ap@@ -156,10 +142,6 @@ -- | The monad permits substitution on free variables, while preserving -- bound variables instance Monad f => Monad (Scope b f) where-#if __GLASGOW_HASKELL__ < 710- return a = Scope (return (F a))- {-# INLINE return #-}-#endif Scope e >>= f = Scope $ e >>= \v -> case v of B b -> return (B b) F a -> unscope (f a)@@ -173,7 +155,6 @@ hoist f = hoistScope f {-# INLINE hoist #-} -#if (MIN_VERSION_transformers(0,5,0)) || !(MIN_VERSION_transformers(0,4,0)) instance (Eq b, Eq1 f) => Eq1 (Scope b f) where liftEq f m n = liftEq (liftEq f) (unscope m) (unscope n) @@ -201,37 +182,7 @@ instance (Read b, Read1 f, Read a) => Read (Scope b f a) where readsPrec = readsPrec1-#else -instance (Functor f, Eq b, Eq1 f) => Eq1 (Scope b f) where- eq1 m n = eq1 (unscope m) (unscope n)--instance (Functor f, Ord b, Ord1 f) => Ord1 (Scope b f) where- compare1 m n = compare1 (unscope m) (unscope n)--instance (Functor f, Show b, Show1 f) => Show1 (Scope b f) where- showsPrec1 d a = showParen (d > 10) $- showString "Scope " . showsPrec1 11 (unscope a)--instance (Functor f, Read b, Read1 f) => Read1 (Scope b f) where- readsPrec1 d = readParen (d > 10) $ \r -> do- ("Scope", r') <- lex r- (s, r'') <- readsPrec1 11 r'- return (Scope s, r'')--instance (Functor f, Eq b, Eq1 f, Eq a) => Eq (Scope b f a) where- (==) = eq1--instance (Functor f, Ord b, Ord1 f, Ord a) => Ord (Scope b f a) where- compare = compare1--instance (Functor f, Show b, Show1 f, Show a) => Show (Scope b f a) where- showsPrec = showsPrec1--instance (Functor f, Read b, Read1 f, Read a) => Read (Scope b f a) where- readsPrec = readsPrec1-#endif- instance Bound (Scope b) where Scope m >>>= f = Scope $ m >>= \v -> case v of B b -> return (B b)@@ -479,25 +430,5 @@ 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)-+deriving instance (Typeable b, Typeable f, Data a, Data (f (Var b a))) => Data (Scope b f a) #endif
src/Bound/TH.hs view
@@ -1,6 +1,11 @@-{-# LANGUAGE CPP #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE PatternGuards #-}++#if __GLASGOW_HASKELL__ >= 900+{-# LANGUAGE TemplateHaskellQuotes #-}+#else {-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE PatternGuards #-}+#endif ----------------------------------------------------------------------------- -- |@@ -29,9 +34,6 @@ import Bound.Class (Bound((>>>=))) import Language.Haskell.TH import Language.Haskell.TH.Datatype.TyVarBndr-#if __GLASGOW_HASKELL__ < 710-import Control.Applicative (Applicative, pure, (<*>))-#endif import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Maybe (MaybeT (..))@@ -123,11 +125,7 @@ makeBound name = do TyConI dec <- reify name case dec of-#if MIN_VERSION_template_haskell(2,11,0) DataD _ _name vars _ cons _ -> makeBound' name vars cons-#else- DataD _ _name vars cons _ -> makeBound' name vars cons-#endif _ -> fail $ show name ++ " Must be a data type." makeBound' :: Name -> [TyVarBndrUnit] -> [Con] -> DecsQ@@ -141,61 +139,6 @@ bind :: ExpQ bind = constructBind name vars cons -#if __GLASGOW_HASKELL__ < 708- def :: Name -> DecQ -> [DecQ]-#if __GLASGOW_HASKELL__ < 706- def _theName dec = [dec]-#else- def theName dec = [pragInlD theName Inline FunLike AllPhases, dec]-#endif-- pureBody :: Name -> [DecQ]- pureBody pure'or'return =- def pure'or'return- (valD (varP pure'or'return) (normalB var) [])-- bindBody :: [DecQ]- bindBody =- def '(>>=)- (valD (varP '(>>=)) (normalB bind) [])-- apBody <- do- ff <- newName "ff"- fy <- newName "fy"- f <- newName "f"- y <- newName "y"-- -- \ff fy -> do- -- f <- ff- -- y <- fy- -- pure (f x)- let ap :: ExpQ- ap = lamE [varP ff, varP fy] (doE- [bindS (varP f) (varE ff),- bindS (varP y) (varE fy),- noBindS (varE 'pure `appE` (varE f `appE` varE y))])-- pure (def '(<*>) (valD (varP '(<*>)) (normalB ap) []))-- -- instance Applicative $name where- -- pure = $var- -- (<*>) = \ff fy -> do- -- f <- ff- -- y <- fy- -- pure (f y)- applicative <-- instanceD (cxt []) (appT (conT ''Applicative) (pure instanceHead))- (pureBody 'pure ++ apBody)-- -- instance Monad $name where- -- return = $var- -- (>>=) = $bind- monad <-- instanceD (cxt []) (appT (conT ''Monad) (pure instanceHead))- (pureBody 'return ++ bindBody)-- pure [applicative, monad]-#else [d| instance Applicative $(pure instanceHead) where pure = $var {-# INLINE pure #-}@@ -207,15 +150,9 @@ {-# INLINE (<*>) #-} instance Monad $(pure instanceHead) where-# if __GLASGOW_HASKELL__ < 710- return = $var- {-# INLINE return #-}-# endif- (>>=) = $bind {-# INLINE (>>=) #-} |]-#endif -- Internals data Prop@@ -318,7 +255,11 @@ exprs <- foldM bindOne (ConE name) bounds pure $ Match- (ConP name [ VarP arg | (arg, _) <- bounds ])+ (ConP name+#if MIN_VERSION_template_haskell(2,18,0)+ []+#endif+ [ VarP arg | (arg, _) <- bounds ]) (NormalB exprs) []@@ -376,13 +317,9 @@ (conName, [ t1, t2 ]) ForallC _ _ conName -> allTypeArgs conName-#if MIN_VERSION_template_haskell(2,11,0) _ -> error "Not implemented"-#endif return (findReturn lastTyVar (allTypeArgs `fmap` cons))-#else-#endif ------------------------------------------------------------------------------- -- Type mangling@@ -395,3 +332,5 @@ -- | Apply arguments to a type constructor. conAppsT :: Name -> [Type] -> Type conAppsT conName = foldl AppT (ConT conName)+#else+#endif
src/Bound/Var.hs view
@@ -22,13 +22,6 @@ , _F ) where -#if !MIN_VERSION_base(4,8,0)-import Control.Applicative-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(..))@@ -70,12 +63,9 @@ , Read #ifdef __GLASGOW_HASKELL__ , Data- , Typeable , Generic-# if __GLASGOW_HASKELL__ >= 706 , Generic1 #endif-#endif ) distinguisher :: Int@@ -196,7 +186,6 @@ bitraverse _ g (F a) = F <$> g a {-# INLINE bitraverse #-} -#if (MIN_VERSION_transformers(0,5,0)) || !(MIN_VERSION_transformers(0,4,0)) instance Eq2 Var where liftEq2 f _ (B a) (B c) = f a c liftEq2 _ g (F b) (F d) = g b d@@ -226,18 +215,6 @@ instance Read b => Read1 (Var b) where liftReadsPrec = liftReadsPrec2 readsPrec readList--#else---instance Eq2 Var where eq2 = (==)---instance Ord2 Var where compare2 = compare---instance Show2 Var where showsPrec2 = showsPrec---instance Read2 Var where readsPrec2 = readsPrec--instance Eq b => Eq1 (Var b) where eq1 = (==)-instance Ord b => Ord1 (Var b) where compare1 = compare-instance Show b => Show1 (Var b) where showsPrec1 = showsPrec-instance Read b => Read1 (Var b) where readsPrec1 = readsPrec-#endif instance (NFData a, NFData b) => NFData (Var b a) where rnf (B b) = rnf b