diff options
Diffstat (limited to 'final_project/work/discovery.scm')
| -rw-r--r-- | final_project/work/discovery.scm | 59 |
1 files changed, 47 insertions, 12 deletions
diff --git a/final_project/work/discovery.scm b/final_project/work/discovery.scm index 3fa138f..e3756ab 100644 --- a/final_project/work/discovery.scm +++ b/final_project/work/discovery.scm @@ -9,6 +9,8 @@ ; If it isn't already.... ;(load "ghelper") +(define filter keep-matching-items) + ; takes two lists: the first is a set of predicates and the second a set ; of arguments; if any of the predicates are #t for the args, win, else fail (define (for-any? preds args) @@ -137,21 +139,54 @@ -------------------- End Testing ------------------- |# -(define (discover:apply-all . args) - (filter (compose not null?) - (map (lambda (oper) - (if (symbol? oper) - '() - (list oper (apply oper args)))) - (apply discover:opers-for args)))) +; this is just what operators do +(define (discover:apply-name name . args) + (let ((record (hash-table/get *generic-operator-table* name #f))) + (let ((succeed + (lambda (handler) + (apply handler args)))) + (let per-arg + ((tree (operator-record-tree record)) + (args args) + (fail + (lambda () + (error:no-applicable-methods operator args)))) + (let per-pred ((tree tree) (fail fail)) + (cond ((pair? tree) + (if ((caar tree) (car args)) + (if (pair? (cdr args)) + (per-arg (cdar tree) + (cdr args) + (lambda () + (per-pred (cdr tree) fail))) + (succeed (cdar tree))) + (per-pred (cdr tree) fail))) + ((null? tree) + (fail)) + (else + (succeed tree)))))))) + +(define (discover:thunklist-for . args) + (let ((names (apply discover:named-opers-for args))) + (cons args + (map (lambda (x) + (list x + (lambda () + (apply discover:apply-name (cons x args))))) + names)))) + + + + + + + + + + -(discover:apply-all 2) - -(discover:named-opers-for 2) -(environment-lookup (the-environment) 'sin) -(one-like 4) |