1 -----------------------------------------------------------------------------
3 -- Module : Data.Generics.Reify
4 -- Copyright : (c) The University of Glasgow, CWI 2001--2003
5 -- License : BSD-style (see the file libraries/base/LICENSE)
7 -- Maintainer : libraries@haskell.org
8 -- Stability : experimental
9 -- Portability : non-portable
11 -- \"Scrap your boilerplate\" --- Generic programming in Haskell
12 -- See <http://www.cs.vu.nl/boilerplate/>.
14 -----------------------------------------------------------------------------
16 module Data.Generics.Reify (
19 TypeVal, -- view type "a" as "a -> ()"
20 typeVal, -- :: TypeVal a
21 sameType, -- two type values are the same
22 typeValOf, -- :: a -> TypeVal a
23 undefinedType, -- :: TypeVal a -> a
24 withType, -- :: a -> TypeVal a -> a
25 argType, -- :: (a -> b) -> TypeVal a
26 resType, -- :: (a -> b) -> TypeVal b
27 paraType, -- :: t a -> TypeVal a
28 TypeFun, -- functions on types
30 -- * Generic operations to reify terms
36 -- * Generic operations to reify types
43 ------------------------------------------------------------------------------
46 import Data.Generics.Basics
47 import Data.Generics.Aliases
48 import Data.Generics.Schemes
52 -------------------------------------------------------------
56 -------------------------------------------------------------
60 This group provides a style of encoding types as values and using
61 them. This style is seen as an alternative to the pragmatic style used
62 in Data.Typeable.typeOf and elsewhere, i.e., simply use an "undefined"
63 to denote a type argument. This pragmatic style suffers from lack
64 of robustness: one feels tempted to pattern match on undefineds.
65 Maybe Data.Typeable.typeOf etc. should be rewritten accordingly.
70 -- | Type as values to stipulate use of undefineds
71 type TypeVal a = a -> ()
74 -- | The value that denotes a type
79 -- | Test for type equivalence
80 sameType :: (Typeable a, Typeable b) => TypeVal a -> TypeVal b -> Bool
81 sameType tva tvb = typeOf (undefinedType tva) ==
82 typeOf (undefinedType tvb)
85 -- | Map a value to its type
86 typeValOf :: a -> TypeVal a
90 -- | Stipulate this idiom!
91 undefinedType :: TypeVal a -> a
92 undefinedType _ = undefined
96 withType :: a -> TypeVal a -> a
100 -- | The argument type of a function
101 argType :: (a -> b) -> TypeVal a
105 -- | The result type of a function
106 resType :: (a -> b) -> TypeVal b
110 -- | The parameter type of type constructor
111 paraType :: t a -> TypeVal a
116 -- i.e., functions mapping types to values
118 type TypeFun a r = TypeVal a -> r
122 -- Generic type functions,
123 -- i.e., functions mapping types to values
125 type GTypeFun r = forall a. Typeable a => TypeFun a r
129 ------------------------------------------------------------------------------
131 -- Generic operations to reify terms
133 ------------------------------------------------------------------------------
136 -- | Count the number of immediate subterms of the given term
137 glength :: GenericQ Int
138 glength = length . gmapQ (const ())
141 -- | Determine the number of all suitable nodes in a given term
142 gcount :: GenericQ Bool -> GenericQ Int
143 gcount p = everything (+) (\x -> if p x then 1 else 0)
146 -- | Determine the number of all nodes in a given term
147 gnodecount :: GenericQ Int
148 gnodecount = gcount (const True)
151 -- | Determine the number of nodes of a given type in a given term
152 gtypecount :: Typeable a => (a -> ()) -> GenericQ Int
153 gtypecount f = gcount (False `mkQ` (const True . f))
157 ------------------------------------------------------------------------------
159 -- Generic operations to reify types
161 ------------------------------------------------------------------------------
163 -- | Compute arity of a constructor against a type argument
164 constrArity :: Data a => (a -> ()) -> Constr -> Int
165 constrArity ta c = glength $ withType (fromConstr c) ta
169 -- Reachability relation on types:
170 -- Test if nodes of type "a" are reachable from nodes of type "b".
171 -- This is a naive, inefficient encoding.
172 -- As of writing, it does not even cope with recursive types.
174 typeReachableFrom :: (Data a, Data b) => TypeVal a -> TypeVal b -> Bool
175 typeReachableFrom (a::TypeVal a) (b::TypeVal b) =
177 : map (recurse . fromConstr) (dataTypeCons $ dataTypeOf b)
181 -- See if a is reachable from immediate subterms of a kind of b
184 . gmapQ ( typeReachableFrom a