Data/Generics/Reify.hs

   1 -----------------------------------------------------------------------------
   2 -- |
   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)
   6 --
   7 -- Maintainer  :  libraries@haskell.org
   8 -- Stability   :  experimental
   9 -- Portability :  non-portable
  10 --
  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.
  14 --
  15 -----------------------------------------------------------------------------
  16
  17 module Data.Generics.Reify (
  18
  19         -- * Types as values
  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
  31
  32         -- * Generic operations to reify terms
  33         glength,
  34         gcount,
  35         gnodecount,
  36         gtypecount,
  37
  38         -- * Generic operations to reify types
  39         constrArity,
  40         typeReachableFrom
  41
  42  ) where
  43
  44
  45 ------------------------------------------------------------------------------
  46
  47
  48 import Data.Generics.Basics
  49 import Data.Generics.Aliases
  50 import Data.Generics.Schemes
  51
  52
  53
  54 -------------------------------------------------------------
  55 --
  56 --      Types as values
  57 --
  58 -------------------------------------------------------------
  59
  60 {-
  61
  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.
  68
  69 -}
  70
  71
  72 -- | Type as values to stipulate use of undefineds
  73 type TypeVal a = a -> ()
  74
  75
  76 -- | The value that denotes a type
  77 typeVal :: TypeVal a
  78 typeVal = const ()
  79
  80
  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)
  85
  86
  87 -- | Map a value to its type
  88 typeValOf :: a -> TypeVal a
  89 typeValOf _ = typeVal
  90
  91
  92 -- | Stipulate this idiom!
  93 undefinedType :: TypeVal a -> a
  94 undefinedType _ = undefined
  95
  96
  97 -- | Constrain a type
  98 withType :: a -> TypeVal a -> a
  99 withType x _ = x
 100
 101
 102 -- | The argument type of a function
 103 argType :: (a -> b) -> TypeVal a
 104 argType _ = typeVal
 105
 106
 107 -- | The result type of a function
 108 resType :: (a -> b) -> TypeVal b
 109 resType _ = typeVal
 110
 111
 112 -- | The parameter type of type constructor
 113 paraType :: t a -> TypeVal a
 114 paraType _ = typeVal
 115
 116
 117 -- Type functions,
 118 -- i.e., functions mapping types to values
 119 --
 120 type TypeFun a r = TypeVal a -> r
 121
 122
 123
 124 -- Generic type functions,
 125 -- i.e., functions mapping types to values
 126 --
 127 type GTypeFun r  = forall a. Data a => TypeFun a r
 128
 129
 130
 131 ------------------------------------------------------------------------------
 132 --
 133 --      Generic operations to reify terms
 134 --
 135 ------------------------------------------------------------------------------
 136
 137
 138 -- | Count the number of immediate subterms of the given term
 139 glength :: GenericQ Int
 140 glength = length . gmapQ (const ())
 141
 142
 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)
 146
 147
 148 -- | Determine the number of all nodes in a given term
 149 gnodecount :: GenericQ Int
 150 gnodecount = gcount (const True)
 151
 152
 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))
 156
 157
 158
 159 ------------------------------------------------------------------------------
 160 --
 161 --      Generic operations to reify types
 162 --
 163 ------------------------------------------------------------------------------
 164
 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
 168
 169
 170 --
 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.
 175 --
 176 typeReachableFrom :: (Data a, Data b) => TypeVal a -> TypeVal b -> Bool
 177 typeReachableFrom (a::TypeVal a) (b::TypeVal b) =
 178   or ( sameType a b
 179      : map (recurse . fromConstr) (dataTypeCons $ dataTypeOf b)
 180      )
 181   where
 182
 183     -- See if a is reachable from immediate subterms of a kind of b
 184     recurse :: b -> Bool
 185     recurse = or
 186             . gmapQ ( typeReachableFrom a
 187                     . typeValOf
 188                     )