tarot-viewing/compiler/std/seq.scm

(define (elt? exp)
  (and (pair? exp)
       (eq? 'elt (car exp))
       (pair? (cdr exp))
       (null? (cddr exp))))
(define (elt-get-elt exp) (cadr exp))
(define (cat? exp) (and (pair? exp) (eq? 'cat (car exp))))
(define (cat-get-seqs exp) (cdr exp))

(define (seq->dlist seq tail)
  (cond ((elt? seq) (cons (elt-get-elt seq) tail))
	((cat? seq) (fold seq->dlist tail (cat-get-seqs seq)))
	(else (error 'seq->dlist "?" seq))))
(define (seq->list seq) (seq->dlist seq '()))

(define (seq-length^ seq tail)
  (cond ((elt? seq) (+ 1 tail))
	((cat? seq) (fold seq-length^ tail (cat-get-seqs seq)))
	(else (error 'seq-length^ "?" seq))))
(define (seq-length seq) (seq-length^ seq 0))