 | MagicHaskeller-0.8.3: Automatic inductive functional programmer by systematic search | Contents | Index |
|
|
|
|
|
|
Synopsis |
|
|
|
|
Re-exported modules
|
|
This library implicitly re-exports the entities from
module Language.Haskell.TH as TH and module Data.Typeable from the Standard Hierarchical Library of Haskell.
Please refer to their documentations on types from them --- in this documentation, types from TH are all qualified and the only type used from module Typeable is Typeable.Typeable. Other types you had never seen should be our internal representation.
|
|
Setting up your synthesis
|
|
Before synthesis, you have to define at least one program generator algorithm (or you may define one once and reuse it for later syntheses).
Other parameters are memoization depth and time out interval, which have default values.
You may elect either to set those values to the 'global variables' using 'set*' functions (i.e. functions whose names are prefixed by set), or hand them explicitly as parameters.
|
|
Class for program generator algorithms
|
|
class ProgramGenerator a |
ProgramGenerator is a generalization of the old Memo type.
| | Instances | |
|
|
Functions for creating your program generator algorithm
|
|
You can set your primitives like, e.g., setPrimitives $(p [| ( (+) :: Int->Int->Int, 0 :: Int, 'A', [] :: [a] ) |]),
where the primitive set is consisted of (+) specialized to type Int->Int->Int, 0 specialized to type Int,
'A' which has monomorphic type Char, and [] with polymorphic type [a].
As primitive components one can include any variables and constructors within the scope.
However, because currently ad hoc polymorphism is not supported by this library, you may not write
setPrimitives $(p [| (+) :: Num a => a->a->a |]).
Also, you have to specify the type unless you are using a monomorphic component
(just like when using the dynamic expression of Concurrent Clean), and thus
you may write setPrimitives $(p [| 'A' |]),
while you have to write setPrimitives $(p [| [] :: [a] |]) instead of setPrimitives $(p [| [] |]).
|
|
p |
:: ExpQ | Quasi-quote a tuple of primitive components here.
| -> ExpQ | This becomes [Primitive] when spliced.
| p is used to convert your primitive component set into the internal form.
|
|
|
setPrimitives :: [Primitive] -> IO () |
setPrimitives = setPG . mkPG
|
|
mkPG :: ProgramGenerator pg => [Primitive] -> pg |
|
mkPGSF |
:: ProgramGenerator pg | | => [Int] | number of random samples at each depth, for each type.
| -> [Primitive] | | -> [Primitive] | | -> pg | | mkPGSF is used instead of mkPG when the search should be fine-tuned. This function is defined only for the ProgramGenerators whose names end with SF (i.e., generators with synergetic filtration).
For such generators, mkPG is defined as:
mkPG prims = mkPGSF (repeat 5) prims prims
|
|
|
setPG :: ProgGen -> IO () |
|
Older versions prohibited data types holding functions such as [a->b], (Int->Char, Bool), etc. just for efficiency reasons.
They are still available if you use mkMemo and mkMemoSF instead of mkPG and mkPGSF respectively, though as for ConstrL and ConstrLSF this limitation does not affect the efficiency a lot.
|
|
mkMemo :: ProgramGenerator pg => [Primitive] -> pg |
|
mkMemoSF |
|
|
Memoization depth
|
|
setDepth |
:: Int | memoization depth. (Sub)expressions within this size are memoized, while greater expressions will be recomputed (to save the heap space).
| -> IO () | |
|
|
Time out
|
|
Because the library generates all the expressions including those with non-linear recursions, you should note that there exist some expressions which take extraordinarily long time. (Imagine a function that takes an integer n and increments 0 for 2^(2^n) times.)
For this reason, time out is taken after 0.02
second since each invocation of evaluation by default. This default behavior can
be overridden by the following functions.
|
|
setTimeout |
:: Int | time in microseconds
| -> IO () | | setTimeout sets the timeout in microseconds. Also, my implementation of timeout also catches inevitable exceptions like stack space overflow. Note that setting timeout makes the library referentially untransparent. (But currently setTimeout 20000 is the default!)
|
|
|
unsetTimeout :: IO () |
unsetTimeout disables timeout. This is the safe choice.
|
|
Defining functions automatically
|
|
In this case "automatically" does not mean "inductively" but "deductively using Template Haskell";)
|
|
define :: Name -> String -> Integer -> ExpQ -> Q [Dec] |
define eases use of this library by automating some function definitions. For example,
$( define ''ProgGen "Foo" 15 (p [| (1 :: Int, (+) :: Int -> Int -> Int) |]) )
is equivalent to
memoFoo :: ProgGen
memoFoo = mkPG (p [| (1 :: Int, (+) :: Int -> Int -> Int) |])
everyFoo :: Everything
everyFoo = everything 15 memoFoo
filterFoo :: Filter
filterFoo pred = filterThen pred everyFoo
If you do not think this function reduces the number of your keystrokes a lot, you can do without it.
|
|
type Everything = Typeable a => Every a |
|
type Filter = Typeable a => (a -> Bool) -> IO (Every a) |
|
type Every a = [[(Exp, a)]] |
|
Generating programs
|
|
(There are many variants, but most of the functions here just filter everything with the predicates you provide.)
Functions suffixed with "F" (like everythingF, etc.) are filtered versions, where their results are filtered to totally remove semantic duplications.
(Note that this is filtration AFTER the program generation, unlike the filtration by using ProgGenSF is done DURING program generation.)
|
|
Quick start
|
|
findOne :: Typeable a => (a -> Bool) -> Exp |
findOne pred finds an expression e that satisfies pred e == True, and returns it in Exp.
|
|
printOne :: Typeable a => (a -> Bool) -> IO () |
printOne prints the expression found first.
|
|
printAny :: Typeable a => (a -> Bool) -> IO () |
printAny prints all the expressions satisfying the given predicate.
|
|
Incremental filtration
|
|
Sometimes you may want to filter further after synthesis, because the predicate you previously provided did not specify
the function enough. The following functions can be used to filter expressions incrementally.
|
|
filterFirst :: Typeable a => (a -> Bool) -> IO (Every a) |
filterFirst is like printAny, but by itself it does not print anything. Instead, it creates a stream of expressions represented in tuples of Exp and the expressions themselves.
|
|
filterFirstF :: Typeable a => (a -> Bool) -> IO (Every a) |
|
filterThen :: Typeable a => (a -> Bool) -> Every a -> IO (Every a) |
filterThen may be used to further filter the results.
|
|
Expression generators
|
|
These functions generate all the expressions that have the type you provide.
|
|
getEverything :: Typeable a => IO (Every a) |
getEverything uses the 'global' values set with set* functions. getEverythingF is its filtered version
|
|
everything |
:: (ProgramGenerator pg, Typeable a) | | => Int | memoization depth.
| -> pg | program generator
| -> Every a | | everything generates all the expressions that fit the inferred type, and their representations in the Exp form.
It returns a stream of lists, which is equivalent to Spivey's Matrix data type, i.e., that contains expressions consisted of n primitive components at the n-th element (n = 1,2,...).
everythingF is its filtered version
|
|
|
unifyable |
:: ProgramGenerator pg | | => Int | memoization depth
| -> pg | program generator
| -> Type | query type
| -> [[Exp]] | |
|
|
matching |
:: ProgramGenerator pg | | => Int | memoization depth
| -> pg | program generator
| -> Type | query type
| -> [[Exp]] | |
|
|
getEverythingF :: Typeable a => IO (Every a) |
|
everythingF |
|
|
unifyableF |
:: ProgramGenerator pg | | => Int | memoization depth
| -> pg | program generator
| -> Type | query type
| -> [[Exp]] | |
|
|
matchingF |
:: ProgramGenerator pg | | => Int | memoization depth
| -> pg | program generator
| -> Type | query type
| -> [[Exp]] | | Those functions are like everything, but take Type as an argument, which may be polymorphic.
For example, printQ ([t| forall a. a->a->a |] >>= return . unifyable True 10 memo) will print all the expressions using memo whose types unify with forall a. a->a->a.
(At first I (Susumu) could not find usefulness in finding unifyable expressions, but seemingly Hoogle does something alike, and these functions might enhance it.)
|
|
|
Pretty printers
|
|
pprs :: Every a -> IO () |
pprs pretty prints the results to the console, using pprint
|
|
printQ :: Ppr a => Q a -> IO () |
|
Internal data representation
|
|
The following types are assigned to our internal data representations.
|
|
type Primitive = (HValue, Exp, Type) |
|
newtype HValue |
|
|
Produced by Haddock version 0.8 |