diff options
Diffstat (limited to 'final_project/work')
| -rw-r--r-- | final_project/work/discovery.scm | 63 |
1 files changed, 57 insertions, 6 deletions
diff --git a/final_project/work/discovery.scm b/final_project/work/discovery.scm index 1da7b21..b6f315d 100644 --- a/final_project/work/discovery.scm +++ b/final_project/work/discovery.scm @@ -60,7 +60,7 @@ -#| ------------------- Testing -------------------- +;#| ------------------- Testing -------------------- (for-any? (list list? null? vector?) '(4)) ; #f @@ -93,7 +93,7 @@ (plus 1 2) ; 3 -(minus 3) +;(minus 3) ; ERROR (inverse 6.5) @@ -135,7 +135,7 @@ (display x)) (hash-table/key-list *generic-operator-table*)) --------------------- End Testing ------------------- |# +;-------------------- End Testing ------------------- |# ; this is just what operators do (define (discover:apply-name name . args) @@ -173,19 +173,70 @@ (apply discover:apply-name (cons x args))))) names)))) +(define (discover:apply-all . args) + (let ((names (apply discover:named-opers-for args))) + (map (lambda (x) + (apply discover:apply-name (cons x args))) + names))) + +(define (discover:apply-all-name . args) + (let ((names (apply discover:named-opers-for args))) + (map (lambda (x) + (list (apply discover:apply-name (cons x args)) x)) + names))) + (define (discover:satisfy pred? . args) (let try ((objs (list args))) - (let ((goodies (keep-matching-items (lambda (x) (apply pred? x))))) + (let ((goodies (filter (lambda (x) (apply pred? x)) objs))) (if (not (null? goodies)) (car goodies) - (lp (fold-right append + (try (fold-right append '() (map (lambda (x) - (list (apply discover:apply-all x))) + (map list + (apply discover:apply-all x))) objs))))))) +;#| more testing + +(define add1 (make-generic-operator 1 #f 'add1)) +(define sub1 (make-generic-operator 1 #f 'sub1)) +(define double (make-generic-operator 1 #f 'double)) +(define square (make-generic-operator 1 #f 'square)) +(defhandler add1 (lambda (x) (+ x 1)) number?) +(defhandler sub1 (lambda (x) (- x 1)) number?) +(defhandler double (lambda (x) (* 2 x)) number?) +(defhandler square (lambda (x) (* x x)) number?) + +(add1 4) +;(sub1 'b) + +(discover:apply-all 3) +(discover:satisfy (lambda (x) (eq? x 9)) (/ 1 2)) +(discover:satisfy-sequence (lambda (x) (eq? x 9)) (/ 1 2)) +(discover:satisfy-sequence (lambda (x) (eq? x 49)) (/ 5 6)) + +(square (sqrt 2)) +(sqrt 2) +(square 3) + +;|# + +(define (discover:satisfy-sequence pred? . args) + (let try ((objs (list (list args)))) + (let ((goodies (filter (lambda (x) (apply pred? (car x))) objs))) + (if (not (null? goodies)) + goodies + (try (fold-right append + '() + (map (lambda (x) + (map (lambda (y) + (cons (list (car y)) (cons (cadr y) + (cdr x)))) + (apply discover:apply-all-name (car x)))) + objs))))))) |