syb 0.4.4 → 0.5
raw patch · 3 files changed
+294/−274 lines, 3 filesdep ~base
Dependency ranges changed: base
Files
- src/Data/Generics/Text.hs +2/−1
- src/Data/Generics/Twins.hs +291/−272
- syb.cabal +1/−1
src/Data/Generics/Text.hs view
@@ -34,6 +34,7 @@ import Data.Data import Data.Generics.Aliases import Text.ParserCombinators.ReadP +import Text.Read.Lex ------------------------------------------------------------------------------ @@ -120,7 +121,7 @@ string "[]" -- Compound lexeme "[]" <++ string "()" -- singleton "()" <++ infixOp -- Infix operator in parantheses - <++ readS_to_P lex -- Ordinary constructors and literals + <++ hsLex -- Ordinary constructors and literals -- Handle infix operators such as (:) infixOp :: ReadP String
src/Data/Generics/Twins.hs view
@@ -1,272 +1,291 @@-{-# LANGUAGE RankNTypes, ScopedTypeVariables, CPP #-}--------------------------------------------------------------------------------- |--- Module : Data.Generics.Twins--- Copyright : (c) The University of Glasgow, CWI 2001--2004--- License : BSD-style (see the LICENSE file)------ Maintainer : generics@haskell.org--- Stability : experimental--- Portability : non-portable (local universal quantification)------ \"Scrap your boilerplate\" --- Generic programming in Haskell--- See <http://www.cs.uu.nl/wiki/GenericProgramming/SYB>. The present module--- provides support for multi-parameter traversal, which is also--- demonstrated with generic operations like equality.-----------------------------------------------------------------------------------module Data.Generics.Twins (-- -- * Generic folds and maps that also accumulate- gfoldlAccum,- gmapAccumT,- gmapAccumM,- gmapAccumQl,- gmapAccumQr,- gmapAccumQ,- gmapAccumA,-- -- * Mapping combinators for twin traversal- gzipWithT,- gzipWithM,- gzipWithQ,-- -- * Typical twin traversals- geq,- gzip-- ) where-----------------------------------------------------------------------------------#ifdef __HADDOCK__-import Prelude-#endif-import Data.Data-import Data.Generics.Aliases--#ifdef __GLASGOW_HASKELL__-import Prelude hiding ( GT )-#endif--#if __GLASGOW_HASKELL__ < 709-import Control.Applicative (Applicative(..))-#endif----------------------------------------------------------------------------------------------------------------------------------------------------------------------- Generic folds and maps that also accumulate------------------------------------------------------------------------------------{----------------------------------------------------------------A list map can be elaborated to perform accumulation.-In the same sense, we can elaborate generic maps over terms.--We recall the type of map:-map :: (a -> b) -> [a] -> [b]--We recall the type of an accumulating map (see Data.List):-mapAccumL :: (a -> b -> (a,c)) -> a -> [b] -> (a,[c])--Applying the same scheme we obtain an accumulating gfoldl.----------------------------------------------------------------}---- | gfoldl with accumulation--gfoldlAccum :: Data d- => (forall e r. Data e => a -> c (e -> r) -> e -> (a, c r))- -> (forall g. a -> g -> (a, c g))- -> a -> d -> (a, c d)--gfoldlAccum k z a0 d = unA (gfoldl k' z' d) a0- where- k' c y = A (\a -> let (a', c') = unA c a in k a' c' y)- z' f = A (\a -> z a f)----- | A type constructor for accumulation-newtype A a c d = A { unA :: a -> (a, c d) }----- | gmapT with accumulation-gmapAccumT :: Data d- => (forall e. Data e => a -> e -> (a,e))- -> a -> d -> (a, d)-gmapAccumT f a0 d0 = let (a1, d1) = gfoldlAccum k z a0 d0- in (a1, unID d1)- where- k a (ID c) d = let (a',d') = f a d- in (a', ID (c d'))- z a x = (a, ID x)----- | Applicative version-gmapAccumA :: forall b d a. (Data d, Applicative a)- => (forall e. Data e => b -> e -> (b, a e))- -> b -> d -> (b, a d)-gmapAccumA f a0 d0 = gfoldlAccum k z a0 d0- where- k :: forall d' e. (Data d') =>- b -> a (d' -> e) -> d' -> (b, a e)- k a c d = let (a',d') = f a d- c' = c <*> d'- in (a', c')- z :: forall t c a'. (Applicative a') =>- t -> c -> (t, a' c)- z a x = (a, pure x)----- | gmapM with accumulation-gmapAccumM :: (Data d, Monad m)- => (forall e. Data e => a -> e -> (a, m e))- -> a -> d -> (a, m d)-gmapAccumM f = gfoldlAccum k z- where- k a c d = let (a',d') = f a d- in (a', d' >>= \d'' -> c >>= \c' -> return (c' d''))- z a x = (a, return x)----- | gmapQl with accumulation-gmapAccumQl :: Data d- => (r -> r' -> r)- -> r- -> (forall e. Data e => a -> e -> (a,r'))- -> a -> d -> (a, r)-gmapAccumQl o r0 f a0 d0 = let (a1, r1) = gfoldlAccum k z a0 d0- in (a1, unCONST r1)- where- k a (CONST c) d = let (a', r) = f a d- in (a', CONST (c `o` r))- z a _ = (a, CONST r0)----- | gmapQr with accumulation-gmapAccumQr :: Data d- => (r' -> r -> r)- -> r- -> (forall e. Data e => a -> e -> (a,r'))- -> a -> d -> (a, r)-gmapAccumQr o r0 f a0 d0 = let (a1, l) = gfoldlAccum k z a0 d0- in (a1, unQr l r0)- where- k a (Qr c) d = let (a',r') = f a d- in (a', Qr (\r -> c (r' `o` r)))- z a _ = (a, Qr id)----- | gmapQ with accumulation-gmapAccumQ :: Data d- => (forall e. Data e => a -> e -> (a,q))- -> a -> d -> (a, [q])-gmapAccumQ f = gmapAccumQr (:) [] f---------------------------------------------------------------------------------------- Helper type constructors--------------------------------------------------------------------------------------- | The identity type constructor needed for the definition of gmapAccumT-newtype ID x = ID { unID :: x }----- | The constant type constructor needed for the definition of gmapAccumQl-newtype CONST c a = CONST { unCONST :: c }----- | The type constructor needed for the definition of gmapAccumQr-newtype Qr r a = Qr { unQr :: r -> r }---------------------------------------------------------------------------------------- Mapping combinators for twin traversal--------------------------------------------------------------------------------------- | Twin map for transformation-gzipWithT :: GenericQ (GenericT) -> GenericQ (GenericT)-gzipWithT f x y = case gmapAccumT perkid funs y of- ([], c) -> c- _ -> error "gzipWithT"- where- perkid a d = (tail a, unGT (head a) d)- funs = gmapQ (\k -> GT (f k)) x------ | Twin map for monadic transformation-gzipWithM :: Monad m => GenericQ (GenericM m) -> GenericQ (GenericM m)-gzipWithM f x y = case gmapAccumM perkid funs y of- ([], c) -> c- _ -> error "gzipWithM"- where- perkid a d = (tail a, unGM (head a) d)- funs = gmapQ (\k -> GM (f k)) x----- | Twin map for queries-gzipWithQ :: GenericQ (GenericQ r) -> GenericQ (GenericQ [r])-gzipWithQ f x y = case gmapAccumQ perkid funs y of- ([], r) -> r- _ -> error "gzipWithQ"- where- perkid a d = (tail a, unGQ (head a) d)- funs = gmapQ (\k -> GQ (f k)) x---------------------------------------------------------------------------------------- Typical twin traversals-------------------------------------------------------------------------------------- | Generic equality: an alternative to \"deriving Eq\"-geq :: Data a => a -> a -> Bool--{---Testing for equality of two terms goes like this. Firstly, we-establish the equality of the two top-level datatype-constructors. Secondly, we use a twin gmap combinator, namely tgmapQ,-to compare the two lists of immediate subterms.--(Note for the experts: the type of the worker geq' is rather general-but precision is recovered via the restrictive type of the top-level-operation geq. The imprecision of geq' is caused by the type system's-unability to express the type equivalence for the corresponding-couples of immediate subterms from the two given input terms.)---}--geq x0 y0 = geq' x0 y0- where- geq' :: GenericQ (GenericQ Bool)- geq' x y = (toConstr x == toConstr y)- && and (gzipWithQ geq' x y)----- | Generic zip controlled by a function with type-specific branches-gzip :: GenericQ (GenericM Maybe) -> GenericQ (GenericM Maybe)--- See testsuite/.../Generics/gzip.hs for an illustration-gzip f x y =- f x y- `orElse`- if toConstr x == toConstr y- then gzipWithM (gzip f) x y- else Nothing+{-# LANGUAGE RankNTypes, ScopedTypeVariables, CPP #-} +----------------------------------------------------------------------------- +-- | +-- Module : Data.Generics.Twins +-- Copyright : (c) The University of Glasgow, CWI 2001--2004 +-- License : BSD-style (see the LICENSE file) +-- +-- Maintainer : generics@haskell.org +-- Stability : experimental +-- Portability : non-portable (local universal quantification) +-- +-- \"Scrap your boilerplate\" --- Generic programming in Haskell +-- See <http://www.cs.uu.nl/wiki/GenericProgramming/SYB>. The present module +-- provides support for multi-parameter traversal, which is also +-- demonstrated with generic operations like equality. +-- +----------------------------------------------------------------------------- + +module Data.Generics.Twins ( + + -- * Generic folds and maps that also accumulate + gfoldlAccum, + gmapAccumT, + gmapAccumM, + gmapAccumQl, + gmapAccumQr, + gmapAccumQ, + gmapAccumA, + + -- * Mapping combinators for twin traversal + gzipWithT, + gzipWithM, + gzipWithQ, + + -- * Typical twin traversals + geq, + gzip, + gcompare + + ) where + + +------------------------------------------------------------------------------ + +#ifdef __HADDOCK__ +import Prelude +#endif +import Data.Data +import Data.Generics.Aliases + +#ifdef __GLASGOW_HASKELL__ +import Prelude hiding ( GT ) +#endif + +#if __GLASGOW_HASKELL__ < 709 +import Control.Applicative (Applicative(..)) +import Data.Monoid ( (<>), mconcat ) +#endif + +------------------------------------------------------------------------------ + + +------------------------------------------------------------------------------ +-- +-- Generic folds and maps that also accumulate +-- +------------------------------------------------------------------------------ + +{-------------------------------------------------------------- + +A list map can be elaborated to perform accumulation. +In the same sense, we can elaborate generic maps over terms. + +We recall the type of map: +map :: (a -> b) -> [a] -> [b] + +We recall the type of an accumulating map (see Data.List): +mapAccumL :: (a -> b -> (a,c)) -> a -> [b] -> (a,[c]) + +Applying the same scheme we obtain an accumulating gfoldl. + +--------------------------------------------------------------} + +-- | gfoldl with accumulation + +gfoldlAccum :: Data d + => (forall e r. Data e => a -> c (e -> r) -> e -> (a, c r)) + -> (forall g. a -> g -> (a, c g)) + -> a -> d -> (a, c d) + +gfoldlAccum k z a0 d = unA (gfoldl k' z' d) a0 + where + k' c y = A (\a -> let (a', c') = unA c a in k a' c' y) + z' f = A (\a -> z a f) + + +-- | A type constructor for accumulation +newtype A a c d = A { unA :: a -> (a, c d) } + + +-- | gmapT with accumulation +gmapAccumT :: Data d + => (forall e. Data e => a -> e -> (a,e)) + -> a -> d -> (a, d) +gmapAccumT f a0 d0 = let (a1, d1) = gfoldlAccum k z a0 d0 + in (a1, unID d1) + where + k a (ID c) d = let (a',d') = f a d + in (a', ID (c d')) + z a x = (a, ID x) + + +-- | Applicative version +gmapAccumA :: forall b d a. (Data d, Applicative a) + => (forall e. Data e => b -> e -> (b, a e)) + -> b -> d -> (b, a d) +gmapAccumA f a0 d0 = gfoldlAccum k z a0 d0 + where + k :: forall d' e. (Data d') => + b -> a (d' -> e) -> d' -> (b, a e) + k a c d = let (a',d') = f a d + c' = c <*> d' + in (a', c') + z :: forall t c a'. (Applicative a') => + t -> c -> (t, a' c) + z a x = (a, pure x) + + +-- | gmapM with accumulation +gmapAccumM :: (Data d, Monad m) + => (forall e. Data e => a -> e -> (a, m e)) + -> a -> d -> (a, m d) +gmapAccumM f = gfoldlAccum k z + where + k a c d = let (a',d') = f a d + in (a', d' >>= \d'' -> c >>= \c' -> return (c' d'')) + z a x = (a, return x) + + +-- | gmapQl with accumulation +gmapAccumQl :: Data d + => (r -> r' -> r) + -> r + -> (forall e. Data e => a -> e -> (a,r')) + -> a -> d -> (a, r) +gmapAccumQl o r0 f a0 d0 = let (a1, r1) = gfoldlAccum k z a0 d0 + in (a1, unCONST r1) + where + k a (CONST c) d = let (a', r) = f a d + in (a', CONST (c `o` r)) + z a _ = (a, CONST r0) + + +-- | gmapQr with accumulation +gmapAccumQr :: Data d + => (r' -> r -> r) + -> r + -> (forall e. Data e => a -> e -> (a,r')) + -> a -> d -> (a, r) +gmapAccumQr o r0 f a0 d0 = let (a1, l) = gfoldlAccum k z a0 d0 + in (a1, unQr l r0) + where + k a (Qr c) d = let (a',r') = f a d + in (a', Qr (\r -> c (r' `o` r))) + z a _ = (a, Qr id) + + +-- | gmapQ with accumulation +gmapAccumQ :: Data d + => (forall e. Data e => a -> e -> (a,q)) + -> a -> d -> (a, [q]) +gmapAccumQ f = gmapAccumQr (:) [] f + + + +------------------------------------------------------------------------------ +-- +-- Helper type constructors +-- +------------------------------------------------------------------------------ + + +-- | The identity type constructor needed for the definition of gmapAccumT +newtype ID x = ID { unID :: x } + + +-- | The constant type constructor needed for the definition of gmapAccumQl +newtype CONST c a = CONST { unCONST :: c } + + +-- | The type constructor needed for the definition of gmapAccumQr +newtype Qr r a = Qr { unQr :: r -> r } + + + +------------------------------------------------------------------------------ +-- +-- Mapping combinators for twin traversal +-- +------------------------------------------------------------------------------ + + +-- | Twin map for transformation +gzipWithT :: GenericQ (GenericT) -> GenericQ (GenericT) +gzipWithT f x y = case gmapAccumT perkid funs y of + ([], c) -> c + _ -> error "gzipWithT" + where + perkid a d = (tail a, unGT (head a) d) + funs = gmapQ (\k -> GT (f k)) x + + + +-- | Twin map for monadic transformation +gzipWithM :: Monad m => GenericQ (GenericM m) -> GenericQ (GenericM m) +gzipWithM f x y = case gmapAccumM perkid funs y of + ([], c) -> c + _ -> error "gzipWithM" + where + perkid a d = (tail a, unGM (head a) d) + funs = gmapQ (\k -> GM (f k)) x + + +-- | Twin map for queries +gzipWithQ :: GenericQ (GenericQ r) -> GenericQ (GenericQ [r]) +gzipWithQ f x y = case gmapAccumQ perkid funs y of + ([], r) -> r + _ -> error "gzipWithQ" + where + perkid a d = (tail a, unGQ (head a) d) + funs = gmapQ (\k -> GQ (f k)) x + + + +------------------------------------------------------------------------------ +-- +-- Typical twin traversals +-- +------------------------------------------------------------------------------ + +-- | Generic equality: an alternative to \"deriving Eq\" +geq :: Data a => a -> a -> Bool + +{- + +Testing for equality of two terms goes like this. Firstly, we +establish the equality of the two top-level datatype +constructors. Secondly, we use a twin gmap combinator, namely tgmapQ, +to compare the two lists of immediate subterms. + +(Note for the experts: the type of the worker geq' is rather general +but precision is recovered via the restrictive type of the top-level +operation geq. The imprecision of geq' is caused by the type system's +unability to express the type equivalence for the corresponding +couples of immediate subterms from the two given input terms.) + +-} + +geq x0 y0 = geq' x0 y0 + where + geq' :: GenericQ (GenericQ Bool) + geq' x y = (toConstr x == toConstr y) + && and (gzipWithQ geq' x y) + + +-- | Generic zip controlled by a function with type-specific branches +gzip :: GenericQ (GenericM Maybe) -> GenericQ (GenericM Maybe) +-- See testsuite/.../Generics/gzip.hs for an illustration +gzip f x y = + f x y + `orElse` + if toConstr x == toConstr y + then gzipWithM (gzip f) x y + else Nothing + +-- | Generic comparison: an alternative to \"deriving Ord\" +gcompare :: Data a => a -> a -> Ordering +gcompare = gcompare' + where + gcompare' :: (Data a, Data b) => a -> b -> Ordering + gcompare' x y + = let repX = constrRep $ toConstr x + repY = constrRep $ toConstr y + in + case (repX, repY) of + (AlgConstr nX, AlgConstr nY) -> + nX `compare` nY <> mconcat (gzipWithQ gcompare' x y) + (IntConstr iX, IntConstr iY) -> iX `compare` iY + (FloatConstr rX, FloatConstr rY) -> rX `compare` rY + (CharConstr cX, CharConstr cY) -> cX `compare` cY + _ -> error "type incompatibility in gcompare"
syb.cabal view
@@ -1,5 +1,5 @@ name: syb-version: 0.4.4+version: 0.5 license: BSD3 license-file: LICENSE author: Ralf Lammel, Simon Peyton Jones, Jose Pedro Magalhaes