Safe Haskell | None |
---|
This is the code for "Template Your Boilerplate" under review at the Haskell Symposium 2012.
A draft copy of that paper is available at http://cs.pdx.edu/~adamsmic/projects/tyb/TYB.pdf and provides more thorough documentation.
- thcase :: Quasi m => (m Exp -> [(Type, m Exp)] -> m Exp) -> m Type -> m Exp
- thcase' :: Quasi m => (Either Name (Name, [(Type, Name)]) -> m Exp) -> m Type -> m Exp
- thfoldl :: Quasi m => (m Exp -> Type -> m Exp -> m Exp) -> (m Exp -> m Exp) -> m Type -> m Exp
- thmapT :: Quasi m => (Type -> m Exp) -> m Type -> m Exp
- thmapM :: Quasi m => (Type -> m Exp) -> m Type -> m Exp
- thmapQ :: Quasi m => (Type -> m Exp) -> m Type -> m Exp
- thmapQl :: Quasi m => m Exp -> m Exp -> (Type -> m Exp) -> m Type -> m Exp
- thmapQr :: Quasi m => m Exp -> m Exp -> (Type -> m Exp) -> m Type -> m Exp
- memoizeDec :: (Quasi m, Ord a) => ((a -> m Exp) -> a -> m Exp) -> a -> m ([Dec], Exp)
- memoizeDec2 :: (Quasi m, Ord a, Ord b) => ((a -> m Exp) -> (b -> m Exp) -> a -> m Exp) -> ((a -> m Exp) -> (b -> m Exp) -> b -> m Exp) -> a -> m ([Dec], Exp)
- memoizeExp :: (Quasi m, Ord a) => ((a -> m Exp) -> a -> m Exp) -> a -> m Exp
- memoizeExp2 :: (Quasi m, Ord a, Ord b) => ((a -> m Exp) -> (b -> m Exp) -> a -> m Exp) -> ((a -> m Exp) -> (b -> m Exp) -> b -> m Exp) -> a -> m Exp
- everywhere :: Quasi m => (Type -> m Exp) -> m Type -> m Exp
- everywhere' :: Quasi m => (Type -> m Exp) -> m Type -> m Exp
- everywhereBut :: Quasi m => (Type -> m Bool) -> (Type -> m Exp) -> m Type -> m Exp
- everywhereM :: Quasi m => (Type -> m Exp) -> m Type -> m Exp
- everywhereM' :: Quasi m => (Type -> m Exp) -> m Type -> m Exp
- everywhereButM' :: Quasi m => (Type -> m Bool) -> (Type -> m Exp) -> m Type -> m Exp
- everywhereFor :: Quasi m => Name -> m Type -> m Exp
- everywhereForM :: Quasi m => Name -> m Type -> m Exp
- somewhere :: Quasi m => ((Type -> m Exp) -> Type -> m (Maybe Exp)) -> m Type -> m Exp
- somewhereM :: Quasi m => ((Type -> m Exp) -> Type -> m (Maybe Exp)) -> m Type -> m Exp
- everything :: Quasi m => m Exp -> (Type -> m Exp) -> m Type -> m Exp
- everythingBut :: Quasi m => m Exp -> (Type -> m (Exp, Bool)) -> m Type -> m Exp
- everythingAccL :: (Type -> Q Exp) -> Q Type -> Q Exp
- everythingAccL' :: (Type -> Q Exp) -> Q Type -> Q Exp
- everythingButAccL :: (Type -> Q (Exp, Bool)) -> Q Type -> Q Exp
- everythingButAccL' :: (Type -> Q (Exp, Bool)) -> Q Type -> Q Exp
- everythingAccR :: (Type -> Q Exp) -> Q Type -> Q Exp
- everythingButAccR :: (Type -> Q (Exp, Bool)) -> Q Type -> Q Exp
- everythingForR :: Name -> Q Type -> Q Exp
- everythingForL :: Name -> Q Type -> Q Exp
- everythingForL' :: Name -> Q Type -> Q Exp
- extN :: Quasi m => (Type -> m Exp) -> Name -> Type -> m Exp
- extE :: Quasi m => (Type -> m exp) -> (Type -> m Bool, m exp) -> Type -> m exp
- extE' :: Quasi m => (Type -> m exp) -> (Type -> m Bool, Type -> m exp) -> Type -> m exp
- mkT :: Quasi m => Name -> Type -> m Exp
- mkTs :: Quasi m => [Name] -> Type -> m Exp
- mkQ :: Quasi m => m Exp -> Name -> Type -> m Exp
- mkQs :: Quasi m => m Exp -> [Name] -> Type -> m Exp
- mkM :: Quasi m => Name -> Type -> m Exp
- mkMs :: Quasi m => [Name] -> Type -> m Exp
- eqType :: Quasi m => m Type -> Type -> m Bool
- eqTypes :: Quasi m => [m Type] -> Type -> m Bool
- inType :: Quasi m => m Type -> Type -> m Bool
- inTypes :: Quasi m => [m Type] -> Type -> m Bool
- constructorsOf :: Quasi m => Type -> m (Maybe [(Name, [Type])])
- typeOfName :: Quasi m => Name -> m Type
Primitives
:: Quasi m | |
=> (m Exp -> [(Type, m Exp)] -> m Exp) | Case handling function. The first argument is the constructor. The second argument is the list of arguments and their types. |
-> m Type | The type to inspect. |
-> m Exp | The expression containing the |
Case expression generation. This is the core function of the Template Your Boilerplate library.
This function is similar to thcase'
, except that since most users
will note care about the distinction between types and primitive
types, this function smooths over the differences by treating primitive
types as types with nullary constructors.
:: Quasi m | |
=> (Either Name (Name, [(Type, Name)]) -> m Exp) | Case handling function. If the |
-> m Type | The type to inspect. |
-> m Exp | The expression containing the |
Primitive case expression generation. Most users will want to use
thcase
instead.
:: Quasi m | |
=> (m Exp -> Type -> m Exp -> m Exp) | Constructor argument application. If the first |
-> (m Exp -> m Exp) | Constructor injection. The argument |
-> m Type | The type to inspect. |
-> m Exp | The expression containing the |
Scrap Your Boilerplate style case expression generation. The
thcase
function is generally simpler to use instead of this and
is more powerful.
Single-layer traversals
:: Quasi m | |
=> (Type -> m Exp) | The transformation. If the |
-> m Type -> m Exp | Generates an |
Generic single-layer transformation
:: Quasi m | |
=> (Type -> m Exp) | The monadic transformation. If the |
-> m Type -> m Exp | Generates an |
Generic single-layer monadic transformation.
:: Quasi m | |
=> (Type -> m Exp) | The query. Extracts data from the given
type. If the |
-> m Type -> m Exp | Generates an |
Generic single-layer query.
:: Quasi m | |
=> m Exp | Combining function. |
-> m Exp | Starting value. |
-> (Type -> m Exp) | The query. Extract data from the given
type. If the |
-> m Type -> m Exp | Generates an |
Generic single-layer query (left associative).
:: Quasi m | |
=> m Exp | Combining function. |
-> m Exp | Starting value. |
-> (Type -> m Exp) | The query. Extract data from the given
type. If the |
-> m Type -> m Exp | Generates an |
Generic single-layer query (right associative).
Memoization
:: (Quasi m, Ord a) | |
=> ((a -> m Exp) -> a -> m Exp) | The function to memoize. Takes a memoized version of the function as argument. |
-> a | The initial argument to the function. |
-> m ([Dec], Exp) | The result of applying the
function to the initial argument.
The |Exp| is the result, but
expects the |
Memoizes a code generation function. Most users will want to use
memoizeExp
instead as it provides a simplified interface, but all
the notes about this function also apply to memoizeExp
.
We memoize a function returning an Exp
by creating a Dec
with a
body that is the Exp
returned by that function. The return value
of the function is replaced with a VarE
that refers to the Dec
.
This allows functions like everywhere
to avoid infinite
recursions when they traverse recursive types like lists.
The memoization functions come in two flavors: memoizeDec
and
memoizeExp
. With memoizeDec
it is the responsibility of the
caller to place the Dec
in an appropriate place. The
memoizeExp
function automatically handles the Dec
by wrapping
them in a local LetE
form.
Every memoized function is passed a memoized version of itself. This is the function that should be used in recursive calls. Failing to do so will prevent those calls from being memoized.
Mutually recursive functions are possible using memoizeDec2
,
etc. and memoizeExp2
, etc.
If the function being memoized needs to accept multiple arguments, then they must be packed into a tuple and passed as a single argument.
Effects in the m
monad are only performed the first time the
memoized function is called with a particular argument. Subsequent
times the monad is simply the result of a return
. Thus while it
is tempting to store extra return values in the monad, this should
be avoided due to the high likelihood of unexpected behavior.
Implementation Notes:
- Note that
m
should not store a copy of the function, otherwise a memory leak is introduced. It wouldn't even make sense to do it anyway since the results refer to expressions that might not be in scope. - The memoized function stores a reference to the memoization
table, Thus if a reference to the memoized function gets tucked
inside
m
, then a memory leak can be introduced. We could eliminate this leak by clearing and invalidating the table whenmemoizeDec
returns. To fully do this properly the table would have to be invalidated in such a way that the memoized version of the function would not continue to try populating the table if the user called it aftermemoizeDec
return. - Conceptually we should use a State monad instead of an IORef but
we choose IORef since we can embed IO operations in a Quasi
without imposing extra restrictions on
m
. - Other designs are possible. This design was choosen for its simplicity of use. The choice of memoization interface is largely orthogonal to the rest of this library.
- Type synonyms and kind annotations may lead to duplicate versions
of the code (e.g. versions for both
String
and[
) Usually this isn't a problem, but if it is, then the type synonyms should be expanded before each call to the memoized function.Char
] - GADTs and data/type families haven't been considered in this code. It is unknown whether they work.
Note that polymorphically recursive types (e.g. data F a = N a | F (F
(Int, a))
) have an infinite number of types in them and thus despite
memoization this function will not terminate on those types.
:: (Quasi m, Ord a, Ord b) | |
=> ((a -> m Exp) -> (b -> m Exp) -> a -> m Exp) | The first function to memoize. Takes memoized versions of the two functions as arguments. |
-> ((a -> m Exp) -> (b -> m Exp) -> b -> m Exp) | The second function to memoize. Takes memoized versions of the two functions as arguments. |
-> a | The initial argument. |
-> m ([Dec], Exp) | The result of applying the function to the
initial argument. The |Exp| is the result, but
expects the |
Simultaneously memoizes two code generation functions. All of
the notes about memoizeDec
also apply to this function. Most
users will want to use memoizeExp2
instead of this function as it
provides a simplified interface.
memoizeExp :: (Quasi m, Ord a) => ((a -> m Exp) -> a -> m Exp) -> a -> m ExpSource
Memoizes a code generation function. Behaves identically to
memoizeDec
except that it returns a LetE
that binds the Dec
resulting from memoizeDec
for the Exp
resulting from
memoizeDec
.
memoizeExp2 :: (Quasi m, Ord a, Ord b) => ((a -> m Exp) -> (b -> m Exp) -> a -> m Exp) -> ((a -> m Exp) -> (b -> m Exp) -> b -> m Exp) -> a -> m ExpSource
Simultaneously memoizes two code generation functions. Behaves
identically to memoizeDec2
except that it returns a LetE
that
binds the Dec
resulting from memoizeDec2
for the Exp
resulting from memoizeDec2
.
Traversals
Transformations
:: Quasi m | |
=> (Type -> m Exp) | The transformation. If the |
-> m Type -> m Exp | Generates an |
Generic recursive transformation (bottom-up)
:: Quasi m | |
=> (Type -> m Exp) | The transformation. If the |
-> m Type -> m Exp | Generates an |
Generic recursive transformation (top-down)
:: Quasi m | |
=> (Type -> m Bool) | The query. Should return |
-> (Type -> m Exp) | The transformation. If the |
-> m Type -> m Exp | Generates an |
Generic recursive transformation (bottom-up) with selective traversal.
Skips traversal when a given query returns True
.
:: Quasi m | |
=> (Type -> m Exp) | The monadic transformation. If the |
-> m Type -> m Exp | Generates an |
Generic recursive monadic transformation (bottom-up)
:: Quasi m | |
=> (Type -> m Exp) | The monadic transformation. If the |
-> m Type -> m Exp | Generates an |
Generic recursive monadic transformation (top-down)
:: Quasi m | |
=> (Type -> m Bool) | The query. Should return |
-> (Type -> m Exp) | The monadic transformation. If the |
-> m Type -> m Exp | Generates an |
Generic recursive monadic transformation (top-down) with selective traversal.
Skips traversal when a given query returns True
.
:: Quasi m | |
=> Name | Name of a function of type |
-> m Type -> m Exp | Generates an |
Generic recursive transformation (bottom-up) with selective traversal. Recurs on only types that can contain a type with type specific behavior.
:: Quasi m | |
=> Name | Name of a function of type |
-> m Type -> m Exp | Generates an |
Generic recursive monadic transformation (bottom-up) with selective traversal. Recurs on only types that can contain a type with type specific behavior.
:: Quasi m | |
=> ((Type -> m Exp) -> Type -> m (Maybe Exp)) | The transformation. The first argument is the memoized
recursion. If We use |
-> m Type -> m Exp | Generates an |
Generic recursive transformation (bottom-up) with selective traversal.
:: Quasi m | |
=> ((Type -> m Exp) -> Type -> m (Maybe Exp)) | The monadic transformation. The first argument is the memoized
recursion. If We use |
-> m Type -> m Exp | Generates an |
Generic recursive monadic transformation (bottom-up) with selective traversal.
Queries
:: Quasi m | |
=> m Exp | Combining function. |
-> (Type -> m Exp) | The query. Extract data from the given
type. If the |
-> m Type -> m Exp | Generates an |
Generic recursive query (bottom-up).
:: Quasi m | |
=> m Exp | Combining function. |
-> (Type -> m (Exp, Bool)) | The query, combining, selectivity function. If the |
-> m Type -> m Exp | Generates an |
Generic recursive query with selective traversal
:: (Type -> Q Exp) | The query and combining function. If the
|
-> Q Type -> Q Exp | Generates an |
Generic recursive query with left-associative accumulation.
:: (Type -> Q Exp) | The query and combining function. If the
|
-> Q Type -> Q Exp | Generates an |
Generic recursive query with strict left-associative accumulation
:: (Type -> Q (Exp, Bool)) | The query, combining, selectivity function. If the |
-> Q Type -> Q Exp | Generates an |
Generic recursive query with left-associative accumulation and selective traversal
:: (Type -> Q (Exp, Bool)) | The query, combining, selectivity function. If the |
-> Q Type -> Q Exp | Generates an |
Generic recursive query with strict left-associative accumulation and selective traversal
:: (Type -> Q Exp) | The query and combining function. If the
|
-> Q Type -> Q Exp | Generates an |
Generic recursive query with right-associative accumulation
:: (Type -> Q (Exp, Bool)) | The query, combining, selectivity function. If the |
-> Q Type -> Q Exp | Generates an |
Generic recursive query with right-associative accumulation and selective traversal
:: Name | Name of a function of type |
-> Q Type -> Q Exp | Generates an |
Generic recursive traversal using right-associative accumulation
:: Name | Name of a function of type |
-> Q Type -> Q Exp | Generates an |
Generic recursive traversal using left-associative accumulation
:: Name | Name of a function of type |
-> Q Type -> Q Exp | Generates an |
Generic recursive traversal using strict left-associative accumulation
Extentions and adaptors
:: Quasi m | |
=> (Type -> m Exp) | The operation to be extended. |
-> Name | Name of the function implementing the type specific behavior. |
-> Type -> m Exp | The result of extending the operation. If the |
Extends a generic operation with type specific behavior based on the type of the given name.
:: Quasi m | |
=> (Type -> m exp) | The operation to be extended. |
-> (Type -> m Bool, m exp) | The |
-> Type -> m exp | The result of extending the operation. |
Extends a generic operation with type specific behavior.
:: Quasi m | |
=> (Type -> m exp) | The operation to be extended. |
-> (Type -> m Bool, Type -> m exp) | The |
-> Type -> m exp | The result of extending the operation. |
Extends a generic operation with type specific behavior.
:: Quasi m | |
=> Name | Name of a function of type |
-> Type -> m Exp | The generic transformation. If the |
Makes a transformation from a named function.
:: Quasi m | |
=> [Name] | Names of functions of type |
-> Type -> m Exp | The generic transformation. If the |
Makes a transformation from several named functions.
:: Quasi m | |
=> m Exp | Default value to return on types other than |
-> Name | Name of a function of type |
-> Type -> m Exp | The generic transformation. If the |
Makes a query from a named function.
:: Quasi m | |
=> m Exp | Default value to return on types that do not
match the |
-> [Name] | Names of functions of type |
-> Type -> m Exp | The generic query. If the |
Makes a query from several named functions.
:: Quasi m | |
=> Name | Name of a function of type |
-> Type -> m Exp | The generic monadic transformation. If the |
Makes a monadic transformation from a named function.
:: Quasi m | |
=> [Name] | Names of functions of type |
-> Type -> m Exp | The generic monadic transformation. If the |
Makes a monadic transformation from several named functions.
Type manipulation functions
eqTypes :: Quasi m => [m Type] -> Type -> m BoolSource
Test if any of a list of types is equal to a particular type modulo type synonyms and kind annotations. Useful when multiple types share the same type-specific behavior.
inType :: Quasi m => m Type -> Type -> m BoolSource
inType t1 t2 = True
iff t1
is (even recursively) inside t2
inTypes :: Quasi m => [m Type] -> Type -> m BoolSource
inTypes ts t2 = True
iff any of ts
is (even recursively) inside t2
constructorsOf :: Quasi m => Type -> m (Maybe [(Name, [Type])])Source
Returns the constructors of a given type.
Returns Nothing
if the type is primitive.
typeOfName :: Quasi m => Name -> m TypeSource
Returns the type of a variable, method or constructor name.