path: root/final_project/paper/bnewbold_lch_report_draft.lyx

#LyX 1.4.3 created this file. For more info see http://www.lyx.org/
\lyxformat 245
\begin_document
\begin_header
\textclass article
\language english
\inputencoding auto
\fontscheme default
\graphics default
\paperfontsize default
\spacing single
\papersize default
\use_geometry true
\use_amsmath 1
\cite_engine basic
\use_bibtopic false
\paperorientation portrait
\rightmargin 3.5cm
\secnumdepth -1
\tocdepth 3
\paragraph_separation indent
\defskip medskip
\quotes_language english
\papercolumns 1
\papersides 1
\paperpagestyle default
\tracking_changes false
\output_changes false
\end_header

\begin_body

\begin_layout Title
Generic Operator Discovery:
\newline

\emph on
10,000 Monkeys with 10,000 Lambdas
\end_layout

\begin_layout Date
\begin_inset Formula $\today$
\end_inset


\end_layout

\begin_layout Author
Laura Harris and Bryan Newbold for 6.945
\newline
{lch,bnewbold}@mit.edu
\end_layout

\begin_layout Abstract
We have implemented a simple system which enables the discovery and exploration
 of generic operators and brute force predicate satisfaction.
 Our procedures build on top of existing predicate-based operator dispatch
 databases; this allows existing code to be reused in useful and unexpected
 ways.
 In this write up we describe our code, give a few simple demonstrations
 (including one with a native graphic user interface), and mention some
 potential applications.
\end_layout

\begin_layout Standard
\begin_inset LatexCommand \tableofcontents{}

\end_inset


\end_layout

\begin_layout Section
Generic Operator Discovery System
\end_layout

\begin_layout Standard
The normal purpose of a generic operator dispatch system is to allow the
 programmer or user to use a single operator with many different object
 types or combinations of object types.
 Mature libraries and codebases may have dozens of generic operators defined
 for domain-specific data structures; these generic operations often represent
 the core functionality offered by the system.
 For large systems, those with which the user is unfamiliar, or those with
 poor documentation, it can be daunting to find the operation desired.
 By using 
\begin_inset Quotes eld
\end_inset

operator discovery
\begin_inset Quotes erd
\end_inset

 techniques, the operator dispatch system can be reverse engineered to find
 all of the generic operations which can be applied to given arguments.
 In addition to facilitating user exploration, these techniques can be used
 to improve the robustness of computing systems, as part of automated problem
 solving, as a testing tool, and for the automated generation of higher
 level programs.
\end_layout

\begin_layout Standard
The generic operator system we have built upon uses predicate dispatch;
 for an overview of this strategy see Ernst, Kaplan, and Chamber's paper
 
\begin_inset Quotes eld
\end_inset

Predicate dispatching: A unified theory of dispatch
\begin_inset Quotes erd
\end_inset

 (1998).
 The version we used for MIT/GNU Scheme was distributed by the 6.945 staff
 and is included in the appendix as 
\family typewriter
ghelper.scm
\family default
.
 The exact same dispatch system is used in the 
\family typewriter
scmutils
\family default
 classical mechanics software package, which allowed us to experiment with
 an existing software system.
\end_layout

\begin_layout Section
Implementation
\end_layout

\begin_layout Standard
For examples and demonstrations of the system, see the applications section
 and the file 
\family typewriter
discovery-examples.scm
\family default
 in the appendix.
\end_layout

\begin_layout Subsection
Review of Predicate Dispatch
\end_layout

\begin_layout Standard
Predicate dispatch works by choosing the first 
\emph on
handler
\emph default
 whose associated 
\emph on
predicates
\emph default
 all return true for a given set of arguments; a list of predicate/handler
 pairs is stored in a tree structure for each generic operator.
\end_layout

\begin_layout Standard
A few crucial procedures, globals, and data structures are defined in 
\family typewriter
ghelper.scm:
\end_layout

\begin_layout Paragraph*
*generic-operator-table*
\end_layout

\begin_layout Standard
This is the global table of generic operators.
 It is an 
\family typewriter
eq-hash
\family default
 table which associates operator record 
\emph on
keys
\emph default
 (which define the arity) with predicate/handler tree 
\emph on
values
\emph default
.
 In addition, for 
\begin_inset Quotes eld
\end_inset

named
\begin_inset Quotes erd
\end_inset

 operators, the symbol representing an operator is added as a second 
\emph on
key
\emph default
 pointing at the same predicate/handler tree 
\emph on
value
\emph default
.
 
\end_layout

