1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 | ;This will simply use a list to keep track of the values to be multiplied (define (multiply-delay x y) (let ( ;convert to lists if they aren't already (x-list (if (list? x) x (list x))) (y-list (if (list? y) y (list y)))) ;append them together (append x-list y-list))) (define (multiply-force mul-list) (let ( (has-zero? #f)) (for-each (lambda (x) (if (eqv? 0 x) (set! has-zero? #f) #f)) mul-list) (if has-zero? 0 (apply * mul-list)))) (define a (multiply-delay 23 54)) (define b (multiply-delay 0 5)) (define c (multiply-delay a b)) (define d (multiply-delay c 55) (display (multiply-force d)) (newline) |
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 | ;Unevaluated promises will have the structure ('delayed val1 val2) ;Evaluated promises will have the structure ('forced result) ;Create an unevaluated promise (define (multiply-delay x y) (list 'delayed x y)) ;Checks promises (and values) to see if they contain any zeros (define (has-zero promise) (if (pair? promise) (if (eq? (car promise) 'forced) ;check forced value (if (eqv? (cdr promise) 0) #t #f) ;check unforced value (if (or (has-zero (cadr promise)) (has-zero (caddr promise))) #t #f)) ;Check scalar value (if (eqv? promise 0) #t #f))) ;Attempts zero optimization, then defaults to regular delay/force behavior (define (multiply-force promise) (if (eq? (car promise) 'forced) ;if we've already been forced, return the value (cdr promise) ;otherwise, search for a zero (if (has-zero promise) (begin (set-car! promise 'forced) (set-cdr! promise 0) 0) (multiply-force-nonzero promise)))) ;This is for promises which are known to be free of zeros (define (multiply-force-nozero promise) (if (pair? promise) (if (eq? (car promise) 'forced) ;if the promise has been forced, just return the value (cdr promise) ;otherwise, compute the value, and convert this into a "forced" promise (begin (set-car! promise 'forced) (set-cdr! promise (* (multiply-force-nonzero (cadr promise)) (multiply-force-nonzero (caddr promise)))) ;return the forced value (cdr promise))) ;This is just a number, so return it promise)) |
欢迎光临 电子技术论坛_中国专业的电子工程师学习交流社区-中电网技术论坛 (http://bbs.eccn.com/) | Powered by Discuz! 7.0.0 |