MagicHaskeller-0.8.3: Automatic inductive functional programmer by systematic searchContentsIndex
MagicHaskeller
Contents
Re-exported modules
Setting up your synthesis
Class for program generator algorithms
Functions for creating your program generator algorithm
Memoization depth
Time out
Defining functions automatically
Generating programs
Quick start
Incremental filtration
Expression generators
Pretty printers
Internal data representation
Synopsis
class ProgramGenerator a
p :: ExpQ -> ExpQ
setPrimitives :: [Primitive] -> IO ()
mkPG :: ProgramGenerator pg => [Primitive] -> pg
mkPGSF :: ProgramGenerator pg => [Int] -> [Primitive] -> [Primitive] -> pg
setPG :: ProgGen -> IO ()
mkMemo :: ProgramGenerator pg => [Primitive] -> pg
mkMemoSF :: ProgramGenerator pg => [Int] -> [Primitive] -> [Primitive] -> pg
setDepth :: Int -> IO ()
setTimeout :: Int -> IO ()
unsetTimeout :: IO ()
define :: Name -> String -> Integer -> ExpQ -> Q [Dec]
type Everything = Typeable a => Every a
type Filter = Typeable a => (a -> Bool) -> IO (Every a)
type Every a = [[(Exp, a)]]
findOne :: Typeable a => (a -> Bool) -> Exp
printOne :: Typeable a => (a -> Bool) -> IO ()
printAny :: Typeable a => (a -> Bool) -> IO ()
filterFirst :: Typeable a => (a -> Bool) -> IO (Every a)
filterFirstF :: Typeable a => (a -> Bool) -> IO (Every a)
filterThen :: Typeable a => (a -> Bool) -> Every a -> IO (Every a)
getEverything :: Typeable a => IO (Every a)
everything :: (ProgramGenerator pg, Typeable a) => Int -> pg -> Every a
unifyable :: ProgramGenerator pg => Int -> pg -> Type -> [[Exp]]
matching :: ProgramGenerator pg => Int -> pg -> Type -> [[Exp]]
getEverythingF :: Typeable a => IO (Every a)
everythingF :: (ProgramGenerator pg, Typeable a) => Int -> pg -> Every a
unifyableF :: ProgramGenerator pg => Int -> pg -> Type -> [[Exp]]
matchingF :: ProgramGenerator pg => Int -> pg -> Type -> [[Exp]]
pprs :: Every a -> IO ()
printQ :: Ppr a => Q a -> IO ()
type Primitive = (HValue, Exp, Type)
newtype HValue = HV (forall a . a)
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.
show/hide 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
:: ExpQQuasi-quote a tuple of primitive components here.
-> ExpQThis 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
:: ProgramGenerator pg
=> [Int]number of random samples at each depth, for each type.
-> [Primitive]
-> [Primitive]
-> pg
Memoization depth
setDepth
:: Intmemoization 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
:: Inttime 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)
=> Intmemoization depth.
-> pgprogram 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
=> Intmemoization depth
-> pgprogram generator
-> Typequery type
-> [[Exp]]
matching
:: ProgramGenerator pg
=> Intmemoization depth
-> pgprogram generator
-> Typequery type
-> [[Exp]]
getEverythingF :: Typeable a => IO (Every a)
everythingF
:: (ProgramGenerator pg, Typeable a)
=> Intmemoization depth.
-> pgprogram generator
-> Every a
unifyableF
:: ProgramGenerator pg
=> Intmemoization depth
-> pgprogram generator
-> Typequery type
-> [[Exp]]
matchingF
:: ProgramGenerator pg
=> Intmemoization depth
-> pgprogram generator
-> Typequery 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
Constructors
HV (forall a . a)
Produced by Haddock version 0.8