seq.scm 802 B

1234567891011121314151617181920212223242526272829
  1. (define (fold kons knil lst)
  2. (if (null? lst)
  3. knil
  4. (kons (car lst)
  5. (fold kons knil (cdr lst)))))
  6. ;;
  7. (define (elt? exp)
  8. (and (pair? exp)
  9. (eq? 'elt (car exp))
  10. (pair? (cdr exp))
  11. (null? (cddr exp))))
  12. (define (elt-get-elt exp) (cadr exp))
  13. (define (cat? exp) (and (pair? exp) (eq? 'cat (car exp))))
  14. (define (cat-get-seqs exp) (cdr exp))
  15. (define (seq->dlist seq tail)
  16. (cond ((elt? seq) (cons (elt-get-elt seq) tail))
  17. ((cat? seq) (fold seq->dlist tail (cat-get-seqs seq)))
  18. (else (error 'seq->dlist "?" seq))))
  19. (define (seq->list seq) (seq->dlist seq '()))
  20. (define (seq-length^ seq tail)
  21. (cond ((elt? seq) (+ 1 tail))
  22. ((cat? seq) (fold seq-length^ tail (cat-get-seqs seq)))
  23. (else (error 'seq-length^ "?" seq))))
  24. (define (seq-length seq) (seq-length^ seq 0))