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/>. The present module provides
13 -- some preliminary support to compute on types.
15 -----------------------------------------------------------------------------
17 module Data.Generics.Reify (
20 TypeVal, -- view type "a" as "a -> ()"
21 typeVal, -- :: TypeVal a
22 sameType, -- two type values are the same
23 typeValOf, -- :: a -> TypeVal a
24 undefinedType, -- :: TypeVal a -> a
25 withType, -- :: a -> TypeVal a -> a
26 argType, -- :: (a -> b) -> TypeVal a
27 resType, -- :: (a -> b) -> TypeVal b
28 paraType, -- :: t a -> TypeVal a
29 TypeFun, -- functions on types
30 GTypeFun, -- polymorphic functions on types
32 -- * Generic operations to reify terms
38 -- * Generic operations to reify types
45 ------------------------------------------------------------------------------
48 import Data.Generics.Basics
49 import Data.Generics.Aliases
50 import Data.Generics.Schemes
54 -------------------------------------------------------------
58 -------------------------------------------------------------
62 This group provides a style of encoding types as values and using
63 them. This style is seen as an alternative to the pragmatic style used
64 in Data.Typeable.typeOf and elsewhere, i.e., simply use an "undefined"
65 to denote a type argument. This pragmatic style suffers from lack
66 of robustness: one feels tempted to pattern match on undefineds.
67 Maybe Data.Typeable.typeOf etc. should be rewritten accordingly.
72 -- | Type as values to stipulate use of undefineds
73 type TypeVal a = a -> ()
76 -- | The value that denotes a type
81 -- | Test for type equivalence
82 sameType :: (Typeable a, Typeable b) => TypeVal a -> TypeVal b -> Bool
83 sameType tva tvb = typeOf (undefinedType tva) ==
84 typeOf (undefinedType tvb)
87 -- | Map a value to its type
88 typeValOf :: a -> TypeVal a
92 -- | Stipulate this idiom!
93 undefinedType :: TypeVal a -> a
94 undefinedType _ = undefined
98 withType :: a -> TypeVal a -> a
102 -- | The argument type of a function
103 argType :: (a -> b) -> TypeVal a
107 -- | The result type of a function
108 resType :: (a -> b) -> TypeVal b
112 -- | The parameter type of type constructor
113 paraType :: t a -> TypeVal a
118 -- i.e., functions mapping types to values
120 type TypeFun a r = TypeVal a -> r
124 -- Generic type functions,
125 -- i.e., functions mapping types to values
127 type GTypeFun r = forall a. Data a => TypeFun a r
131 ------------------------------------------------------------------------------
133 -- Generic operations to reify terms
135 ------------------------------------------------------------------------------
138 -- | Count the number of immediate subterms of the given term
139 glength :: GenericQ Int
140 glength = length . gmapQ (const ())
143 -- | Determine the number of all suitable nodes in a given term
144 gcount :: GenericQ Bool -> GenericQ Int
145 gcount p = everything (+) (\x -> if p x then 1 else 0)
148 -- | Determine the number of all nodes in a given term
149 gnodecount :: GenericQ Int
150 gnodecount = gcount (const True)
153 -- | Determine the number of nodes of a given type in a given term
154 gtypecount :: Typeable a => (a -> ()) -> GenericQ Int
155 gtypecount f = gcount (False `mkQ` (const True . f))
159 ------------------------------------------------------------------------------
161 -- Generic operations to reify types
163 ------------------------------------------------------------------------------
165 -- | Compute arity of a constructor against a type argument
166 constrArity :: Data a => (a -> ()) -> Constr -> Int
167 constrArity ta c = glength $ withType (fromConstr c) ta
171 -- Reachability relation on types:
172 -- Test if nodes of type "a" are reachable from nodes of type "b".
173 -- This is a naive, inefficient encoding.
174 -- As of writing, it does not even cope with recursive types.
176 typeReachableFrom :: (Data a, Data b) => TypeVal a -> TypeVal b -> Bool
177 typeReachableFrom (a::TypeVal a) (b::TypeVal b) =
179 : map (recurse . fromConstr) (dataTypeCons $ dataTypeOf b)
183 -- See if a is reachable from immediate subterms of a kind of b
186 . gmapQ ( typeReachableFrom a