#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 [TODO: cite]. 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 scmutils 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 *generic-operator-table*. 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 reimplemented 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 hold \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 hold \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 hold \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 hold \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 Section A GUI Interface \end_layout \begin_layout Subsection FFI \end_layout \begin_layout Subsection Gtk Bindings \end_layout \begin_layout Subsection Procedures \end_layout \begin_layout Paragraph* (discover:thunklist-for . args) \end_layout \begin_layout Standard This is a special purpose function \end_layout \begin_layout Subsection Screenshots \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 LyX-Code \end_layout \end_body \end_document