source: project/release/5/biglists/trunk/biglists.scm @ 37454

Last change on this file since 37454 was 37454, checked in by juergen, 6 months ago

biglists 0.1.2 some typos corrected

File size: 41.6 KB
Line 
1; Author: Juergen Lorenz ; ju (at) jugilo (dot) de
2;
3; Copyright (c) 2013-2019, Juergen Lorenz
4; All rights reserved.
5;
6; Redistribution and use in source and binary forms, with or without
7; modification, are permitted provided that the following conditions are
8; met:
9;
10; Redistributions of source code must retain the above copyright
11; notice, this list of conditions and the following dispasser.
12;
13; Redistributions in binary form must reproduce the above copyright
14; notice, this list of conditions and the following dispasser in the
15; documentation and/or other materials provided with the distribution.
16;
17; Neither the name of the author nor the names of its contributors may be
18; used to endorse or promote products derived from this software without
19; specific prior written permission.
20;
21; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
22; IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
23; TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
24; PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
25; HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
26; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
27; TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
28; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
29; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
30; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
31; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
32
33
34#|[
35This is another implementation of lazy-lists. Contrary to other
36implementations this one
37-- is able to distinguish between finite and infinite lazy lists
38-- implements most routines so that they can be used as partial routines
39-- all routines are named with uppercase first letter, so that
40   they don't conflict with equally named standard list routines
41-- arguments have standard orders:
42   procedure arguments first, biglist arguments last
43]|#
44
45(module biglists (
46  Append
47  Assoc
48  Assp
49  Assq
50  Assv
51  At
52  BigList?
53  BigList->list
54  Cons
55  Cycle
56  Cycle-times
57  Drop
58  Drop-while
59  Drop-until
60  Eager?
61  Eq?
62  Eqp?
63  Equal?
64  Eqv?
65  Every?
66  Filter
67  Fold-left
68  Fold-left0
69  Fold-right
70  Fold-right0
71  For
72  For-each
73  First
74  Index
75  Iterate
76  Iterate-times
77  Iterate-until
78  Iterate-while
79  Lazy?
80  Length
81  List
82  List?
83  List-of?
84  Map
85  Member
86  Memp
87  Memq
88  Memv
89  Merge
90  Null?
91  Print
92  Range
93  Read-forever
94  Remove
95  Remp
96  Remq
97  Remv
98  Repeat
99  Repeat-times
100  Rest
101  Reverse
102  Reverse*
103  Scan-left
104  Scan-right
105  Some?
106  Sort
107  Sorted?
108  Take
109  Take-until
110  Take-while
111  Unzip
112  Zip
113  biglist-lazy
114  biglists
115  eos
116  )
117
118
119  (import scheme (chicken base) (only bindings eos bind-seq-db))
120
121(define (and? . xprs)
122  (call/cc
123    (lambda (out)
124      (for-each (lambda (x) (or x (out #f)))
125                xprs)
126      #t)))
127
128(define-record-type lazy
129  (biglist-lazy first rest finite?)
130  lazy?
131  (first lazy-first)
132  (rest lazy-rest)
133  (finite? lazy-finite?))
134
135(define-record-printer (lazy xs out)
136  (let ((start "(Lazy[") (stop ")"))
137    (display start out)
138    (display (if (List? xs)
139               "finite"
140               "infinite") out)
141    (display "]" out)
142    (cond ((and (Lazy? xs) (List? xs))
143           (let loop ((xs xs))
144             (if (Null? xs)
145               (display stop out)
146               (begin
147                 (display " " out)
148                 (write (First xs) out)
149                 (loop (Rest xs))))))
150           ((and (Lazy? xs) (not (List? xs)))
151            (let loop ((k 0) (xs xs))
152              (cond
153                ((= k 10)
154                 (display " ..." out)
155                 (display stop out))
156                (else
157                  (display " " out)
158                  (write (First xs) out)
159                  (loop (+ k 1) (Rest xs)))))))))
160
161(define-syntax Cons
162  (syntax-rules ()
163    ((_ x y finite?)
164     (biglist-lazy (delay x) (delay y) finite?))
165    ((_ x y) (cons x y))
166    ))
167
168(define (BigList? xpr)
169  (or
170    (list? xpr)
171    (eq? xpr eos) ;;;;;;
172    (and (lazy? xpr)
173         (promise? (lazy-first xpr))
174         (promise? (lazy-rest xpr))
175         (boolean? (lazy-finite? xpr)))
176    ))
177
178(define Eager? list?)
179
180(define (Lazy? xpr) 
181  (and (BigList? xpr) (not (list? xpr))))
182
183(define (List? xpr) ; finite
184  (or (eq? xpr eos)
185      (Eager? xpr)
186      (and (Lazy? xpr)
187           (lazy-finite? xpr))))
188
189(define List-of?
190  (case-lambda
191    (oks?
192      (lambda (xpr)
193        (apply and?
194               (List? xpr)
195               (BigList->list
196                 (Map (lambda (x)
197                        (apply and?
198                               (map (lambda (ok?) (ok? x))
199                                    oks?)))
200                      xpr)))))
201    ((k . oks?)
202     (lambda (xpr)
203       (and (BigList? xpr)
204            ((apply List-of? oks?)
205             (Take k xpr)))))
206    ))
207
208(define (Null? xs) 
209  (and (BigList? xs)
210       (or (eqv? xs '())
211           (eq? xs eos))))
212
213(define (First xs)
214  (cond
215    ((Eager? xs)
216     (if (null? xs)
217       eos
218       (car xs)))
219    ((Lazy? xs)
220     (if (Null? xs)
221       eos
222       (force (lazy-first xs))))
223    (else (error 'First "not a biglist" xs))))
224
225(define (Rest xs)
226  (cond
227    ((list? xs)
228     (if (null? xs)
229       '()
230       (cdr xs)))
231    ((Lazy? xs)
232     (if (Null? xs)
233       xs
234       (force (lazy-rest xs))))
235    (else (error 'Rest "not a biglist" xs))))
236
237(define (Length xs)
238  (if (BigList? xs)
239    (cond
240      ((Eager? xs) (length xs))
241      ((List? xs)
242       (if (Null? xs)
243         0
244         (+ 1 (Length (Rest xs)))))
245      (else #f))
246    (error 'Length "not a biglist" xs)
247    ))
248
249
250(define (At n . xss)
251  (cond
252    ((null? xss)
253     (lambda (xs)
254       (At n xs)))
255    ((null? (cdr xss))
256     (let ((xs (car xss)))
257       (if (BigList? xs)
258         (if (zero? n)
259           (First xs)
260           (At (- n 1) (Rest xs)))
261         (error 'At "not a biglist" xs))))
262    (else (error 'At "too many arguments"))))
263
264(define (List . args)
265  (if (null? args)
266    eos
267    (Cons (car args)
268          (apply List (cdr args))
269          #t)))
270
271(define (Take k . xss)
272  (cond
273    ((null? xss)
274     (lambda (xs)
275       (Take k xs)))
276    ((null? (cdr xss))
277     (let ((xs (car xss)))
278       (if (BigList? xs)
279         (let ((eager? (Eager? xs)))
280           (cond
281             ((Null? xs) xs)
282             ((zero? k) (if eager? '() eos))
283             (else
284               (if eager?
285                 (Cons (First xs) (Take (- k 1) (Rest xs)))
286                 (Cons (First xs) (Take (- k 1) (Rest xs)) #t)))))
287         (error 'Take "not a biglist" xs))))
288;       (cond
289;         ((Eager? xs)
290;          (if (zero? k)
291;            '()
292;            (Cons (First xs) (Take (- k 1) (Rest xs)))))
293;         ((Lazy? xs)
294;          (if (zero? k)
295;            eos
296;            (Cons (First xs) (Take (- k 1) (Rest xs)) #t)))
297;         (else (error 'Take "not a biglist" xs)))))
298    (else (error 'Take "too many arguments"))))
299
300(define (Take-while ok? . xss)
301  (cond
302    ((null? xss)
303     (lambda (xs)
304       (Take-while ok? xs)))
305    ((null? (cdr xss))
306     (let ((xs (car xss)))
307       (cond
308         ((Eager? xs)
309          (let recur ((xs xs))
310            (cond
311              ((null? xs) xs)
312              ((ok? (First xs))
313               (Cons (First xs) (recur (Rest xs))))
314              (else '()))))
315         ((Lazy? xs)
316          (let recur ((xs xs))
317            (if (ok? (First xs))
318              (Cons (First xs) (recur (Rest xs)) #t)
319              eos)))
320         (else (error 'Take-while "not a biglist" xs)))))
321    (else (error 'Take-while "too many arguments"))))
322
323(define (Take-until ok? . xss)
324  (cond
325    ((null? xss)
326     (lambda (xs)
327       (Take-while ok? xs)))
328    ((null? (cdr xss))
329     (let ((xs (car xss)))
330       (cond
331         ((Eager? xs)
332          (let recur ((xs xs))
333            (cond
334              ((null? xs) xs)
335              ((ok? (First xs)) '())
336              (else
337                (Cons (First xs) (recur (Rest xs)))))))
338         ((Lazy? xs)
339          (let recur ((xs xs))
340            (cond
341              ((Null? xs) xs)
342              ((ok? (First xs))
343               eos)
344              (else
345                (Cons (First xs) (recur (Rest xs)) #t)))))
346         (else (error 'Take-until "not a biglist" xs)))))
347    (else (error 'Take-while "too many arguments"))))
348
349(define (Drop k . xss)
350  (cond
351    ((null? xss)
352     (lambda (xs)
353       (Drop k xs)))
354    ((null? (cdr xss))
355     (let ((xs (car xss)))
356       (if (BigList? xs)
357         (if (zero? k)
358           xs
359           (Drop (- k 1) (Rest xs)))
360         (error 'Drop "not a biglist" xs))))
361    (else (error 'Drop "too many arguments"))))
362
363(define (Drop-while ok? . xss)
364  (cond
365    ((null? xss)
366     (lambda (xs)
367       (Drop-while ok? xs)))
368    ((null? (cdr xss))
369     (let* ((xs (car xss))
370            (nil (cond
371                   ((Eager? xs) '())
372                   ((Lazy? xs) eos)
373                   (error 'Drop-while "not a biglist" xs))))
374       (let loop ((xs xs))
375         (cond
376           ((Null? xs) nil)
377           ((ok? (First xs))
378            (loop (Rest xs)))
379           (else xs)))))
380    (else (error 'Drop-while "too many arguments"))))
381
382(define (Drop-until ok? . xss)
383  (cond
384    ((null? xss)
385     (lambda (xs)
386       (Drop-while ok? xs)))
387    ((null? (cdr xss))
388     (let* ((xs (car xss))
389            (nil (cond
390                   ((Eager? xs) '())
391                   ((Lazy? xs) eos)
392                   (error 'Drop-until "not a biglist" xs))))
393       (let loop ((xs xs))
394         (cond
395           ((Null? xs) nil)
396           ((ok? (First xs)) xs)
397           (else (loop (Rest xs)))))))
398    (else (error 'Drop-until "too many arguments"))))
399
400(define BigList->list
401  (case-lambda
402    ((xs)
403     (if (List? xs)
404       (BigList->list (Length xs) xs)
405       (error 'BigList->list "not a biglist" xs)))
406    ((k . xss)
407     (cond
408       ((null? xss)
409        (lambda (xs)
410          (BigList->list k xs)))
411       ((null? (cdr xss))
412        (let ((xs (car xss)))
413          (cond
414            ((Eager? xs) xs)
415            ((Lazy? xs)
416             (let recur ((n 0) (xs xs))
417               (cond
418                 ((Null? xs) '())
419                 ((= n k) '())
420                 (else
421                   (Cons (First xs)
422                         (recur (+ n 1) (Rest xs)))))))
423            (else (error 'BigList->list "not a biglist" xs)))))
424       (else
425         (error 'BigList->list "too many arguments"))))
426    ))
427
428(define (Filter ok? . xss)
429  (cond
430    ((null? xss)
431     (lambda (xs)
432       (Filter ok? xs)))
433    ((null? (cdr xss))
434     (let ((xs (car xss)))
435;      ;; this version is inefficient:
436;      ;; it checks for Eager again and again
437;      (if (BigList? xs)
438;         (let recur ((xs xs))
439;           (cond
440;             ((Null? xs)
441;              (if (Eager? xs) '() eos))
442;             ((ok? (First xs))
443;              (if (Eager? xs)
444;                (Cons (First xs) (recur (Rest xs)))
445;                (Cons (First xs)
446;                      (recur (Rest xs))
447;                      (List? xs))))
448;             (else (recur (Rest xs)))))
449;         (error 'Filter "not a biglist" xs))))
450       (cond
451         ((Eager? xs)
452          (let recur ((xs xs))
453            (cond
454              ((Null? xs) xs)
455              ((ok? (First xs))
456               (Cons (First xs) (recur (Rest xs))))
457              (else (recur (Rest xs))))))
458         ((Lazy? xs)
459          (let recur ((xs xs))
460            (cond
461              ((Null? xs) eos);xs)
462              ((ok? (First xs))
463               (Cons (First xs)
464                     (recur (Rest xs))
465                     (List? xs)))
466              (else (recur (Rest xs))))))
467         (else
468           (error 'Filter "not a biglist" xs)))))
469    (else
470      (error 'Filter "too many arguments"))
471    ))
472
473(define (Map fn . xss)
474  (if (null? xss)
475    (lambda lists
476      (apply Map fn lists))
477    (let ((xs (car xss)))
478      (cond
479        ((Eager? xs)
480         (if ((list-of? BigList?) (cdr xss))
481           (let recur ((xss xss))
482             (if (memv #t (map Null? xss))
483               '()
484               (cons (apply fn (map First xss))
485                     (recur (map Rest xss)))))
486           (error 'Map "not a list of biglists" xss)))
487        ((Lazy? xs)
488         (if ((list-of? BigList?) (cdr xss))
489           (let recur ((xss xss))
490             (if (memv #t (map Null? xss))
491               eos
492               (Cons (apply fn (map First xss))
493                     (recur (map Rest xss))
494                     (and? (map List? xss)))))
495           (error 'Map "not a list of biglists" xss)))
496        (else
497          (error 'Map "not a biglists" xs))
498        ))
499    ))
500
501(define (For-each fn . xss)
502  (if ((list-of? BigList?) xss)
503    (if (null? xss)
504      (lambda lists
505        (apply For-each fn lists))
506      (unless (memq #t (map Null? xss))
507        (cond
508          (((list-of? Eager?) xss)
509           (apply fn (map First xss))
510           (apply For-each fn (map Rest xss)))
511          (((list-of? Lazy?) xss)
512           (apply fn (map First xss))
513           (apply For-each fn (map Rest xss)))
514          (else
515            (error 'For-each "not all either eager or lazy" xss))
516          )))
517    (error 'For-each "not a list of biglists" xss)
518    ))
519
520(define (Append xs . xss)
521  (if (BigList? xs)
522    (cond
523      ((null? xss) xs)
524      ((null? (cdr xss))
525       (let ((ys (First xss)))
526         (cond
527           ((and (List? xs) (Eager? ys))
528            (if (Null? xs)
529              ys
530              (Cons (First xs) (Append (Rest xs) ys))))
531           ((and (List? xs) (BigList? ys))
532            (if (Null? xs)
533              ys
534              (Cons (First xs)
535                       (Append (Rest xs) ys)
536                       (List? ys))))
537           (else
538             (error 'Append "invalid arguments" xs ys)))))
539      (else
540        (Append xs (apply Append (car xss) (cdr xss)))))
541    (error 'Append "not a biglist" xs)))
542
543(define (Reverse xs . xss)
544  (cond
545    ((null? xss)
546     (cond
547       ((Eager? xs)
548        (Reverse xs '()))
549       ((List? xs)
550        (Reverse xs eos))
551       (else (error "not a finite biglist" xs))))
552    ((null? (cdr xss))
553     (let ((ys (car xss)))
554       (cond
555         ((and (Eager? xs) (Eager? ys))
556          (let loop ((xs xs) (result ys))
557            (if (Null? xs)
558              result
559              (loop (Rest xs)
560                    (Cons (First xs) result)))))
561         ((and (List? xs) (Eager? ys))
562          (let loop ((xs xs) (result ys))
563            (if (Null? xs)
564              result
565              (loop (Rest xs)
566                    (Cons (First xs) result)))))
567         ((and (Eager? xs) (BigList? ys))
568          (let loop ((xs xs) (result ys))
569            (if (Null? xs)
570              result
571              (loop (Rest xs)
572                    (Cons (First xs) result (List? ys))))))
573         ((and (List? xs) (BigList? ys))
574          (let loop ((xs xs) (result ys))
575            (if (Null? xs)
576              result
577              (loop (Rest xs)
578                    (Cons (First xs) result (List? ys))))))
579         (else
580           (error 'Reverse "invalid arguments" xs ys)))))
581    (else (error 'Reverse "too many arguments"))))
582
583(define (Reverse* xs)
584  (cond
585    ((Eager? xs)
586     (let recur ((k 0))
587       (if (> k (Length xs))
588         '()
589         (Cons (Reverse (Take k xs)) (recur (+ k 1))))))
590    ((BigList? xs)
591     (let recur ((k 0))
592       (cond
593         ((not (Length xs))
594          (Cons (Reverse (Take k xs))
595                   (recur (+ k 1))
596                   #f))
597         (else
598           (if (> k (Length xs))
599             eos
600             (Cons (Reverse (Take k xs))
601                      (recur (+ k 1))
602                      #t))
603           ))))
604    (else (error 'Reverse* "not a biglist" xs))))
605
606(define (Zip xs ys)
607  (cond
608    ((and (Eager? xs) (Eager? ys))
609     (let recur ((xs xs) (ys ys))
610       (if (Null? xs)
611         ys
612         (Cons (First xs) (recur ys (Rest xs))))))
613    ((and (BigList? xs) (BigList? ys))
614     (let recur ((xs xs) (ys ys))
615       (if (Null? xs)
616         ys
617         (Cons (First xs)
618                  (recur ys (Rest xs))
619                  (and (List? xs) (List? ys))))))
620    (else
621      (error 'Zip "invalid arguments" xs ys))))
622
623(define (Unzip xs)
624  (cond
625    ((Eager? xs)
626     (let ((one
627             (let ((ev? #f))
628               (let recur ((xs xs))
629                 (cond
630                   ((Null? xs) '())
631                   (else
632                     (set! ev? (not ev?))
633                     (if ev?
634                       (Cons (First xs) (recur (Rest xs)))
635                       (recur (Rest xs))
636                       ))))))
637           (two
638             (let ((ev? #f))
639               (let recur ((xs xs))
640                 (cond
641                   ((Null? xs) '())
642                   (else
643                     (set! ev? (not ev?))
644                     (if ev?
645                       (recur (Rest xs))
646                       (Cons (First xs) (recur (Rest xs))))))))))
647       (values one two)))
648    ((BigList? xs)
649     (let ((finite? (List? xs)))
650       (let ((one
651               (let ((ev? #f))
652                 (let recur ((xs xs))
653                   (cond
654                     ((Null? xs) eos)
655                     (else
656                       (set! ev? (not ev?))
657                       (if ev?
658                         (Cons (First xs) (recur (Rest xs)) finite?)
659                         (recur (Rest xs))
660                         ))))))
661             (two
662               (let ((ev? #f))
663                 (let recur ((xs xs))
664                   (cond
665                     ((Null? xs) eos)
666                     (else
667                       (set! ev? (not ev?))
668                       (if ev?
669                         (recur (Rest xs))
670                         (Cons (First xs) (recur (Rest xs)) finite?))))))))
671         (values one two))))
672    (else (error 'Unzip "not a biglist" xs))))
673
674(define (Sorted? <? . xss)
675  (cond
676    ((null? xss)
677     (lambda (xs)
678       (Sorted? <? xs)))
679    ((null? (cdr xss))
680     (let ((xs (car xss)))
681       (if (List? xs)
682         (let loop ((xs xs))
683           (cond
684             ((Null? xs) #t)
685             ((Null? (Rest xs)) #t)
686             ((<? (First xs) (First (Rest xs)))
687              (loop (Rest xs)))
688             (else #f)))
689         (error 'Sorted? "not a finite biglist" xs))))
690    (else (error 'Sorted? "too many arguments"))))
691
692(define (Merge <? xs ys)
693  (if (and (Sorted? xs) (Sorted? ys))
694    (cond
695      ((and (Eager? xs) (Eager? ys))
696       (let recur ((xs xs) (ys ys))
697         (cond
698           ((Null? xs) ys)
699           ((Null? ys) xs)
700           ((<? (First xs) (First ys))
701            (Cons (First xs) (recur (Rest xs) ys)))
702           (else
703             (Cons (First ys) (recur xs (Rest ys)))))))
704      ((and (Lazy? xs) (Lazy? ys))
705       (let recur ((xs xs) (ys ys))
706         (cond
707           ((Null? xs) ys)
708           ((Null? ys) xs)
709           ((<? (First xs) (First ys))
710            (Cons (First xs) (recur (Rest xs) ys) #t))
711           (else
712             (Cons (First ys) (recur xs (Rest ys)) #t)))))
713      (else (error 'Merge "arguments not both lazy or eager" xs ys)))
714    (error 'Merge "arguments not sorted" xs ys)))
715
716(define (Sort <? . xss)
717  (cond
718    ((null? xss)
719     (lambda (xs)
720       (Sort <? xs)))
721    ((null? (cdr xss))
722     (let ((xs (car xss)))
723       (if (List? xs)
724         (let* ((xs xs) (len (Length xs)))
725           (if (< len 2)
726             xs
727             (let ((halflen (round (/ len 2))))
728               (Merge <?
729                      (Sort <? (Take halflen xs))
730                      (Sort <? (Drop halflen xs))))))
731         (error 'Sort "not a finite biglist" xs))))
732    (else (error 'Sort "too many arguments"))))
733
734(define (Every? ok? . xss)
735  (cond
736    ((null? xss)
737     (lambda (xs)
738       (Every? ok? xs)))
739    ((null? (cdr xss))
740     (let ((xs (car xss)))
741       (if (List? xs)
742         (let loop ((xs xs))
743           (cond
744             ((Null? xs) #t)
745             ((ok? (First xs))
746              (loop (Rest xs)))
747             (else #f)))
748         (error 'Every? "not a finite biglist" xs))))
749    (else (error 'Every? "too many arguments"))))
750
751(define (Some? ok? . xss)
752  (cond
753    ((null? xss)
754     (lambda (xs)
755       (Some? ok? xs)))
756    ((null? (cdr xss))
757     (let ((xs (car xss)))
758       (if (List? xs)
759         (let loop ((xs xs))
760           (cond
761             ((Null? xs) #f)
762             ((ok? (First xs)) #t)
763             (else
764               (loop (Rest xs)))))
765         (error 'Some? "not a finite biglist" xs))))
766    (else (error 'Some? "too many arguments"))))
767
768(define (Index ok? . xss)
769  (cond
770    ((null? xss)
771     (lambda (xs)
772       (Index ok? xs)))
773    ((null? (cdr xss))
774     (let ((xs (car xss)))
775       (if (BigList? xs)
776         (let loop ((xs xs) (k 0))
777           (cond
778             ((Null? xs) #f)
779             ((ok? (First xs)) k)
780             (else (loop (Rest xs) (+ k 1)))))
781         (error 'Index "not a biglist" xs))))
782    (else (error 'Index "too many arguments"))))
783
784(define (Memp ok? . xss)
785  (cond
786    ((null? xss)
787     (lambda (xs)
788       (Memp ok? xs)))
789    ((null? (cdr xss))
790     (if (BigList? (car xss))
791       (let* ((xs (car xss))
792              (nil (cond
793                     ((Eager? xs) '())
794                     ((Lazy? xs) eos)
795                     (else (error 'Memp "not a biglist" xs)))))
796         (let loop ((xs xs))
797           (cond
798             ((Null? xs) nil)
799             ((ok? (First xs)) xs)
800             (else (loop (Rest xs))))))))
801    (else (error 'Memp "too many arguments"))))
802
803(define (Memq var . xss)
804  (apply Memp (cut eq? <> var) xss))
805
806(define (Memv var . xss)
807  (apply Memp (cut eqv? <> var) xss))
808
809(define (Member var . xss)
810  (apply Memp (cut equal? <> var) xss))
811
812(define Eqp?
813  (case-lambda
814    ((=?)
815     (lambda (xs ys)
816       (Eqp? =? xs ys)))
817    ((=? xs ys)
818     (cond
819       ((and (Eager? xs) (Lazy? ys)) #f)
820       ((and (Lazy? xs) (Eager? ys)) #f)
821       ((not (eqv? (Length xs) (Length ys))) #f) 
822       ((and (List? xs) (List? ys)) 
823        (let loop ((xs xs) (ys ys))
824          (cond
825            ((and (Null? xs) (Null? ys))
826             #t)
827            ((=? (First xs) (First ys))
828             (loop (Rest xs) (Rest ys)))
829            (else #f))))
830       ((and (BigList? xs) (BigList? ys))
831        (eqv? xs ys))
832       (else (equal? xs ys))))
833    ))
834
835(define Eq? (Eqp? eq?))
836(define Eqv? (Eqp? eqv?))
837(define Equal? (Eqp? equal?))
838
839(define (Assp ok? . xss)
840  (cond
841    ((null? xss)
842     (lambda (xs)
843       (Assp ok? xs)))
844    ((null? (cdr xss))
845     (let ((xs (car xss)))
846       (cond
847         (((List-of? BigList?) xs)
848          (let loop ((xs xs))
849            (cond
850              ((Null? xs) #f)
851              ((ok? (First (First xs)))
852               (First xs))
853              (else (loop (Rest xs))))))
854         (else (error 'Assp "not a finite biglist" xs)))))
855    (else (error 'Assp "too many arguments"))
856    ))
857
858(define (Assq key . xss)
859  (apply Assp (cut eq? <> key) xss))
860
861(define (Assv key . xss)
862  (apply Assp (cut eqv? <> key) xss))
863
864(define (Assoc key . xss)
865  (apply Assp (cut equal? <> key) xss))
866
867(define (Remp ok? . xss)
868  (cond
869    ((null? xss)
870     (lambda (xs) (Remp ok? xs)))
871    ((null? (cdr xss))
872     (Filter (o not ok?) (car xss)))
873    (else (error 'Remp "too many arguements"))))
874
875(define (Remove val . xss)
876  (apply Remp (cut equal? <> val) xss))
877
878(define (Remq val . xss)
879  (apply Remp (cut eq? <> val) xss))
880
881(define (Remv val . xss)
882  (apply Remp (cut eqv? <> val) xss))
883
884(define (Fold-right op init . xss)
885  (cond
886    ((null? xss)
887     (lambda pairs
888       (apply Fold-right op init pairs)))
889    (else
890      (if ((list-of? BigList?) xss)
891        (let recur ((xss xss))
892          (if (memv #t (map List? xss))
893            (cond
894              ((memv #t (map Null? xss)) init)
895              (else
896                (apply op
897                       (append (map First xss)
898                               (list (recur (map Rest xss)))))))
899            (error 'Fold-right "all biglists infinite")))
900        (error 'Fold-right "not a list of biglists" xss)))
901      ))
902
903(define (Fold-left op init . xss)
904  (cond
905    ((null? xss)
906     (lambda pairs
907       (apply Fold-left op init pairs)))
908    (else
909      (if ((list-of? BigList?) xss)
910        (let loop ((xss xss) (result init))
911          (if (memv #t (map List? xss))
912            (cond
913              ((memv #t (map Null? xss)) result)
914              (else
915                (loop (map Rest xss)
916                      (apply op result (map First xss)))))
917            (error 'Fold-left "all biglists infinite")))
918        (error 'Fold-left "not a list of biglists" xss)))
919    ))
920
921(define (Fold-right0 op . xss)
922  (cond
923    ((null? xss)
924     (lambda pairs
925       (apply Fold-right0 op pairs)))
926    (else
927      (if ((list-of? List?) xss)
928        (let ((cars (map First xss)))
929          (if (not (memq eos cars))
930            (apply Fold-right
931                   op
932                   (apply op cars) 
933                   (map Rest xss))
934            (error 'Fold-right0 "some biglist empty")))
935        (error 'Fold-right0 "not a list of finite biglists" xss)))))
936;(define (Fold-right0 op . xss)
937;  (cond
938;    ((null? xss)
939;     (lambda (xs)
940;       (Fold-right0 op xs)))
941;    ((null? (cdr xss))
942;     (let ((xs (car xss)))
943;       (if (List? xs)
944;         (if (Null? xs)
945;           (error 'Fold-right0 "biglist empty")
946;           (Fold-right op (First xs) (Rest xs)))
947;         (error 'Fold-ritht0 "not a finite biglist"))))
948;    (else (error 'Fold-right0 "too many arguments"))))
949
950(define (Fold-left0 op . xss)
951  (cond
952    ((null? xss)
953     (lambda pairs
954       (apply Fold-left0 op pairs)))
955    (else
956      (if ((list-of? List?) xss)
957        (let ((cars (map First xss)))
958          (if (not (memq eos cars))
959            (apply Fold-left
960                   op
961                   (apply op cars) 
962                   (map Rest xss))
963            (error 'Fold-left0 "some biglist empty")))
964        (error 'Fold-left0 "not a list of finite biglists" xss)))))
965;(define (Fold-right0 op . xss)
966;  (cond
967;    ((null? xss)
968;     (lambda (xs)
969;       (Fold-left0 op xs)))
970;    ((null? (cdr xss))
971;     (let ((xs (car xss)))
972;       (if (List? xs)
973;         (if (Null? xs)
974;           (error 'Fold-left0 "biglist empty")
975;           (Fold-left op (First xs) (Rest xs)))
976;         (error 'Fold-left0 "not a finite biglist"))))
977;    (else (error 'Fold-left0 "too many arguments"))))
978
979(define (Scan-right op init . xss)
980  (cond
981    ((null? xss)
982     (lambda pairs
983       (apply Scan-right op init pairs)))
984    (else
985      (if ((list-of? BigList?) xss)
986        (let ((finite?
987                (if (memv #t (map List? xss)) #t #f)))
988          (let recur ((n 0) (tails xss))
989            (if (memv #t (map Null? tails))
990              eos
991              (Cons (apply Fold-right op init (map (Take n) xss))
992                    (recur (+ n 1) (map Rest tails))
993                    finite?))))
994        (error 'Scan-right "not a list of biglists" xss)))))
995
996(define (Scan-left op init . xss)
997  (cond
998    ((null? xss)
999     (lambda pairs
1000       (apply Scan-left op init pairs)))
1001    (else
1002      (if ((list-of? BigList?) xss)
1003        (let ((finite?
1004                (if (memv #t (map List? xss)) #t #f)))
1005          (let recur ((n 0) (tails xss))
1006            (if (memv #t (map Null? tails))
1007              eos
1008              (Cons (apply Fold-left op init (map (Take n) xss))
1009                    (recur (+ n 1) (map Rest tails))
1010                    finite?))))
1011        (error 'Scan-left "not a list of biglists" xss)))))
1012
1013(define Range
1014  (case-lambda
1015    ((upto)
1016     (cond
1017       ((not upto) ; infinite case
1018        (Range 0 upto 1))
1019       ((>= upto 0)
1020        (Range 0 upto 1))
1021       (else
1022         (Range 0 upto -1))))
1023    ((from upto)
1024     (cond
1025       ((not upto) ; infinite case
1026        (Range from upto 1))
1027       ((>= upto from)
1028        (Range from upto 1))
1029       (else
1030         (Range from upto -1))))
1031    ((from upto step)
1032     (let ((from (if (integer? from)
1033                   from
1034                   (error 'Range "not an integer" from)))
1035           (upto (if (or (not upto) (integer? upto))
1036                   upto
1037                   (error 'Range "neither an integer nor #f" upto)))
1038           (step (if (integer? step)
1039                   step
1040                   (error 'Range "not an integer" step))))
1041       (let recur ((k from))
1042         (cond
1043           ((not upto) ; infinite case
1044            (Cons k (recur (+ k step)) #f))
1045           ((and (>= upto from) (positive? step))
1046            (if (>= k upto)
1047              eos
1048              (Cons k (recur (+ k step)) #t)))
1049           ((and (< upto from) (negative? step))
1050            (if (<= k upto)
1051              eos
1052              (Cons k (recur (+ k step)) #t)))
1053           (else
1054             (error 'Range "wrong sign of" step))))))
1055    ))
1056
1057(define (Repeat x)
1058  (Cons x (Repeat x) #f))
1059
1060(define (Repeat-times k x)
1061  (Take k (Repeat x)))
1062
1063(define (Iterate-while fn ok? . xs)
1064  (Take-while ok? (apply Iterate fn xs)))
1065
1066(define (Iterate-until fn ok? . xs)
1067  (Take-until ok? (apply Iterate fn xs)))
1068
1069(define (Iterate-times fn k . xs)
1070  (Take k (apply Iterate fn xs)))
1071
1072(define (Iterate fn . xs)
1073  (cond
1074    ((null? xs)
1075     (lambda (x)
1076       (Iterate fn x)))
1077    ((null? (cdr xs))
1078     (let recur ((x (First xs)))
1079       (Cons x (recur (fn x)) #f)))
1080    (else 'Iterate "too many arguments")))
1081
1082(define (Cycle xs)
1083  (cond
1084    ((Eager? xs)
1085     (Cycle (apply List xs)))
1086    ((List? xs)
1087     (if (Null? xs)
1088       eos
1089       (let recur ((tail xs))
1090         (if (Null? tail)
1091           (recur xs)
1092           (Cons (First tail) (recur (Rest tail)) #f)))))
1093    (else (error 'Cycle "not a finite biglist" xs))))
1094
1095(define (Cycle-times k xs)
1096  (Take k (Cycle xs)))
1097
1098(define Print
1099  (case-lambda
1100    ((k xs)
1101     (if (BigList? xs)
1102       (let loop ((n 0) (xs xs))
1103         (unless (= n k)
1104           (print (First xs))
1105           (loop (+ n 1) (Rest xs))))
1106       (error 'Print "not a biglist" xs)))
1107    ((xs)
1108     (if (List? xs)
1109       (let ((xs xs))
1110         (Print (Length xs) xs))
1111       (error 'Print "not a finite biglist" xs)))
1112    ))
1113
1114;;; (For ((var xs ok-xpr ...) (var1 xs1 ok-xpr1 ...) ...) item-xpr)
1115;;; ---------------------------------------------------------------
1116(define-syntax For
1117  (syntax-rules ()
1118   ((_ ((var xs ok-xpr ...)) item-xpr)
1119    (cond
1120      ((Eager? xs)
1121       (let recur ((seq xs))
1122         (if (Null? seq)
1123           '()
1124           (let ((var (First seq)))
1125             (if (and ok-xpr ...)
1126               (Cons item-xpr (recur (Rest seq)))
1127               (recur (Rest seq)))))))
1128      ((Lazy? xs)
1129       (let recur ((seq xs))
1130         (if (Null? seq)
1131           eos
1132           (let ((var (First seq)))
1133             (if (and ok-xpr ...)
1134               (Cons item-xpr (recur (Rest seq)) #t)
1135               (recur (Rest seq)))))))
1136      (else (error 'For "not a biglist" xs))))
1137    ((_ ((var xs ok-xpr ...) (var1 xs1 ok-xpr1 ...) ...) item-xpr)
1138     (let recur ((seq xs))
1139       (if (Null? seq)
1140         (cond
1141           ((Eager? seq) '())
1142           ((Lazy? seq) eos)
1143           (else (error 'For "not a biglist" seq)))
1144         (let ((var (First seq)))
1145           (if (and ok-xpr ...)
1146             (Append (For ((var1 xs1 ok-xpr1 ...) ...) item-xpr)
1147                     (recur (Rest seq)))
1148             (recur (Rest seq)))))))
1149    ))
1150
1151(define (Read-forever)
1152  (Map (lambda (x) (x))
1153       (Repeat (lambda ()
1154                 (print* "enter a scheme object (stop with Ctrl-C): ")
1155                 (let ((obj (read)))
1156                   (print obj)
1157                   obj)))))
1158   
1159;;; make biglists accessible to pattern matching
1160;;; ----------------------------------------------
1161(bind-seq-db BigList?
1162             #:ref (lambda (xs k) (At k xs))
1163             #:tail (lambda (xs k) (Drop k xs)))
1164
1165;(define (integers-from n)
1166;  (Cons n (integers-from (+ n 1)) #f))
1167;
1168;(define integers (integers-from 0))
1169
1170;;; (biglists sym ..)
1171;;; ----------------------------
1172;;; documentation procedure
1173(define biglists
1174  (let ((als '(
1175    (biglists
1176      procedure:
1177      (biglists sym ..)
1178      "documentation procedure")
1179    (Append
1180      procedure:
1181      (Append xs . xss)
1182      "appends all argument lists, provided all but the last"
1183      "are finite")
1184    (Assoc
1185      procedure:
1186      (Assoc key)
1187      (Assoc key xs)
1188      "returns the biglist, whose First or car is Equal? to key")
1189    (Assp
1190      procedure:
1191      (Assp ok?)
1192      (Assp ok? xs)
1193      "returns the biglist, whose First or car passes ok?")
1194    (Assq
1195      procedure:
1196      (Assq key)
1197      (Assq key xs)
1198      "returns the biglist, whose First or car is Eq? to key")
1199    (Assv
1200      procedure:
1201      (Assv key)
1202      (Assv key xs)
1203      "returns the biglist, whose First or car is Eqv? to key")
1204    (At
1205      procedure:
1206      (At k)
1207      (At k xs)
1208      "returns the kth item of xs")
1209    (BigList?
1210      procedure:
1211      (BigList? xpr)
1212      "type predicate")
1213    (BigList->list
1214      procedure:
1215      (BigList->list xs)
1216      (BigList->list k xs)
1217      "transforms a possibly infinite biglist xs into a list")
1218    (Cons
1219      macro:
1220      (Cons x y finite?)
1221      (Cons x y)
1222      "returns either a lazy or an eager biglist")
1223    (Cycle
1224      procedure:
1225      (Cycle xs)
1226      "returns an infinite biglist by appending the finite"
1227      "biglist xs over and over")
1228    (Cycle-times
1229      procedure:
1230      (Cycle k xs)
1231      "returns a finite biglist by appending the finite"
1232      "biglist xs k times")
1233    (Drop
1234      procedure:
1235      (Drop k)
1236      (Drop k xs)
1237      "drops the first k items of xs")
1238    (Drop-while
1239      procedure:
1240      (Drop-while ok?)
1241      (Drop-while ok? xs)
1242      "returns the xs whith those front items x removed"
1243      "which pass ok?")
1244    (Drop-until
1245      procedure:
1246      (Drop-until ok?)
1247      (Drop-until ok? xs)
1248      "returns the xs whith those front items x removed"
1249      "which don't pass ok?")
1250    (Eager?
1251      procedure:
1252      (Eager? xpr)
1253      "is xpr an eager biglist, i.e. a normal list?")
1254    (Eq?
1255      procedure:
1256      (Eq? xs ys)
1257      "returns #t if both lists have same length"
1258      "and corresponding items are eq?")
1259    (Eqp?
1260      procedure:
1261      (Eqp? =?)
1262      (Eqp? =? xs ys)
1263      "returns #t if both lists have same length"
1264      "and corresponding items are =?")
1265    (Equal?
1266      procedure:
1267      (Equal? xs ys)
1268      "returns #t if both lists have same length"
1269      "and corresponding items are equal?")
1270    (Eqv?
1271      procedure:
1272      (Eqv? xs ys)
1273      "returns #t if both lists have same length"
1274      "and corresponding items are eqv?")
1275    (Every?
1276      procedure:
1277      (Every? ok?)
1278      (Every? ok? xs)
1279      "returns #t if every item of the finite biglist xs"
1280      "passes the ok? test")
1281    (Filter
1282      procedure:
1283      (Filter ok?)
1284      (Filter ok? xs)
1285      "removes all items from the biglist xs which"
1286      "do not pass the ok? test")
1287    (Fold-left
1288      procedure:
1289      (Fold-left op init)
1290      (Fold-left op init . xss)
1291      "folds the finite biglists xss from the left")
1292    (Fold-left0
1293      procedure:
1294      (Fold-left0 op)
1295      (Fold-left0 op . xss)
1296      "folds the finite biglists (map Rest xss) from the left"
1297      "with init (map First xss)")
1298    (Fold-right
1299      procedure:
1300      (Fold-right op init)
1301      (Fold-right op init . xss)
1302      "folds the finite biglists xss from the right")
1303    (Fold-right0
1304      procedure:
1305      (Fold-right0 op)
1306      (Fold-right0 op . xss)
1307      "folds the finite biglists (map Rest xss) from the right"
1308      "with init (map First xss)")
1309    (For
1310      macro:
1311      (For ((var xs ok-xpr ...) (var1 xs1 ok-xpr1 ...) ...) item-xpr)
1312      "creates a new list by binding var to each element"
1313      "of the list xs in sequence, and if it passes the checks,"
1314      "ok-xpr ..., inserts the value of item-xpr into the result list."
1315      "The qualifieres, (var xs ok-xpr ...), are processed"
1316      "sequentially from left to right, so that filters of a"
1317      "qualifier have access to the variables of qualifiers"
1318      "to its left.")
1319    (For-each
1320      procedure:
1321      (For-each fn)
1322      (For-each fn . xss)
1323      "applies the procedure fn to each list of items"
1324      "of xss at each commeon index")
1325    (First
1326      procedure:
1327      (First xs)
1328      "returns the front item of xs, which might be eos"
1329      "if xs is empty")
1330    (Index
1331      procedure:
1332      (Index ok?)
1333      (Index ok? xs)
1334      "returns the index of the first item of the biglist xs,"
1335      "which passes the ok? test")
1336    (Iterate
1337      procedure:
1338      (Iterate fn)
1339      (Iterate fn x)
1340      "returns an infinite list by iteratively"
1341      "applying fn to x")
1342    (Iterate-times
1343      procedure:
1344      (Iterate-times fn times)
1345      (Iterate-times fn times x)
1346      "returns a finite list of lentgh times by"
1347      "iteratively applying fn to x")
1348    (Iterate-until
1349      procedure:
1350      (Iterate-until fn ok?)
1351      (Iterate-until fn ok? x)
1352      "returns a finite list by iteratively applying"
1353      "fn to x until ok? returns #t on the result")
1354    (Iterate-while
1355      procedure:
1356      (Iterate-while fn ok?)
1357      "returns a finite list by iteratively applying"
1358      "fn to x as long as ok? returns #t on the result")
1359    (Lazy?
1360      procedure:
1361      (Lazy? xpr)
1362      "is xpr a lazy biglist?")
1363    (Length
1364      procedure:
1365      (Length xs)
1366      "retuns the length of a finite biglist or #f"
1367      "of an infinite one")
1368    (List
1369      procedure:
1370      (List . args)
1371      "creates a lazy finite biglist with items args")
1372    (List?
1373      procedure:
1374      (List? xpr)
1375      "is xpr a finite biglist?")
1376    (List-of?
1377      procedure:
1378      (List-of? . oks?)
1379      (List-of? k . oks?)
1380      "returs a predicate on a biglist, which checks,"
1381      "if every item (or Take k item) is a finite biglist")
1382    (Map
1383      procedure:
1384      (Map fn)
1385      (Map fn . xss)
1386      "maps every list of of items at fixed index of xss"
1387      "with function fn")
1388    (Member
1389      procedure:
1390      (Member x)
1391      (Member x xs)
1392      "returns the first tail af the biglist xs" 
1393      "whose first item is equal? to x")
1394    (Memp
1395      procedure:
1396      (Memp ok?)
1397      (Memp ok? xs)
1398      "returns the first tail af the biglist xs" 
1399      "which passes the ok? test")
1400    (Memq
1401      procedure:
1402      (Memq x)
1403      (Memq x xs)
1404      "returns the first tail af the biglist xs" 
1405      "whose first item is eq? to x")
1406    (Memv
1407      procedure:
1408      (Memv x)
1409      (Memv x xs)
1410      "returns the first tail af the biglist xs" 
1411      "whose first item is eqv? to x")
1412    (Merge
1413      procedure:
1414      (Merge <? xs ys)
1415      "merges two finite finite biglists xs and ys,"
1416      "both lazy or both eager, with respect to <?")
1417    (Null?
1418      procedure:
1419      (Null? xs)
1420      "is the biglist xs empty?")
1421    (Print
1422      procedure:
1423      (Print k xs)
1424      (Print xs)
1425      "print the items of a finite biglist,"
1426      "or the first k items of an infinite one")
1427    (Range
1428      procedure:
1429      (Range upto)
1430      (Range from upto)
1431      (Range from upto step)
1432      "creates a list of numbers with given limits"
1433      "from defaults to 0"
1434      "step defaults to 1"
1435      "the list is infinite, if utpo is #f")
1436    (Read-forever
1437      procedure:
1438      (Read-forever)
1439      "creates an infinite biglist of prompted"
1440      "read procedures")
1441    (Remove
1442      procedure:
1443      (Remove x)
1444      (Remove x xs)
1445      "removes all items of the biglist xs, which"
1446      "are equal? to x")
1447    (Remp
1448      procedure:
1449      (Remp ok?)
1450      (Remp ok? xs)
1451      "removes all items of the biglist xs, which"
1452      "pass the ok? test")
1453    (Remq
1454      procedure:
1455      (Remp x)
1456      (Remp x xs)
1457      "removes all items of the biglist xs, which"
1458      "are eq? to x")
1459    (Remv
1460      procedure:
1461      (Remp x)
1462      (Remp x xs)
1463      "removes all items of the biglist xs, which"
1464      "are eqv? to x")
1465    (Repeat
1466      procedure:
1467      (Repeat x)
1468      "returns an infinite biglist with all items x")
1469    (Repeat-times
1470      procedure:
1471      (Repeat-times k x)
1472      "returns a finite biglist of length k with all items x")
1473    (Rest
1474      procedure:
1475      (Rest xs)
1476      "returns the rest of the list except the front item"
1477      "which might be xs itself if empty")
1478    (Reverse
1479      procedure:
1480      (Reverse xs)
1481      (Reversee xs ys)
1482      "Append the reverse of xs to ys"
1483      "xs must be finite")
1484    (Reverse*
1485      procedure:
1486      (Reverse* xs)
1487      "retrurns the list of reverses of"
1488      "of all finite takes")
1489    (Scan-left
1490      procedure:
1491      (Scan-left op init)
1492      (Scan-left op init . xss)
1493      "returns a biglist, whose item at index k"
1494      "is the left fold of (map (Take k) xss)")
1495    (Scan-right
1496      procedure:
1497      (Scan-right op init)
1498      (Scan-right op init . xss)
1499      "returns a biglist, whose item at index k"
1500      "is the right fold of (map (Take k) xss)")
1501    (Some?
1502      procedure:
1503      (Some? ok?)
1504      (Some? ok? xs)
1505      "returns #t if some item of the finite biglist xs"
1506      "passes the ok? test")
1507    (Sort
1508      procedure:
1509      (Sort <?)
1510      (Sort <? xs)
1511      "sorts the finite biglist xs with respect to <?")
1512    (Sorted?
1513      procedure:
1514      (Sorted? <?)
1515      (Sorted? <? xs)
1516      "is the biglist xs finite and sorted?")
1517    (Take
1518      procedure:
1519      (Take k)
1520      (Take k xs)
1521      "returns the finite biglist of the first"
1522      "k items of the biglist xs")
1523    (Take-until
1524      procedure:
1525      (Take-until ok?)
1526      (Take-until ok? xs)
1527      "returns the finite biglist of the first"
1528      "items of the biglist xs, which do not pass"
1529      "the ok? test")
1530    (Take-while
1531      procedure:
1532      (Take-while ok?)
1533      (Take-while ok? xs)
1534      "returns the finite biglist of the first"
1535      "items of the biglist xs, which do pass"
1536      "the ok? test")
1537    (Unzip
1538      procedure:
1539      (Unzip xs)
1540      "returns two values, the sublists of biglist xs"
1541      "of even or uneven index")
1542    (Zip
1543      procedure:
1544      (Zip xs ys)
1545      "merges the biglists xs and ys by alternatively"
1546      "Consing (First xs) or (First ys) to the result"
1547      "biglist. Works for unfinite biglists as well.")
1548    (eos
1549      "end-of-sequence indicator")
1550;    (integers
1551;      "non-negative integers")
1552    )))
1553    (case-lambda
1554      (()
1555       (map car als))
1556      ((sym)
1557       (let ((pair (assq sym als)))
1558         (if pair
1559           (for-each print (cdr pair))
1560           (error "Not in list"
1561                  sym
1562                  (map car als))))))))
1563
1564) ; module biglists
1565
Note: See TracBrowser for help on using the repository browser.