\begin_layout Paragraph*
(make-generic-operator arity default-operation #!optional name)
\end_layout

\begin_layout Standard
This procedure creates a new record in the 
\family typewriter
*generic-operator-table*
\family default
 for the given arity; it returns an operator procedure which is usually
 bound in the user's environment and when applied initiates the procedure
 dispatch process.
 If not null, the default-operation is bound (using assign-operation) as
 an any-argument-accepting default handler.
 If passed, the name (which should be a symbol) is bound as a redundant
 key in the 
\family typewriter
*generic-operator-table*
\family default
.

\series bold
 defhandler
\series default
 is an alias for make-generic-operator.
\end_layout

\begin_layout Paragraph*
(assign-operation operator handler .
 argument-predicates)
\end_layout

\begin_layout Standard
This procedure adds a new predicate/handler pair to an operator's tree in
 the 
\family typewriter
*generic-operator-table*
\family default
.
 The binding is done with 
\family typewriter
bind-in-tree
\family default
 (see below).
\end_layout

\begin_layout Paragraph*
(bind-in-tree keys handler tree)
\end_layout

\begin_layout Standard
This procedure simply adds a new handler (with the argument predicates 
\emph on
keys
\emph default
) in a given generic operator's dispatch 
\emph on
tree
\emph default
.
 
\end_layout

\begin_layout Subsection
Procedures
\end_layout

\begin_layout Standard
The actual implementations of these procedures can be found in the appendix.
\end_layout

\begin_layout Subsubsection*
(discover:opers-for .
 args)
\end_layout

\begin_layout Standard
This procedure returns all of the operators which can be applied to the
 arguments.
 The return value is a list of the keys from *generic-operator-table* which
 are associated with predicate/handler trees matching the arguments.
 This is the core of the discovery system.
\end_layout

\begin_layout Subsubsection*
(discover:named-opers-for .
 args)
\end_layout

\begin_layout Standard
This procedure is the same as discover:opers-for except that it only returns
 lookup keys which are symbols (thus the original operator record was defined
 with a name symbol).
 
\end_layout

\begin_layout Paragraph*
(discover:named-opers)
\end_layout

\begin_layout Standard
This procedure returns a list of 
\emph on
all
\emph default
 the 
\begin_inset Quotes eld
\end_inset

named
\begin_inset Quotes erd
\end_inset

 generic operators in the 
\family typewriter
*generic-operator-table*
\family default
 ; it is useful to determine the size of scope of an unknown software system.
\end_layout

\begin_layout Paragraph*
(discover:apply-name name .
 args)
\end_layout

\begin_layout Standard
This procedure allows 
\begin_inset Quotes eld
\end_inset

named
\begin_inset Quotes erd
\end_inset

 operator symbols to be treated like actual operator procedures: it initiates
 the dispatch process for the predicate/handler tree associated with 
\emph on
name
\emph default
 for the given 
\emph on
args
\emph default
.
 
\end_layout

\begin_layout Paragraph*
(discover:apply-all .
 args)
\end_layout

\begin_layout Standard
This procedure finds all of the operators which can act on the given args,
 then returns a list with the results of applying each of these operators.
\end_layout

\begin_layout Paragraph*
(discover:apply-all-name .
 args)
\end_layout

\begin_layout Standard
This is identical to 
\family typewriter
discover:apply-all
\family default
 except that it only applies 
\begin_inset Quotes eld
\end_inset

named
\begin_inset Quotes erd
\end_inset

 operators.
 
\end_layout

\begin_layout Paragraph*
(discover:satisfy pred? .
 args)
\end_layout

\begin_layout Standard
This procedure attempts to satisfy the given predicate by repeatedly applying
 all possible operators the arguments (and the return values of these applicatio
ns recursively).
 It operates as a breadth first search and returns the first matching return
 value.
\end_layout

\begin_layout Paragraph*
(discover:satisfy-sequence pred? .
 args)
\end_layout

\begin_layout Standard
This procedure is similar to 
\family typewriter
discover:satisfy
\family default
 except that it only applies 
\begin_inset Quotes eld
\end_inset

named
\begin_inset Quotes erd
\end_inset

 operators and it maintains a record of which operators were applied to
 obtain a given return value; it will also return all of the matching return
 values for a given 
\begin_inset Quotes eld
\end_inset

depth
\begin_inset Quotes erd
\end_inset

 of search.
\end_layout

\begin_layout Subsection
Room for improvement
\end_layout

\begin_layout Standard
The code for all of these procedures is rather ugly and complicated due
 to the crude data structures used: for example discover:satisfy-sequence
 has an internal variable to store potential solutions as a list with the
 first argument being a list of arguments (always a single element after
 the first application of operators) and all subsequent operators being
 a record of the operators applied to obtain those arguments.
 This could almost certainly be re-implemented in a more elegant functional
 style.
\end_layout

\begin_layout Standard
The predicate/handler tree format does not currently include a name symbol
 for the given operator.
 Perhaps the name symbol could also be determined by searching the environment
 bindings, but this does not seem like a great idea (search would be slow?).
\end_layout

\begin_layout Standard
Almost all of the implementations are ripe for trivial optimization: for
 example 
\family typewriter
discover:named-opers-for
\family default
 just filters the results of 
\family typewriter
discover:opers-for
\family default
; it could be much more efficient if it filtered out non-symbol operators
 earlier in the search process.
\end_layout

\begin_layout Section
Applications
\end_layout

\begin_layout Subsection
scmutils Package
\end_layout

\begin_layout Standard

\family typewriter
scmutils
\family default
 is an MIT/GNU Scheme package for math and physics, focused on classical
 mechanics
\begin_inset Foot
status collapsed

\begin_layout Standard
See http://groups.csail.mit.edu/mac/users/gjs/6946/linux-install.htm
\end_layout

\end_inset

.
 It uses the predicate dispatch system defined in 
\family typewriter
ghelper.scm
\family default
, so it is a natural candidate for experimentation with the discovery tools.
\end_layout

\begin_layout Standard
The default scmutils band file has over 90 generic operators; the named
 ones can be discovered:
\end_layout

\begin_layout Quotation

\family typewriter
(discover:named-opers) 
\end_layout

\begin_layout Quotation

\family typewriter
;Value: (+ one-like cos dot-product expt one? * gcd
\end_layout

\begin_layout Quotation

\family typewriter
partial-derivative acos exp atan2 cosh imag-part one = conjugate
\end_layout

\begin_layout Quotation

\family typewriter
zero? / zero-like abs sinh identity? sin asin derivative angle
\end_layout

\begin_layout Quotation

\family typewriter
magnitude inexact? type apply identity make-polar arity real-part -
\end_layout

\begin_layout Quotation

\family typewriter
invert negate identity-like trace determinant sqrt zero log square
\end_layout

\begin_layout Quotation

\family typewriter
make-rectangular type-predicate atan1)
\end_layout

\begin_layout Standard
The operators applicable on the 3x3 identity matrix are:
\end_layout

\begin_layout Quotation

\family typewriter
(discover:named-opers-for 
\end_layout

\begin_layout Quotation

\family typewriter
\InsetSpace ~
\InsetSpace ~
\InsetSpace ~
(matrix-by-rows '(1 0 0) '(0 1 0) '(0 0 1))) 
\end_layout

\begin_layout Quotation

\family typewriter
;Value: (one-like cos exp conjugate zero? zero-like identity? sin
\end_layout

\begin_layout Quotation

\family typewriter
inexact? type arity invert negate identity-like trace determinant
\end_layout

\begin_layout Quotation

\family typewriter
type-predicate)
\end_layout

\begin_layout Standard
The operators applicable for a single variable 
\begin_inset Formula $'a$
\end_inset

 are:
\end_layout

\begin_layout Quotation

\family typewriter
(discover:named-opers-for 'a) 
\end_layout

\begin_layout Quotation

\family typewriter
;Value: (one-like cos acos exp cosh imag-part conjugate zero-like
\end_layout

\begin_layout Quotation

\family typewriter
sinh sin asin angle magnitude inexact? type arity real-part invert
\end_layout

\begin_layout Quotation

\family typewriter
negate identity-like sqrt log type-predicate atan1)
\end_layout

\begin_layout Standard

\family typewriter
scmutils
\family default
 has special treatment for mathematical functions:
\end_layout

\begin_layout Quotation

\family typewriter
(discover:named-opers-for (compose sin cos)) 
\end_layout

\begin_layout Quotation

\family typewriter
;Value: (one-like cos acos exp cosh imag-part zero-like abs sinh
\end_layout

\begin_layout Quotation

\family typewriter
sin asin angle magnitude inexact? type arity real-part invert
\end_layout

\begin_layout Quotation

\family typewriter
negate identity-like sqrt log square type-predicate atan1)
\end_layout

\begin_layout Subsection
Other Applications
\end_layout

\begin_layout Standard
The discovery system combined with the predicate satisfaction search makes
 a very useful general purpose tool.
 Even when using such a simple system as Scheme, it can be difficult to
 remember the particular names of simple procedures.
 For instance, you might have list of hundreds of numbers and want to turn
 it into a vector, or a 20 digit floating point number that you want to
 print as a string: are the desired operations 
\family typewriter
list->vector
\family default
 and 
\family typewriter
number->string
\family default
? Are they generic 
\family typewriter
to-string
\family default
 and 
\family typewriter
to-vector
\family default
? You could read the documentation or search by hand through the bound procedure
s in the environment, or you could do a search with the predicates
\family typewriter
 vector?
\family default
 and 
\family typewriter
string?
\family default
.
 
\end_layout

\begin_layout Standard
With proper memoization and error catching, predicate satisfaction could
 be the basis for robust computing: if compiled code ever failed, the system
 could elegantly search for an alternative (perhaps much less efficient
 but still satisfactory) procedure from the system libraries or even among
 network peers in a network instead of halting computation and giving the
 user an error.
\end_layout

\begin_layout Section
A Graphical User Interface
\end_layout

\begin_layout Standard
\begin_inset Float figure
wide false
sideways false
status collapsed

\begin_layout Standard
\begin_inset Graphics
	filename /home/bnewbold/6.945/final_project/presentation/gui1.png
	width 6in
	keepAspectRatio

\end_inset


\end_layout

\begin_layout Caption
GUI Screenshot
\begin_inset LatexCommand \label{fig:Screenshot}

\end_inset


\end_layout

\end_inset


\end_layout

\begin_layout Standard
The graphical user interface (GUI) was implemented using a new foreign function
 interface (FFI) and GUI toolkit bindings for MIT/GNU Scheme written by
 Matt Birkholz
\begin_inset Foot
status collapsed

\begin_layout Standard
See http://birkholz.chandler.az.us/~matt/Scheme/
\end_layout

\end_inset

.
\end_layout

\begin_layout Standard
The GUI essentially displays a object (a collection of arguments) and allows
 the user to select an applicable operator from a drop down box.
 The result of this operation is then itself displayed as an object and
 the user can recursively select an operation for 
\emph on
that
\emph default
 object.
 Figure 
\begin_inset LatexCommand \ref{fig:Screenshot}

\end_inset

 shows a screenshot of the interface with a chain of example operations.
\end_layout

\begin_layout Subsection
Procedures
\end_layout

\begin_layout Standard
Most of the scheme GUI code is included in the appendix as 
\family typewriter
prhello.scm
\family default
; additional declaration and shim files were used for compilation but are
 not included.
\end_layout

\begin_layout Paragraph*
(discover:thunklist-for .
 args)
\end_layout

\begin_layout Standard
This is a special purpose function (in discover.scm) which creates a data
 structure (a list) containing both the passed arguments and a series of
 delayed thunks: each thunk is the application of an appropriate 
\begin_inset Quotes eld
\end_inset

named
\begin_inset Quotes erd
\end_inset

 generic operator on the arguments.
 Each thunk has the operator's name symbol attached.
\end_layout

\begin_layout Paragraph*
(discover-gui .
 args)
\end_layout

\begin_layout Standard
This generates the actual GUI for the given arguments.
 
\family typewriter
discover:thunklist-for
\family default
 generates the set of possible operators which are displayed as a pull-down
 list for the user: selecting an operator evaluates the thunk and calls
 
\family typewriter
discover-gui
\family default
 on the result.
\end_layout

\begin_layout Section
\start_of_appendix
Appendix: Code Listing
\begin_inset LatexCommand \label{sub:code}

\end_inset


\end_layout

\begin_layout Subsection
ghelper.scm
\end_layout

\begin_layout LyX-Code
;;; From 6.945 Staff, with minor edit by bnewbold (May 2009):
\end_layout

\begin_layout LyX-Code
;;; the optional name argument is handled in the style of
\end_layout

\begin_layout LyX-Code
;;; the scmutils implementation
\end_layout

\begin_layout LyX-Code

\end_layout

\begin_layout LyX-Code
;;;;           Most General Generic-Operator Dispatch
\end_layout

\begin_layout LyX-Code

\end_layout

\begin_layout LyX-Code
(declare (usual-integrations))
\end_layout

\begin_layout LyX-Code

\end_layout

\begin_layout LyX-Code
;;; Generic-operator dispatch is implemented here by a discrimination
\end_layout

\begin_layout LyX-Code
;;; list, where the arguments passed to the operator are examined by
\end_layout

\begin_layout LyX-Code
;;; predicates that are supplied at the point of attachment of a
\end_layout

\begin_layout LyX-Code
;;; handler (by ASSIGN-OPERATION).
\end_layout

\begin_layout LyX-Code
;;; To be the correct branch all arguments must be accepted by
\end_layout

\begin_layout LyX-Code
;;; the branch predicates, so this makes it necessary to
\end_layout

\begin_layout LyX-Code
;;; backtrack to find another branch where the first argument
\end_layout

\begin_layout LyX-Code
;;; is accepted if the second argument is rejected.
  Here
\end_layout

\begin_layout LyX-Code
;;; backtracking is implemented by OR.
\end_layout

\begin_layout LyX-Code

\end_layout

\begin_layout LyX-Code
(define (make-generic-operator arity default-operation #!optional name)
\end_layout

\begin_layout LyX-Code
  (let ((record (make-operator-record arity)))
\end_layout

\begin_layout LyX-Code
    (define (operator .
 arguments)
\end_layout

\begin_layout LyX-Code
      (if (not (= (length arguments) arity))
\end_layout

\begin_layout LyX-Code
          (error:wrong-number-of-arguments operator arity arguments))
\end_layout

\begin_layout LyX-Code
      (let ((succeed
\end_layout

\begin_layout LyX-Code
             (lambda (handler)
\end_layout

\begin_layout LyX-Code
               (apply handler arguments))))
\end_layout

\begin_layout LyX-Code
        (let per-arg
\end_layout

\begin_layout LyX-Code
            ((tree (operator-record-tree record))
\end_layout

\begin_layout LyX-Code
             (args arguments)
\end_layout

\begin_layout LyX-Code
             (fail
\end_layout

\begin_layout LyX-Code
              (lambda ()
\end_layout

\begin_layout LyX-Code
                (error:no-applicable-methods operator arguments))))
\end_layout

\begin_layout LyX-Code
          (let per-pred ((tree tree) (fail fail))
\end_layout

\begin_layout LyX-Code
            (cond ((pair? tree)
\end_layout

\begin_layout LyX-Code
                   (if ((caar tree) (car args))
\end_layout

\begin_layout LyX-Code
                       (if (pair? (cdr args))
\end_layout

\begin_layout LyX-Code
                           (per-arg (cdar tree)
\end_layout

\begin_layout LyX-Code
                                    (cdr args)
\end_layout

\begin_layout LyX-Code
                                    (lambda ()
\end_layout

\begin_layout LyX-Code
                                      (per-pred (cdr tree) fail)))
\end_layout

\begin_layout LyX-Code
                           (succeed (cdar tree)))
\end_layout

\begin_layout LyX-Code
                       (per-pred (cdr tree) fail)))
\end_layout

\begin_layout LyX-Code
                  ((null? tree)
\end_layout

\begin_layout LyX-Code
                   (fail))
\end_layout

\begin_layout LyX-Code
                  (else
\end_layout

\begin_layout LyX-Code
                   (succeed tree)))))))
\end_layout

\begin_layout LyX-Code
    (hash-table/put! *generic-operator-table* operator record)
\end_layout

\begin_layout LyX-Code
    (if default-operation
\end_layout

\begin_layout LyX-Code
        (assign-operation operator default-operation))
\end_layout

\begin_layout LyX-Code
    (if (not (default-object? name))
\end_layout

\begin_layout LyX-Code
        (hash-table/put! *generic-operator-table* name record))
\end_layout

\begin_layout LyX-Code
    operator))
\end_layout

\begin_layout LyX-Code

\end_layout

\begin_layout LyX-Code
(define *generic-operator-table*
\end_layout

\begin_layout LyX-Code
  (make-eq-hash-table))
\end_layout

\begin_layout LyX-Code
(define (make-operator-record arity) (cons arity '()))
\end_layout

\begin_layout LyX-Code
(define (operator-record-arity record) (car record))
\end_layout

\begin_layout LyX-Code
(define (operator-record-tree record) (cdr record))
\end_layout

\begin_layout LyX-Code
(define (set-operator-record-tree! record tree) (set-cdr! record tree))
\end_layout

\begin_layout LyX-Code

\end_layout

\begin_layout LyX-Code
(define (assign-operation operator handler .
 argument-predicates)
\end_layout

\begin_layout LyX-Code
  (let ((record
\end_layout

\begin_layout LyX-Code
         (let ((record (hash-table/get *generic-operator-table* operator
 #f))
\end_layout

\begin_layout LyX-Code
               (arity (length argument-predicates)))
\end_layout

\begin_layout LyX-Code
           (if record
\end_layout

\begin_layout LyX-Code
               (begin
\end_layout

\begin_layout LyX-Code
                 (if (not (<= arity (operator-record-arity record)))
\end_layout

\begin_layout LyX-Code
                     (error "Incorrect operator arity:" operator))
\end_layout

\begin_layout LyX-Code
                 record)
\end_layout

\begin_layout LyX-Code
               (let ((record (make-operator-record arity)))
\end_layout

\begin_layout LyX-Code
                 (hash-table/put! *generic-operator-table* operator record)
\end_layout

\begin_layout LyX-Code
                 record)))))
\end_layout

\begin_layout LyX-Code
    (set-operator-record-tree! record
\end_layout

\begin_layout LyX-Code
                               (bind-in-tree argument-predicates
\end_layout

\begin_layout LyX-Code
                                             handler
\end_layout

\begin_layout LyX-Code
                                             (operator-record-tree record))))
\end_layout

\begin_layout LyX-Code
  operator)
\end_layout

\begin_layout LyX-Code

\end_layout

\begin_layout LyX-Code
(define defhandler assign-operation)
\end_layout

\begin_layout LyX-Code

\end_layout

\begin_layout LyX-Code
(define (bind-in-tree keys handler tree)
\end_layout

\begin_layout LyX-Code
  (let loop ((keys keys) (tree tree))
\end_layout

\begin_layout LyX-Code
    (if (pair? keys)
\end_layout

\begin_layout LyX-Code
        (let find-key ((tree* tree))
\end_layout

\begin_layout LyX-Code
          (if (pair? tree*)
\end_layout

\begin_layout LyX-Code
              (if (eq? (caar tree*) (car keys))
\end_layout

\begin_layout LyX-Code
                  (begin
\end_layout

\begin_layout LyX-Code
                    (set-cdr! (car tree*)
\end_layout

\begin_layout LyX-Code
                              (loop (cdr keys) (cdar tree*)))
\end_layout

\begin_layout LyX-Code
                    tree)
\end_layout

\begin_layout LyX-Code
                  (find-key (cdr tree*)))
\end_layout

\begin_layout LyX-Code
              (cons (cons (car keys)
\end_layout

\begin_layout LyX-Code
                          (loop (cdr keys) '()))
\end_layout

\begin_layout LyX-Code
                    tree)))
\end_layout

\begin_layout LyX-Code
        (if (pair? tree)
\end_layout

\begin_layout LyX-Code
            (let ((p (last-pair tree)))
\end_layout

\begin_layout LyX-Code
              (if (not (null? (cdr p)))
\end_layout

\begin_layout LyX-Code
                  (warn "Replacing a handler:" (cdr p) handler))
\end_layout

\begin_layout LyX-Code
              (set-cdr! p handler)
\end_layout

\begin_layout LyX-Code
              tree)
\end_layout

\begin_layout LyX-Code
            (begin
\end_layout

\begin_layout LyX-Code
              (if (not (null? tree))
\end_layout

\begin_layout LyX-Code
                  (warn "Replacing top-level handler:" tree handler))
\end_layout

\begin_layout LyX-Code
              handler)))))
\end_layout

\begin_layout LyX-Code

\end_layout

\begin_layout Subsection
discovery.scm
\end_layout

\begin_layout LyX-Code
; discovery.scm
\end_layout

\begin_layout LyX-Code
; author: bnewbold @ mit (with lch @ mit)
\end_layout

\begin_layout LyX-Code
; for 6.945
\end_layout

\begin_layout LyX-Code
; circa 04/2009
\end_layout

\begin_layout LyX-Code

\end_layout

\begin_layout LyX-Code
; For speed?
\end_layout

\begin_layout LyX-Code
;(declare (usual-integrations))
\end_layout

\begin_layout LyX-Code

\end_layout

\begin_layout LyX-Code
; If it isn't already....
\end_layout

\begin_layout LyX-Code
;(load "ghelper")
\end_layout

\begin_layout LyX-Code

\end_layout

\begin_layout LyX-Code
; takes two lists: the first is a set of predicates and the second a set
\end_layout

\begin_layout LyX-Code
; of arguments; if any of the predicates are #t for the args, win, else
 fail
\end_layout

\begin_layout LyX-Code
(define (for-any? preds args)
\end_layout

\begin_layout LyX-Code
  (cond ((null? preds) #f)
\end_layout

\begin_layout LyX-Code
        ((null? (car preds)) #f)
\end_layout

\begin_layout LyX-Code
        ((apply (car preds) args) #t)
\end_layout

\begin_layout LyX-Code
        (else (for-any? (cdr preds) args))))
\end_layout

\begin_layout LyX-Code

\end_layout

\begin_layout LyX-Code
; Test
\end_layout

\begin_layout LyX-Code
(for-any? (list list? null? vector?) '(5)) 
\end_layout

\begin_layout LyX-Code
; #f 
\end_layout

\begin_layout LyX-Code
(for-any? (list list? null? vector?) '('(1 2 3))) 
\end_layout

\begin_layout LyX-Code
; #t 
\end_layout

\begin_layout LyX-Code

\end_layout

\begin_layout LyX-Code
; finds all the operators which can be applied to the args; returns a list
\end_layout

\begin_layout LyX-Code
; of operators (not the actual procedures; will include duplicate symbols
 and
\end_layout

\begin_layout LyX-Code
; operator stubs for named operators)
\end_layout

\begin_layout LyX-Code
(define (discover:opers-for .
 args)
\end_layout

\begin_layout LyX-Code
  (let* ((arity (length args))
\end_layout

\begin_layout LyX-Code
         (opers (hash-table->alist *generic-operator-table*))
\end_layout

\begin_layout LyX-Code
         (check 
\end_layout

\begin_layout LyX-Code
          (lambda (op)
\end_layout

\begin_layout LyX-Code
            (if (not (eq? arity (cadr op)))
\end_layout

\begin_layout LyX-Code
                #f
\end_layout

\begin_layout LyX-Code
                (let per-arg ((tree (operator-record-tree (cdr op)))
\end_layout

\begin_layout LyX-Code
                              (args args)
\end_layout

\begin_layout LyX-Code
                              (fail (lambda () #f)))
\end_layout

\begin_layout LyX-Code
                  (let per-pred ((tree tree) (fail fail))
\end_layout

\begin_layout LyX-Code
                    (cond ((pair? tree)
\end_layout

\begin_layout LyX-Code
                           (if ((caar tree) (car args))
\end_layout

\begin_layout LyX-Code
                               (if (pair? (cdr args))
\end_layout

\begin_layout LyX-Code
                                   (per-arg (cdar tree) 
\end_layout

\begin_layout LyX-Code
                                            (cdr args)
\end_layout

\begin_layout LyX-Code
                                            (lambda () 
\end_layout

\begin_layout LyX-Code
                                              (per-pred (cdr tree) fail)))
\end_layout

\begin_layout LyX-Code
                                   #t)
\end_layout

\begin_layout LyX-Code
                               (per-pred (cdr tree) fail)))
\end_layout

\begin_layout LyX-Code
                          ((null? tree) (fail))
\end_layout

\begin_layout LyX-Code
                          (else #t))))))))
\end_layout

\begin_layout LyX-Code
    (map car (filter check opers))))
\end_layout

\begin_layout LyX-Code

\end_layout

\begin_layout LyX-Code
; same as the above but only grabs the symboled ones
\end_layout

\begin_layout LyX-Code
(define (discover:named-opers-for .
 args)
\end_layout

\begin_layout LyX-Code
  (filter symbol? (apply discover:opers-for args)))
\end_layout

\begin_layout LyX-Code

\end_layout

\begin_layout LyX-Code
; returns a list of 
\end_layout

\begin_layout LyX-Code
(define (discover:named-opers)
\end_layout

\begin_layout LyX-Code
  (let ((check (lambda (x) (cond ((null? x) '())
\end_layout

\begin_layout LyX-Code
                                 ((symbol? x) x)
\end_layout

\begin_layout LyX-Code
                                 (else '())))))
\end_layout

\begin_layout LyX-Code
    (filter (lambda (x) (not (null? x)))
\end_layout

\begin_layout LyX-Code
            (map check (hash-table-keys *generic-operator-table*)))))
\end_layout

\begin_layout LyX-Code

\end_layout

\begin_layout LyX-Code
; this is just what operators do
\end_layout

\begin_layout LyX-Code
(define (discover:apply-name name .
 args)
\end_layout

\begin_layout LyX-Code
  (let ((record (hash-table/get *generic-operator-table* name #f)))
\end_layout

\begin_layout LyX-Code
    (let ((succeed
\end_layout

\begin_layout LyX-Code
           (lambda (handler)
\end_layout

\begin_layout LyX-Code
             (apply handler args))))
\end_layout

\begin_layout LyX-Code
      (let per-arg
\end_layout

\begin_layout LyX-Code
          ((tree (operator-record-tree record))
\end_layout

\begin_layout LyX-Code
           (args args)
\end_layout

\begin_layout LyX-Code
           (fail
\end_layout

\begin_layout LyX-Code
            (lambda ()
\end_layout

\begin_layout LyX-Code
              (error:no-applicable-methods operator args))))
\end_layout

\begin_layout LyX-Code
        (let per-pred ((tree tree) (fail fail))
\end_layout

\begin_layout LyX-Code
          (cond ((pair? tree)
\end_layout

\begin_layout LyX-Code
                 (if ((caar tree) (car args))
\end_layout

\begin_layout LyX-Code
                     (if (pair? (cdr args))
\end_layout

\begin_layout LyX-Code
                         (per-arg (cdar tree)
\end_layout

\begin_layout LyX-Code
                                  (cdr args)
\end_layout

\begin_layout LyX-Code
                                  (lambda ()
\end_layout

\begin_layout LyX-Code
                                    (per-pred (cdr tree) fail)))
\end_layout

\begin_layout LyX-Code
                         (succeed (cdar tree)))
\end_layout

\begin_layout LyX-Code
                     (per-pred (cdr tree) fail)))
\end_layout

\begin_layout LyX-Code
                ((null? tree)
\end_layout

\begin_layout LyX-Code
                 (fail))
\end_layout

\begin_layout LyX-Code
                (else
\end_layout

\begin_layout LyX-Code
                 (succeed tree))))))))
\end_layout

\begin_layout LyX-Code
(define (discover:thunklist-for .
 args)
\end_layout

\begin_layout LyX-Code
  (let ((names (apply discover:named-opers-for args)))
\end_layout

\begin_layout LyX-Code
    (cons args
\end_layout

\begin_layout LyX-Code
          (map (lambda (x)
\end_layout

\begin_layout LyX-Code
                 (list x
\end_layout

\begin_layout LyX-Code
                       (lambda ()
\end_layout

\begin_layout LyX-Code
                         (apply discover:apply-name (cons x args)))))
\end_layout

\begin_layout LyX-Code
               names))))
\end_layout

\begin_layout LyX-Code
(define (discover:apply-all .
 args)
\end_layout

\begin_layout LyX-Code
  (let ((names (apply discover:named-opers-for args)))
\end_layout

\begin_layout LyX-Code
    (map (lambda (x)
\end_layout

\begin_layout LyX-Code
           (apply discover:apply-name (cons x args)))
\end_layout

\begin_layout LyX-Code
         names)))
\end_layout

\begin_layout LyX-Code
(define (discover:apply-all-name .
 args)
\end_layout

\begin_layout LyX-Code
  (let ((names (apply discover:named-opers-for args)))
\end_layout

\begin_layout LyX-Code
    (map (lambda (x)
\end_layout

\begin_layout LyX-Code
           (list (apply discover:apply-name (cons x args)) x))
\end_layout

\begin_layout LyX-Code
         names)))
\end_layout

\begin_layout LyX-Code
(define (discover:satisfy pred? .
 args)
\end_layout

\begin_layout LyX-Code
  (let try ((objs (list args)))
\end_layout

\begin_layout LyX-Code
    (let ((goodies (filter (lambda (x) (apply pred? x)) objs)))
\end_layout

\begin_layout LyX-Code
      (if (not (null? goodies))
\end_layout

\begin_layout LyX-Code
          (car goodies)
\end_layout

\begin_layout LyX-Code
          (try (fold-right append 
\end_layout

\begin_layout LyX-Code
                          '()
\end_layout

\begin_layout LyX-Code
                          (map (lambda (x)
\end_layout

\begin_layout LyX-Code
                                 (map list
\end_layout

\begin_layout LyX-Code
                                      (apply discover:apply-all x)))
\end_layout

\begin_layout LyX-Code
                               objs)))))))
\end_layout

\begin_layout LyX-Code
(define (discover:satisfy-sequence pred? .
 args)
\end_layout

\begin_layout LyX-Code
  (let try ((objs (list (list args))))
\end_layout

\begin_layout LyX-Code
    (let ((goodies (filter (lambda (x) (apply pred? (car x))) objs)))
\end_layout

\begin_layout LyX-Code
      (if (not (null? goodies))
\end_layout

\begin_layout LyX-Code
          goodies
\end_layout

\begin_layout LyX-Code
          (try (fold-right append 
\end_layout

\begin_layout LyX-Code
                          '()
\end_layout

\begin_layout LyX-Code
                          (map (lambda (x)
\end_layout

\begin_layout LyX-Code
                                 (map (lambda (y)
\end_layout

\begin_layout LyX-Code
                                        (cons (list (car y)) (cons (cadr
 y) 
\end_layout

\begin_layout LyX-Code
                                                                   (cdr
 x))))
\end_layout

\begin_layout LyX-Code
                                      (apply discover:apply-all-name (car
 x))))
\end_layout

\begin_layout LyX-Code
                               objs)))))))
\end_layout

\begin_layout LyX-Code

\end_layout

\begin_layout LyX-Code
; see discovery-examples.scm for testing and examples
\end_layout

\begin_layout Subsection
discovery-examples.scm
\end_layout

\begin_layout LyX-Code
(load "ghelper")
\end_layout

\begin_layout LyX-Code
(load "discovery")
\end_layout

\begin_layout LyX-Code
(define inverse
\end_layout

\begin_layout LyX-Code
  (make-generic-operator 1 #f 'inverse))
\end_layout

\begin_layout LyX-Code
(define plus
\end_layout

\begin_layout LyX-Code
  (make-generic-operator 2 #f 'plus))
\end_layout

\begin_layout LyX-Code
(define minus
\end_layout

\begin_layout LyX-Code
  (make-generic-operator 2 #f 'minus))
\end_layout

\begin_layout LyX-Code
  
\end_layout

\begin_layout LyX-Code
(assign-operation inverse
\end_layout

\begin_layout LyX-Code
          (lambda (x) (/ 1 x))
\end_layout

\begin_layout LyX-Code
          (lambda (x) (and (number? x)
\end_layout

\begin_layout LyX-Code
                   (not (integer? x)))))
\end_layout

\begin_layout LyX-Code
; actually a transpose, but meh
\end_layout

\begin_layout LyX-Code
(assign-operation inverse
\end_layout

\begin_layout LyX-Code
          (lambda (x) (apply zip x))
\end_layout

\begin_layout LyX-Code
          (lambda (x) 
\end_layout

\begin_layout LyX-Code
            (and (list? x)
\end_layout

\begin_layout LyX-Code
             (for-all? x list?))))
\end_layout

\begin_layout LyX-Code
(define any? (lambda (x) #t))
\end_layout

\begin_layout LyX-Code
(assign-operation minus - any? any?)
\end_layout

\begin_layout LyX-Code
(assign-operation plus + any? any?)
\end_layout

\begin_layout LyX-Code
(plus 1 2)
\end_layout

\begin_layout LyX-Code
; 3
\end_layout

\begin_layout LyX-Code
;(minus 3)
\end_layout

\begin_layout LyX-Code
; ERROR
\end_layout

\begin_layout LyX-Code
(inverse 6.5)
\end_layout

\begin_layout LyX-Code
;Value: .15384615384615385
\end_layout

\begin_layout LyX-Code
(discover:opers-for 6.5)
\end_layout

\begin_layout LyX-Code
;Value 52: (inverse #[compound-procedure 49 operator])
\end_layout

\begin_layout LyX-Code
(discover:named-opers-for 6.5)
\end_layout

\begin_layout LyX-Code
;Value 53: (inverse)
\end_layout

\begin_layout LyX-Code
(discover:named-opers-for 1 2)
\end_layout

\begin_layout LyX-Code
;Value 54: (plus minus)
\end_layout

\begin_layout LyX-Code
(environment-lookup (the-environment) 'inverse)
\end_layout

\begin_layout LyX-Code
;Value 49: #[compound-procedure 49 operator]
\end_layout

\begin_layout LyX-Code
(hash-table/get *generic-operator-table* inverse #f)
\end_layout

\begin_layout LyX-Code
;Value 59: (1 (#[compound-procedure 57] .
 #[compound-procedure 60]) (#[compound-procedure 61] .
 #[compound-procedure 62]))
\end_layout

\begin_layout LyX-Code
(hash-table/get *generic-operator-table* minus #f)
\end_layout

\begin_layout LyX-Code
;Value 63: (2 (#[compound-procedure 56 any?] (#[compound-procedure 56 any?]
 .
 #[arity-dispatched-procedure 28])))
\end_layout

\begin_layout LyX-Code
(hash-table-size *generic-operator-table*)
\end_layout

\begin_layout LyX-Code
;Value: 6    ; for this file
\end_layout

\begin_layout LyX-Code
;Value: 92   ; for scmutils
\end_layout

\begin_layout LyX-Code
;this prints all keys line by line
\end_layout

\begin_layout LyX-Code
(for-each
\end_layout

\begin_layout LyX-Code
 (lambda (x) (newline)
\end_layout

\begin_layout LyX-Code
     (display x))
\end_layout

\begin_layout LyX-Code
 (hash-table/key-list *generic-operator-table*))
\end_layout

\begin_layout LyX-Code
(define add1 (make-generic-operator 1 #f 'add1))
\end_layout

\begin_layout LyX-Code
(define sub1 (make-generic-operator 1 #f 'sub1))
\end_layout

\begin_layout LyX-Code
(define double (make-generic-operator 1 #f 'double))
\end_layout

\begin_layout LyX-Code
(define square (make-generic-operator 1 #f 'square))
\end_layout

\begin_layout LyX-Code
(define inverse (make-generic-operator 1 #f 'inverse))
\end_layout

\begin_layout LyX-Code
(defhandler add1 (lambda (x) (+ x 1)) number?)
\end_layout

\begin_layout LyX-Code
(defhandler sub1 (lambda (x) (- x 1)) number?)
\end_layout

\begin_layout LyX-Code
(defhandler double (lambda (x) (* 2 x)) number?)
\end_layout

\begin_layout LyX-Code
(defhandler square (lambda (x) (* x x)) number?)
\end_layout

\begin_layout LyX-Code
(defhandler inverse (lambda (x) (/ 1 x)) (lambda (n)
\end_layout

\begin_layout LyX-Code
                       (and (number? n)
\end_layout

\begin_layout LyX-Code
                        (not (zero? n)))))
\end_layout

\begin_layout LyX-Code
(discover:apply-all 3)
\end_layout

\begin_layout LyX-Code
;Value 89: (1/3 4 9 2 6)
\end_layout

\begin_layout LyX-Code
(discover:satisfy (lambda (x) (eq? x 9)) (/ 1 2))
\end_layout

\begin_layout LyX-Code
;Value 35: (9)
\end_layout

\begin_layout LyX-Code
(discover:satisfy-sequence (lambda (x) (eq? x 9)) (/ 1 2))
\end_layout

\begin_layout LyX-Code
;Value 36: (((9) square double add1) ((9) square add1 inverse))
\end_layout

\begin_layout LyX-Code
(discover:satisfy-sequence (lambda (x) (eq? x 49)) (/ 5 6))
\end_layout

\begin_layout LyX-Code
;Value 37: (((49) square sub1 inverse sub1))
\end_layout

\begin_layout LyX-Code
(define (prime? n)
\end_layout

\begin_layout LyX-Code
  (cond ((null? n) #f)
\end_layout

\begin_layout LyX-Code
        ((not (integer? n)) #f)
\end_layout

\begin_layout LyX-Code
        ((> 0 n) #f)
\end_layout

\begin_layout LyX-Code
        (else (let lp ((m 2))
\end_layout

\begin_layout LyX-Code
                (cond ((> m (sqrt n)) #t)
\end_layout

\begin_layout LyX-Code
                      ((integer? (/ n m)) #f)
\end_layout

\begin_layout LyX-Code
                      (else (lp (+ m 1))))))))
\end_layout

\begin_layout LyX-Code
(prime? 47)
\end_layout

\begin_layout LyX-Code
; #t
\end_layout

\begin_layout LyX-Code
(discover:satisfy-sequence prime? (/ 5 6))
\end_layout

\begin_layout LyX-Code
;Value 39: (((5) inverse sub1 inverse))
\end_layout

\begin_layout LyX-Code
(discover:satisfy-sequence prime? 923)
\end_layout

\begin_layout LyX-Code
;Value 44: (((1847) add1 double))
\end_layout

\begin_layout LyX-Code
(discover:named-opers)
\end_layout

\begin_layout Subsection
prhello.scm
\end_layout

\begin_layout LyX-Code
(declare (usual-integrations))    
\end_layout

\begin_layout LyX-Code
(load "ghelper.scm")
\end_layout

\begin_layout LyX-Code
(load "discovery.scm")
\end_layout

\begin_layout LyX-Code
(load-option 'FFI)
\end_layout

\begin_layout LyX-Code
(C-include "prhello")
\end_layout

\begin_layout LyX-Code
(load "generic-string-opers.scm") ; extra generic string operations
\end_layout

\begin_layout LyX-Code
(define get-vals car)
\end_layout

\begin_layout LyX-Code
(define (get-proc-symbols input) (map car (cdr input)))
\end_layout

\begin_layout LyX-Code
(define (apply-ith-thunk input i) ((cadr (list-ref (cdr input) i))))
\end_layout

\begin_layout LyX-Code
(define (thing-to-string thing)
\end_layout

\begin_layout LyX-Code
 (let ((buff (open-output-string)))
\end_layout

\begin_layout LyX-Code
   (display thing buff)
\end_layout

\begin_layout LyX-Code
   (get-output-string buff)))
\end_layout

\begin_layout LyX-Code
(define (discover-gui .
 input)
\end_layout

\begin_layout LyX-Code

\end_layout

\begin_layout LyX-Code
  (C-call "gtk_init" 0 null-alien)
\end_layout

\begin_layout LyX-Code
  (let* ((discovered-opers (apply discover:thunklist-for input))
\end_layout

\begin_layout LyX-Code
         (window (let ((alien (make-alien '|GtkWidget|)))
\end_layout

\begin_layout LyX-Code
                   (C-call "gtk_window_new" alien
\end_layout

\begin_layout LyX-Code
                           (C-enum "GTK_WINDOW_TOPLEVEL"))
\end_layout

\begin_layout LyX-Code
                   (if (alien-null? alien) (error "Could not create window."))
\end_layout

\begin_layout LyX-Code
                       alien))
\end_layout

\begin_layout LyX-Code
         (hbox (let ((alien (make-alien '|GtkWidget|)))
\end_layout

\begin_layout LyX-Code
                 (C-call "gtk_hbox_new" alien 0 20)
\end_layout

\begin_layout LyX-Code
                 (if (alien-null? alien) (error "Could not create hbox."))
\end_layout

\begin_layout LyX-Code
                 alien))
\end_layout

\begin_layout LyX-Code
         (combo (let ((alien (make-alien '|GtkWidget|)))
\end_layout

\begin_layout LyX-Code
                  (C-call "gtk_combo_box_new_text" alien)
\end_layout

\begin_layout LyX-Code
                  (if (alien-null? alien) (error "Could not create combo."))
\end_layout

\begin_layout LyX-Code
                  alien))
\end_layout

\begin_layout LyX-Code
         (labels (map (lambda (val) 
\end_layout

\begin_layout LyX-Code
                        (let ((alien (make-alien '|GtkWidget|)))
\end_layout

\begin_layout LyX-Code
                          (C-call "gtk_label_new" alien (thing-to-string
 val))
\end_layout

\begin_layout LyX-Code
                          (if (alien-null? alien) (error "Could not create
 label."))
\end_layout

\begin_layout LyX-Code
                          alien))
\end_layout

\begin_layout LyX-Code
                      (get-vals discovered-opers))))
\end_layout

\begin_layout LyX-Code
    (for-each (lambda (proc-symbol)
\end_layout

\begin_layout LyX-Code
                (C-call "gtk_combo_box_append_text" combo (thing-to-string
 proc-symbol)))
\end_layout

\begin_layout LyX-Code
              (get-proc-symbols discovered-opers))
\end_layout

\begin_layout LyX-Code
                                
\end_layout

\begin_layout LyX-Code
    (for-each (lambda (label) (C-call "gtk_container_add" hbox label)) labels)
\end_layout

\begin_layout LyX-Code
    (C-call "gtk_container_add" hbox combo)
\end_layout

\begin_layout LyX-Code
    (C-call "gtk_container_add" window hbox)
\end_layout

\begin_layout LyX-Code
    (C-call "gtk_window_set_title" window "Generic Operator Discovery")
\end_layout

\begin_layout LyX-Code
    (C-call "gtk_container_set_border_width" window 10)
\end_layout

\begin_layout LyX-Code
    (C-call "gtk_window_resize" window 250 20)
\end_layout

\begin_layout LyX-Code
    (C-call "g_signal_connect" combo "changed"
\end_layout

\begin_layout LyX-Code
            (C-callback "changed")      ;trampoline
\end_layout

\begin_layout LyX-Code
            (C-callback                 ;callback ID
\end_layout

\begin_layout LyX-Code
             (lambda (w)
\end_layout

\begin_layout LyX-Code
               (let ((i (C-call "gtk_combo_box_get_active" combo)))
\end_layout

\begin_layout LyX-Code
                 (discover-gui (apply-ith-thunk discovered-opers i))))))
\end_layout

\begin_layout LyX-Code
    (C-call "g_signal_connect" window "delete_event"
\end_layout

\begin_layout LyX-Code
            (C-callback "delete_event") ;trampoline
\end_layout

\begin_layout LyX-Code
            (C-callback                 ;callback ID
\end_layout

\begin_layout LyX-Code
             (lambda (w e)
\end_layout

\begin_layout LyX-Code
               (begin
\end_layout

\begin_layout LyX-Code
                 (C-call "gtk_main_quit")
\end_layout

\begin_layout LyX-Code
                 0))))
\end_layout

\begin_layout LyX-Code
    (C-call "gtk_widget_show_all" window)
\end_layout

\begin_layout LyX-Code
    (C-call "gtk_main")
\end_layout

\begin_layout LyX-Code
    window))
\end_layout

\begin_layout LyX-Code

\end_layout

\end_body
\end_document