home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1989 / 02 / levelki / generate.lsp < prev    next >
Encoding:
Text File  |  1988-11-23  |  1.8 KB  |  55 lines
  1. ; Die Funktion g verwandelt eine normale Funktion in eine,
  2. ; die Streams als Argumente nimmt, und den Stream der
  3. ; Resultate zurückgibt.   Bsp.:
  4. ; (define a (cons-stream 1 (cons-stream 2 the-empty-stream)))
  5. ; (define b (cons-stream 100 (cons-stream 101 the-empty-stream)))
  6. ; (define s ((g +) a b))
  7. ; (head s) ===> 101
  8. ; (head (tail s)) ===> 102
  9. ; (head (tail (tail s))) ===> 102
  10. ; (head (tail (tail (tail s)))) ===> 103
  11. ; (define s1 ((g +) 1 b))
  12. ; (head s1) ===> 101
  13. ; (head (tail s1)) ===> 102
  14.  
  15. (define (g proc)
  16.   (lambda ops
  17.     (let ((args (map (lambda (x)
  18.                        (if (stream? x) x
  19.                            (cons-stream x the-empty-stream)))
  20.                      ops)))
  21.       (if (= 1 (length args))
  22.           (map-stream proc args)
  23.           (process proc args)))))
  24.  
  25. (define (process proc args)
  26.   (let ((l (length args)))
  27.     (cond ((= 2 l) (p2 proc (car args) (cadr args)))
  28.           (else (error "Too many arguments")))))
  29.  
  30. (define (p2 proc a b)
  31.   (cond ((empty-stream? a) the-empty-stream)
  32.         ((empty-stream? b) the-empty-stream)
  33.         (else (flatten (map-stream (lambda (a1)
  34.                                      (map-stream (lambda (x) (proc a1 x))
  35.                                                  b))
  36.                                    a)))))
  37.  
  38. (define (map-stream proc s)
  39.   (if (empty-stream? s) the-empty-stream
  40.       (cons-stream (proc (head s))
  41.                    (map-stream proc (tail s)))))
  42.  
  43. (define (append-delayed s ds)
  44.   (if (empty-stream? s) (force ds)
  45.       (cons-stream (head s)
  46.                    (append-delayed (tail s) ds))))
  47.  
  48. (define (flatten stream)
  49.   (if (empty-stream? stream) the-empty-stream
  50.       (append-delayed (head stream) (delay (flatten (tail stream))))))
  51.  
  52. (define (error msg)
  53.   (print "too many arguments to generator")
  54.   nil)
  55.