ompayne
/
sicp
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

First cut at 2.82; not working

This commit is contained in:
Oliver Payne 2022-02-08 22:38:46 +00:00
parent 89a52bb489
commit e43ea03225
1 changed files with 35 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

53
2_78.rkt
View File

@ -68,30 +68,47 @@
;; "No method for these types -- APPLY-GENERIC"
;; (list op type-tags))))))
(define (accumulate op initial sequence)
(if (null? sequence)
initial
(op (car sequence)
(accumulate op initial (cdr sequence)))))
(define (flatmap proc seq)
(accumulate append nil (map proc seq)))
(define (apply-generic op . args)
(define (coerce-to t)
(lambda (arg)
(let* ((type (type-tag arg))
(type->t (get-coercion type t)))
(cond ((eq? type t) arg)
(type->t (type->t arg))
(else '())))))
(define (any-empty-list l)
(cond ((null? l) #f)
((eq? (car l) '()) #t)
(else (any-empty-list (cdr l)))))
(let ((type-tags (map type-tag args)))
(let ((proc (get op type-tags)))
(if proc
(apply proc (map contents args))
(if (= (length args) 2)
(let ((type1 (car type-tags))
(type2 (cadr type-tags))
(a1 (car args))
(a2 (cadr args)))
(if (not (eq? type1 type2))
(let ((t1->t2 (get-coercion type1 type2))
(t2->t1 (get-coercion type2 type1)))
(cond (t1->t2
(apply-generic op (t1->t2 a1) a2))
(t2->t1
(apply-generic op a1 (t2->t1 a2)))
(else
(error "No method for these types"
(list op type-tags)))))
(error "No method for these types"
(if (> (length args) 1)
(let* ((type1 (car type-tags))
(coerced-args (map (coerce-to type1) args)))
(if (not (any-empty-list coerced-args))
(apply-generic op coerced-args) ;; the problem is that the third argument is a list: expecting multiple arguments
(error "Tried coercing all args to first type"
(list op type-tags))))
(error "No method for these types"
(list op type-tags)))))))
(error "Too few args"))))))
;; map coerce-to onto all arguments for the type of each argument.
;; The first one that returns all non empty arguments is the coercion
;; that is used.
;; How to determine if any of the results are ()? Maybe use accumulate?
;; Scheme numbers