Index: /release/5/biglists/tags/0.1.2/biglists.egg
===================================================================
--- /release/5/biglists/tags/0.1.2/biglists.egg (revision 37454)
+++ /release/5/biglists/tags/0.1.2/biglists.egg (revision 37454)
@@ -0,0 +1,11 @@
+((synopsis
+ "a uniform interface to lists and lazy-lists")
+ (category lang-exts)
+ (license "BSD")
+ (test-dependencies bindings simple-tests)
+ (dependencies bindings)
+ (author "[[Juergen Lorenz]]")
+ (version "0.1.2")
+ (components (extension biglists)))
+
+
Index: /release/5/biglists/tags/0.1.2/biglists.scm
===================================================================
--- /release/5/biglists/tags/0.1.2/biglists.scm (revision 37454)
+++ /release/5/biglists/tags/0.1.2/biglists.scm (revision 37454)
@@ -0,0 +1,1565 @@
+; Author: Juergen Lorenz ; ju (at) jugilo (dot) de
+;
+; Copyright (c) 2013-2019, Juergen Lorenz
+; All rights reserved.
+;
+; Redistribution and use in source and binary forms, with or without
+; modification, are permitted provided that the following conditions are
+; met:
+;
+; Redistributions of source code must retain the above copyright
+; notice, this list of conditions and the following dispasser.
+;
+; Redistributions in binary form must reproduce the above copyright
+; notice, this list of conditions and the following dispasser in the
+; documentation and/or other materials provided with the distribution.
+;
+; Neither the name of the author nor the names of its contributors may be
+; used to endorse or promote products derived from this software without
+; specific prior written permission.
+;
+; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+; IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+; TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+; PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+; HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
+; TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+
+#|[
+This is another implementation of lazy-lists. Contrary to other
+implementations this one
+-- is able to distinguish between finite and infinite lazy lists
+-- implements most routines so that they can be used as partial routines
+-- all routines are named with uppercase first letter, so that
+ they don't conflict with equally named standard list routines
+-- arguments have standard orders:
+ procedure arguments first, biglist arguments last
+]|#
+
+(module biglists (
+ Append
+ Assoc
+ Assp
+ Assq
+ Assv
+ At
+ BigList?
+ BigList->list
+ Cons
+ Cycle
+ Cycle-times
+ Drop
+ Drop-while
+ Drop-until
+ Eager?
+ Eq?
+ Eqp?
+ Equal?
+ Eqv?
+ Every?
+ Filter
+ Fold-left
+ Fold-left0
+ Fold-right
+ Fold-right0
+ For
+ For-each
+ First
+ Index
+ Iterate
+ Iterate-times
+ Iterate-until
+ Iterate-while
+ Lazy?
+ Length
+ List
+ List?
+ List-of?
+ Map
+ Member
+ Memp
+ Memq
+ Memv
+ Merge
+ Null?
+ Print
+ Range
+ Read-forever
+ Remove
+ Remp
+ Remq
+ Remv
+ Repeat
+ Repeat-times
+ Rest
+ Reverse
+ Reverse*
+ Scan-left
+ Scan-right
+ Some?
+ Sort
+ Sorted?
+ Take
+ Take-until
+ Take-while
+ Unzip
+ Zip
+ biglist-lazy
+ biglists
+ eos
+ )
+
+
+ (import scheme (chicken base) (only bindings eos bind-seq-db))
+
+(define (and? . xprs)
+ (call/cc
+ (lambda (out)
+ (for-each (lambda (x) (or x (out #f)))
+ xprs)
+ #t)))
+
+(define-record-type lazy
+ (biglist-lazy first rest finite?)
+ lazy?
+ (first lazy-first)
+ (rest lazy-rest)
+ (finite? lazy-finite?))
+
+(define-record-printer (lazy xs out)
+ (let ((start "(Lazy[") (stop ")"))
+ (display start out)
+ (display (if (List? xs)
+ "finite"
+ "infinite") out)
+ (display "]" out)
+ (cond ((and (Lazy? xs) (List? xs))
+ (let loop ((xs xs))
+ (if (Null? xs)
+ (display stop out)
+ (begin
+ (display " " out)
+ (write (First xs) out)
+ (loop (Rest xs))))))
+ ((and (Lazy? xs) (not (List? xs)))
+ (let loop ((k 0) (xs xs))
+ (cond
+ ((= k 10)
+ (display " ..." out)
+ (display stop out))
+ (else
+ (display " " out)
+ (write (First xs) out)
+ (loop (+ k 1) (Rest xs)))))))))
+
+(define-syntax Cons
+ (syntax-rules ()
+ ((_ x y finite?)
+ (biglist-lazy (delay x) (delay y) finite?))
+ ((_ x y) (cons x y))
+ ))
+
+(define (BigList? xpr)
+ (or
+ (list? xpr)
+ (eq? xpr eos) ;;;;;;
+ (and (lazy? xpr)
+ (promise? (lazy-first xpr))
+ (promise? (lazy-rest xpr))
+ (boolean? (lazy-finite? xpr)))
+ ))
+
+(define Eager? list?)
+
+(define (Lazy? xpr)
+ (and (BigList? xpr) (not (list? xpr))))
+
+(define (List? xpr) ; finite
+ (or (eq? xpr eos)
+ (Eager? xpr)
+ (and (Lazy? xpr)
+ (lazy-finite? xpr))))
+
+(define List-of?
+ (case-lambda
+ (oks?
+ (lambda (xpr)
+ (apply and?
+ (List? xpr)
+ (BigList->list
+ (Map (lambda (x)
+ (apply and?
+ (map (lambda (ok?) (ok? x))
+ oks?)))
+ xpr)))))
+ ((k . oks?)
+ (lambda (xpr)
+ (and (BigList? xpr)
+ ((apply List-of? oks?)
+ (Take k xpr)))))
+ ))
+
+(define (Null? xs)
+ (and (BigList? xs)
+ (or (eqv? xs '())
+ (eq? xs eos))))
+
+(define (First xs)
+ (cond
+ ((Eager? xs)
+ (if (null? xs)
+ eos
+ (car xs)))
+ ((Lazy? xs)
+ (if (Null? xs)
+ eos
+ (force (lazy-first xs))))
+ (else (error 'First "not a biglist" xs))))
+
+(define (Rest xs)
+ (cond
+ ((list? xs)
+ (if (null? xs)
+ '()
+ (cdr xs)))
+ ((Lazy? xs)
+ (if (Null? xs)
+ xs
+ (force (lazy-rest xs))))
+ (else (error 'Rest "not a biglist" xs))))
+
+(define (Length xs)
+ (if (BigList? xs)
+ (cond
+ ((Eager? xs) (length xs))
+ ((List? xs)
+ (if (Null? xs)
+ 0
+ (+ 1 (Length (Rest xs)))))
+ (else #f))
+ (error 'Length "not a biglist" xs)
+ ))
+
+
+(define (At n . xss)
+ (cond
+ ((null? xss)
+ (lambda (xs)
+ (At n xs)))
+ ((null? (cdr xss))
+ (let ((xs (car xss)))
+ (if (BigList? xs)
+ (if (zero? n)
+ (First xs)
+ (At (- n 1) (Rest xs)))
+ (error 'At "not a biglist" xs))))
+ (else (error 'At "too many arguments"))))
+
+(define (List . args)
+ (if (null? args)
+ eos
+ (Cons (car args)
+ (apply List (cdr args))
+ #t)))
+
+(define (Take k . xss)
+ (cond
+ ((null? xss)
+ (lambda (xs)
+ (Take k xs)))
+ ((null? (cdr xss))
+ (let ((xs (car xss)))
+ (if (BigList? xs)
+ (let ((eager? (Eager? xs)))
+ (cond
+ ((Null? xs) xs)
+ ((zero? k) (if eager? '() eos))
+ (else
+ (if eager?
+ (Cons (First xs) (Take (- k 1) (Rest xs)))
+ (Cons (First xs) (Take (- k 1) (Rest xs)) #t)))))
+ (error 'Take "not a biglist" xs))))
+; (cond
+; ((Eager? xs)
+; (if (zero? k)
+; '()
+; (Cons (First xs) (Take (- k 1) (Rest xs)))))
+; ((Lazy? xs)
+; (if (zero? k)
+; eos
+; (Cons (First xs) (Take (- k 1) (Rest xs)) #t)))
+; (else (error 'Take "not a biglist" xs)))))
+ (else (error 'Take "too many arguments"))))
+
+(define (Take-while ok? . xss)
+ (cond
+ ((null? xss)
+ (lambda (xs)
+ (Take-while ok? xs)))
+ ((null? (cdr xss))
+ (let ((xs (car xss)))
+ (cond
+ ((Eager? xs)
+ (let recur ((xs xs))
+ (cond
+ ((null? xs) xs)
+ ((ok? (First xs))
+ (Cons (First xs) (recur (Rest xs))))
+ (else '()))))
+ ((Lazy? xs)
+ (let recur ((xs xs))
+ (if (ok? (First xs))
+ (Cons (First xs) (recur (Rest xs)) #t)
+ eos)))
+ (else (error 'Take-while "not a biglist" xs)))))
+ (else (error 'Take-while "too many arguments"))))
+
+(define (Take-until ok? . xss)
+ (cond
+ ((null? xss)
+ (lambda (xs)
+ (Take-while ok? xs)))
+ ((null? (cdr xss))
+ (let ((xs (car xss)))
+ (cond
+ ((Eager? xs)
+ (let recur ((xs xs))
+ (cond
+ ((null? xs) xs)
+ ((ok? (First xs)) '())
+ (else
+ (Cons (First xs) (recur (Rest xs)))))))
+ ((Lazy? xs)
+ (let recur ((xs xs))
+ (cond
+ ((Null? xs) xs)
+ ((ok? (First xs))
+ eos)
+ (else
+ (Cons (First xs) (recur (Rest xs)) #t)))))
+ (else (error 'Take-until "not a biglist" xs)))))
+ (else (error 'Take-while "too many arguments"))))
+
+(define (Drop k . xss)
+ (cond
+ ((null? xss)
+ (lambda (xs)
+ (Drop k xs)))
+ ((null? (cdr xss))
+ (let ((xs (car xss)))
+ (if (BigList? xs)
+ (if (zero? k)
+ xs
+ (Drop (- k 1) (Rest xs)))
+ (error 'Drop "not a biglist" xs))))
+ (else (error 'Drop "too many arguments"))))
+
+(define (Drop-while ok? . xss)
+ (cond
+ ((null? xss)
+ (lambda (xs)
+ (Drop-while ok? xs)))
+ ((null? (cdr xss))
+ (let* ((xs (car xss))
+ (nil (cond
+ ((Eager? xs) '())
+ ((Lazy? xs) eos)
+ (error 'Drop-while "not a biglist" xs))))
+ (let loop ((xs xs))
+ (cond
+ ((Null? xs) nil)
+ ((ok? (First xs))
+ (loop (Rest xs)))
+ (else xs)))))
+ (else (error 'Drop-while "too many arguments"))))
+
+(define (Drop-until ok? . xss)
+ (cond
+ ((null? xss)
+ (lambda (xs)
+ (Drop-while ok? xs)))
+ ((null? (cdr xss))
+ (let* ((xs (car xss))
+ (nil (cond
+ ((Eager? xs) '())
+ ((Lazy? xs) eos)
+ (error 'Drop-until "not a biglist" xs))))
+ (let loop ((xs xs))
+ (cond
+ ((Null? xs) nil)
+ ((ok? (First xs)) xs)
+ (else (loop (Rest xs)))))))
+ (else (error 'Drop-until "too many arguments"))))
+
+(define BigList->list
+ (case-lambda
+ ((xs)
+ (if (List? xs)
+ (BigList->list (Length xs) xs)
+ (error 'BigList->list "not a biglist" xs)))
+ ((k . xss)
+ (cond
+ ((null? xss)
+ (lambda (xs)
+ (BigList->list k xs)))
+ ((null? (cdr xss))
+ (let ((xs (car xss)))
+ (cond
+ ((Eager? xs) xs)
+ ((Lazy? xs)
+ (let recur ((n 0) (xs xs))
+ (cond
+ ((Null? xs) '())
+ ((= n k) '())
+ (else
+ (Cons (First xs)
+ (recur (+ n 1) (Rest xs)))))))
+ (else (error 'BigList->list "not a biglist" xs)))))
+ (else
+ (error 'BigList->list "too many arguments"))))
+ ))
+
+(define (Filter ok? . xss)
+ (cond
+ ((null? xss)
+ (lambda (xs)
+ (Filter ok? xs)))
+ ((null? (cdr xss))
+ (let ((xs (car xss)))
+; ;; this version is inefficient:
+; ;; it checks for Eager again and again
+; (if (BigList? xs)
+; (let recur ((xs xs))
+; (cond
+; ((Null? xs)
+; (if (Eager? xs) '() eos))
+; ((ok? (First xs))
+; (if (Eager? xs)
+; (Cons (First xs) (recur (Rest xs)))
+; (Cons (First xs)
+; (recur (Rest xs))
+; (List? xs))))
+; (else (recur (Rest xs)))))
+; (error 'Filter "not a biglist" xs))))
+ (cond
+ ((Eager? xs)
+ (let recur ((xs xs))
+ (cond
+ ((Null? xs) xs)
+ ((ok? (First xs))
+ (Cons (First xs) (recur (Rest xs))))
+ (else (recur (Rest xs))))))
+ ((Lazy? xs)
+ (let recur ((xs xs))
+ (cond
+ ((Null? xs) eos);xs)
+ ((ok? (First xs))
+ (Cons (First xs)
+ (recur (Rest xs))
+ (List? xs)))
+ (else (recur (Rest xs))))))
+ (else
+ (error 'Filter "not a biglist" xs)))))
+ (else
+ (error 'Filter "too many arguments"))
+ ))
+
+(define (Map fn . xss)
+ (if (null? xss)
+ (lambda lists
+ (apply Map fn lists))
+ (let ((xs (car xss)))
+ (cond
+ ((Eager? xs)
+ (if ((list-of? BigList?) (cdr xss))
+ (let recur ((xss xss))
+ (if (memv #t (map Null? xss))
+ '()
+ (cons (apply fn (map First xss))
+ (recur (map Rest xss)))))
+ (error 'Map "not a list of biglists" xss)))
+ ((Lazy? xs)
+ (if ((list-of? BigList?) (cdr xss))
+ (let recur ((xss xss))
+ (if (memv #t (map Null? xss))
+ eos
+ (Cons (apply fn (map First xss))
+ (recur (map Rest xss))
+ (and? (map List? xss)))))
+ (error 'Map "not a list of biglists" xss)))
+ (else
+ (error 'Map "not a biglists" xs))
+ ))
+ ))
+
+(define (For-each fn . xss)
+ (if ((list-of? BigList?) xss)
+ (if (null? xss)
+ (lambda lists
+ (apply For-each fn lists))
+ (unless (memq #t (map Null? xss))
+ (cond
+ (((list-of? Eager?) xss)
+ (apply fn (map First xss))
+ (apply For-each fn (map Rest xss)))
+ (((list-of? Lazy?) xss)
+ (apply fn (map First xss))
+ (apply For-each fn (map Rest xss)))
+ (else
+ (error 'For-each "not all either eager or lazy" xss))
+ )))
+ (error 'For-each "not a list of biglists" xss)
+ ))
+
+(define (Append xs . xss)
+ (if (BigList? xs)
+ (cond
+ ((null? xss) xs)
+ ((null? (cdr xss))
+ (let ((ys (First xss)))
+ (cond
+ ((and (List? xs) (Eager? ys))
+ (if (Null? xs)
+ ys
+ (Cons (First xs) (Append (Rest xs) ys))))
+ ((and (List? xs) (BigList? ys))
+ (if (Null? xs)
+ ys
+ (Cons (First xs)
+ (Append (Rest xs) ys)
+ (List? ys))))
+ (else
+ (error 'Append "invalid arguments" xs ys)))))
+ (else
+ (Append xs (apply Append (car xss) (cdr xss)))))
+ (error 'Append "not a biglist" xs)))
+
+(define (Reverse xs . xss)
+ (cond
+ ((null? xss)
+ (cond
+ ((Eager? xs)
+ (Reverse xs '()))
+ ((List? xs)
+ (Reverse xs eos))
+ (else (error "not a finite biglist" xs))))
+ ((null? (cdr xss))
+ (let ((ys (car xss)))
+ (cond
+ ((and (Eager? xs) (Eager? ys))
+ (let loop ((xs xs) (result ys))
+ (if (Null? xs)
+ result
+ (loop (Rest xs)
+ (Cons (First xs) result)))))
+ ((and (List? xs) (Eager? ys))
+ (let loop ((xs xs) (result ys))
+ (if (Null? xs)
+ result
+ (loop (Rest xs)
+ (Cons (First xs) result)))))
+ ((and (Eager? xs) (BigList? ys))
+ (let loop ((xs xs) (result ys))
+ (if (Null? xs)
+ result
+ (loop (Rest xs)
+ (Cons (First xs) result (List? ys))))))
+ ((and (List? xs) (BigList? ys))
+ (let loop ((xs xs) (result ys))
+ (if (Null? xs)
+ result
+ (loop (Rest xs)
+ (Cons (First xs) result (List? ys))))))
+ (else
+ (error 'Reverse "invalid arguments" xs ys)))))
+ (else (error 'Reverse "too many arguments"))))
+
+(define (Reverse* xs)
+ (cond
+ ((Eager? xs)
+ (let recur ((k 0))
+ (if (> k (Length xs))
+ '()
+ (Cons (Reverse (Take k xs)) (recur (+ k 1))))))
+ ((BigList? xs)
+ (let recur ((k 0))
+ (cond
+ ((not (Length xs))
+ (Cons (Reverse (Take k xs))
+ (recur (+ k 1))
+ #f))
+ (else
+ (if (> k (Length xs))
+ eos
+ (Cons (Reverse (Take k xs))
+ (recur (+ k 1))
+ #t))
+ ))))
+ (else (error 'Reverse* "not a biglist" xs))))
+
+(define (Zip xs ys)
+ (cond
+ ((and (Eager? xs) (Eager? ys))
+ (let recur ((xs xs) (ys ys))
+ (if (Null? xs)
+ ys
+ (Cons (First xs) (recur ys (Rest xs))))))
+ ((and (BigList? xs) (BigList? ys))
+ (let recur ((xs xs) (ys ys))
+ (if (Null? xs)
+ ys
+ (Cons (First xs)
+ (recur ys (Rest xs))
+ (and (List? xs) (List? ys))))))
+ (else
+ (error 'Zip "invalid arguments" xs ys))))
+
+(define (Unzip xs)
+ (cond
+ ((Eager? xs)
+ (let ((one
+ (let ((ev? #f))
+ (let recur ((xs xs))
+ (cond
+ ((Null? xs) '())
+ (else
+ (set! ev? (not ev?))
+ (if ev?
+ (Cons (First xs) (recur (Rest xs)))
+ (recur (Rest xs))
+ ))))))
+ (two
+ (let ((ev? #f))
+ (let recur ((xs xs))
+ (cond
+ ((Null? xs) '())
+ (else
+ (set! ev? (not ev?))
+ (if ev?
+ (recur (Rest xs))
+ (Cons (First xs) (recur (Rest xs))))))))))
+ (values one two)))
+ ((BigList? xs)
+ (let ((finite? (List? xs)))
+ (let ((one
+ (let ((ev? #f))
+ (let recur ((xs xs))
+ (cond
+ ((Null? xs) eos)
+ (else
+ (set! ev? (not ev?))
+ (if ev?
+ (Cons (First xs) (recur (Rest xs)) finite?)
+ (recur (Rest xs))
+ ))))))
+ (two
+ (let ((ev? #f))
+ (let recur ((xs xs))
+ (cond
+ ((Null? xs) eos)
+ (else
+ (set! ev? (not ev?))
+ (if ev?
+ (recur (Rest xs))
+ (Cons (First xs) (recur (Rest xs)) finite?))))))))
+ (values one two))))
+ (else (error 'Unzip "not a biglist" xs))))
+
+(define (Sorted? var) xss))
+
+(define (Memv var . xss)
+ (apply Memp (cut eqv? <> var) xss))
+
+(define (Member var . xss)
+ (apply Memp (cut equal? <> var) xss))
+
+(define Eqp?
+ (case-lambda
+ ((=?)
+ (lambda (xs ys)
+ (Eqp? =? xs ys)))
+ ((=? xs ys)
+ (cond
+ ((and (Eager? xs) (Lazy? ys)) #f)
+ ((and (Lazy? xs) (Eager? ys)) #f)
+ ((not (eqv? (Length xs) (Length ys))) #f)
+ ((and (List? xs) (List? ys))
+ (let loop ((xs xs) (ys ys))
+ (cond
+ ((and (Null? xs) (Null? ys))
+ #t)
+ ((=? (First xs) (First ys))
+ (loop (Rest xs) (Rest ys)))
+ (else #f))))
+ ((and (BigList? xs) (BigList? ys))
+ (eqv? xs ys))
+ (else (equal? xs ys))))
+ ))
+
+(define Eq? (Eqp? eq?))
+(define Eqv? (Eqp? eqv?))
+(define Equal? (Eqp? equal?))
+
+(define (Assp ok? . xss)
+ (cond
+ ((null? xss)
+ (lambda (xs)
+ (Assp ok? xs)))
+ ((null? (cdr xss))
+ (let ((xs (car xss)))
+ (cond
+ (((List-of? BigList?) xs)
+ (let loop ((xs xs))
+ (cond
+ ((Null? xs) #f)
+ ((ok? (First (First xs)))
+ (First xs))
+ (else (loop (Rest xs))))))
+ (else (error 'Assp "not a finite biglist" xs)))))
+ (else (error 'Assp "too many arguments"))
+ ))
+
+(define (Assq key . xss)
+ (apply Assp (cut eq? <> key) xss))
+
+(define (Assv key . xss)
+ (apply Assp (cut eqv? <> key) xss))
+
+(define (Assoc key . xss)
+ (apply Assp (cut equal? <> key) xss))
+
+(define (Remp ok? . xss)
+ (cond
+ ((null? xss)
+ (lambda (xs) (Remp ok? xs)))
+ ((null? (cdr xss))
+ (Filter (o not ok?) (car xss)))
+ (else (error 'Remp "too many arguements"))))
+
+(define (Remove val . xss)
+ (apply Remp (cut equal? <> val) xss))
+
+(define (Remq val . xss)
+ (apply Remp (cut eq? <> val) xss))
+
+(define (Remv val . xss)
+ (apply Remp (cut eqv? <> val) xss))
+
+(define (Fold-right op init . xss)
+ (cond
+ ((null? xss)
+ (lambda pairs
+ (apply Fold-right op init pairs)))
+ (else
+ (if ((list-of? BigList?) xss)
+ (let recur ((xss xss))
+ (if (memv #t (map List? xss))
+ (cond
+ ((memv #t (map Null? xss)) init)
+ (else
+ (apply op
+ (append (map First xss)
+ (list (recur (map Rest xss)))))))
+ (error 'Fold-right "all biglists infinite")))
+ (error 'Fold-right "not a list of biglists" xss)))
+ ))
+
+(define (Fold-left op init . xss)
+ (cond
+ ((null? xss)
+ (lambda pairs
+ (apply Fold-left op init pairs)))
+ (else
+ (if ((list-of? BigList?) xss)
+ (let loop ((xss xss) (result init))
+ (if (memv #t (map List? xss))
+ (cond
+ ((memv #t (map Null? xss)) result)
+ (else
+ (loop (map Rest xss)
+ (apply op result (map First xss)))))
+ (error 'Fold-left "all biglists infinite")))
+ (error 'Fold-left "not a list of biglists" xss)))
+ ))
+
+(define (Fold-right0 op . xss)
+ (cond
+ ((null? xss)
+ (lambda pairs
+ (apply Fold-right0 op pairs)))
+ (else
+ (if ((list-of? List?) xss)
+ (let ((cars (map First xss)))
+ (if (not (memq eos cars))
+ (apply Fold-right
+ op
+ (apply op cars)
+ (map Rest xss))
+ (error 'Fold-right0 "some biglist empty")))
+ (error 'Fold-right0 "not a list of finite biglists" xss)))))
+;(define (Fold-right0 op . xss)
+; (cond
+; ((null? xss)
+; (lambda (xs)
+; (Fold-right0 op xs)))
+; ((null? (cdr xss))
+; (let ((xs (car xss)))
+; (if (List? xs)
+; (if (Null? xs)
+; (error 'Fold-right0 "biglist empty")
+; (Fold-right op (First xs) (Rest xs)))
+; (error 'Fold-ritht0 "not a finite biglist"))))
+; (else (error 'Fold-right0 "too many arguments"))))
+
+(define (Fold-left0 op . xss)
+ (cond
+ ((null? xss)
+ (lambda pairs
+ (apply Fold-left0 op pairs)))
+ (else
+ (if ((list-of? List?) xss)
+ (let ((cars (map First xss)))
+ (if (not (memq eos cars))
+ (apply Fold-left
+ op
+ (apply op cars)
+ (map Rest xss))
+ (error 'Fold-left0 "some biglist empty")))
+ (error 'Fold-left0 "not a list of finite biglists" xss)))))
+;(define (Fold-right0 op . xss)
+; (cond
+; ((null? xss)
+; (lambda (xs)
+; (Fold-left0 op xs)))
+; ((null? (cdr xss))
+; (let ((xs (car xss)))
+; (if (List? xs)
+; (if (Null? xs)
+; (error 'Fold-left0 "biglist empty")
+; (Fold-left op (First xs) (Rest xs)))
+; (error 'Fold-left0 "not a finite biglist"))))
+; (else (error 'Fold-left0 "too many arguments"))))
+
+(define (Scan-right op init . xss)
+ (cond
+ ((null? xss)
+ (lambda pairs
+ (apply Scan-right op init pairs)))
+ (else
+ (if ((list-of? BigList?) xss)
+ (let ((finite?
+ (if (memv #t (map List? xss)) #t #f)))
+ (let recur ((n 0) (tails xss))
+ (if (memv #t (map Null? tails))
+ eos
+ (Cons (apply Fold-right op init (map (Take n) xss))
+ (recur (+ n 1) (map Rest tails))
+ finite?))))
+ (error 'Scan-right "not a list of biglists" xss)))))
+
+(define (Scan-left op init . xss)
+ (cond
+ ((null? xss)
+ (lambda pairs
+ (apply Scan-left op init pairs)))
+ (else
+ (if ((list-of? BigList?) xss)
+ (let ((finite?
+ (if (memv #t (map List? xss)) #t #f)))
+ (let recur ((n 0) (tails xss))
+ (if (memv #t (map Null? tails))
+ eos
+ (Cons (apply Fold-left op init (map (Take n) xss))
+ (recur (+ n 1) (map Rest tails))
+ finite?))))
+ (error 'Scan-left "not a list of biglists" xss)))))
+
+(define Range
+ (case-lambda
+ ((upto)
+ (cond
+ ((not upto) ; infinite case
+ (Range 0 upto 1))
+ ((>= upto 0)
+ (Range 0 upto 1))
+ (else
+ (Range 0 upto -1))))
+ ((from upto)
+ (cond
+ ((not upto) ; infinite case
+ (Range from upto 1))
+ ((>= upto from)
+ (Range from upto 1))
+ (else
+ (Range from upto -1))))
+ ((from upto step)
+ (let ((from (if (integer? from)
+ from
+ (error 'Range "not an integer" from)))
+ (upto (if (or (not upto) (integer? upto))
+ upto
+ (error 'Range "neither an integer nor #f" upto)))
+ (step (if (integer? step)
+ step
+ (error 'Range "not an integer" step))))
+ (let recur ((k from))
+ (cond
+ ((not upto) ; infinite case
+ (Cons k (recur (+ k step)) #f))
+ ((and (>= upto from) (positive? step))
+ (if (>= k upto)
+ eos
+ (Cons k (recur (+ k step)) #t)))
+ ((and (< upto from) (negative? step))
+ (if (<= k upto)
+ eos
+ (Cons k (recur (+ k step)) #t)))
+ (else
+ (error 'Range "wrong sign of" step))))))
+ ))
+
+(define (Repeat x)
+ (Cons x (Repeat x) #f))
+
+(define (Repeat-times k x)
+ (Take k (Repeat x)))
+
+(define (Iterate-while fn ok? . xs)
+ (Take-while ok? (apply Iterate fn xs)))
+
+(define (Iterate-until fn ok? . xs)
+ (Take-until ok? (apply Iterate fn xs)))
+
+(define (Iterate-times fn k . xs)
+ (Take k (apply Iterate fn xs)))
+
+(define (Iterate fn . xs)
+ (cond
+ ((null? xs)
+ (lambda (x)
+ (Iterate fn x)))
+ ((null? (cdr xs))
+ (let recur ((x (First xs)))
+ (Cons x (recur (fn x)) #f)))
+ (else 'Iterate "too many arguments")))
+
+(define (Cycle xs)
+ (cond
+ ((Eager? xs)
+ (Cycle (apply List xs)))
+ ((List? xs)
+ (if (Null? xs)
+ eos
+ (let recur ((tail xs))
+ (if (Null? tail)
+ (recur xs)
+ (Cons (First tail) (recur (Rest tail)) #f)))))
+ (else (error 'Cycle "not a finite biglist" xs))))
+
+(define (Cycle-times k xs)
+ (Take k (Cycle xs)))
+
+(define Print
+ (case-lambda
+ ((k xs)
+ (if (BigList? xs)
+ (let loop ((n 0) (xs xs))
+ (unless (= n k)
+ (print (First xs))
+ (loop (+ n 1) (Rest xs))))
+ (error 'Print "not a biglist" xs)))
+ ((xs)
+ (if (List? xs)
+ (let ((xs xs))
+ (Print (Length xs) xs))
+ (error 'Print "not a finite biglist" xs)))
+ ))
+
+;;; (For ((var xs ok-xpr ...) (var1 xs1 ok-xpr1 ...) ...) item-xpr)
+;;; ---------------------------------------------------------------
+(define-syntax For
+ (syntax-rules ()
+ ((_ ((var xs ok-xpr ...)) item-xpr)
+ (cond
+ ((Eager? xs)
+ (let recur ((seq xs))
+ (if (Null? seq)
+ '()
+ (let ((var (First seq)))
+ (if (and ok-xpr ...)
+ (Cons item-xpr (recur (Rest seq)))
+ (recur (Rest seq)))))))
+ ((Lazy? xs)
+ (let recur ((seq xs))
+ (if (Null? seq)
+ eos
+ (let ((var (First seq)))
+ (if (and ok-xpr ...)
+ (Cons item-xpr (recur (Rest seq)) #t)
+ (recur (Rest seq)))))))
+ (else (error 'For "not a biglist" xs))))
+ ((_ ((var xs ok-xpr ...) (var1 xs1 ok-xpr1 ...) ...) item-xpr)
+ (let recur ((seq xs))
+ (if (Null? seq)
+ (cond
+ ((Eager? seq) '())
+ ((Lazy? seq) eos)
+ (else (error 'For "not a biglist" seq)))
+ (let ((var (First seq)))
+ (if (and ok-xpr ...)
+ (Append (For ((var1 xs1 ok-xpr1 ...) ...) item-xpr)
+ (recur (Rest seq)))
+ (recur (Rest seq)))))))
+ ))
+
+(define (Read-forever)
+ (Map (lambda (x) (x))
+ (Repeat (lambda ()
+ (print* "enter a scheme object (stop with Ctrl-C): ")
+ (let ((obj (read)))
+ (print obj)
+ obj)))))
+
+;;; make biglists accessible to pattern matching
+;;; ----------------------------------------------
+(bind-seq-db BigList?
+ #:ref (lambda (xs k) (At k xs))
+ #:tail (lambda (xs k) (Drop k xs)))
+
+;(define (integers-from n)
+; (Cons n (integers-from (+ n 1)) #f))
+;
+;(define integers (integers-from 0))
+
+;;; (biglists sym ..)
+;;; ----------------------------
+;;; documentation procedure
+(define biglists
+ (let ((als '(
+ (biglists
+ procedure:
+ (biglists sym ..)
+ "documentation procedure")
+ (Append
+ procedure:
+ (Append xs . xss)
+ "appends all argument lists, provided all but the last"
+ "are finite")
+ (Assoc
+ procedure:
+ (Assoc key)
+ (Assoc key xs)
+ "returns the biglist, whose First or car is Equal? to key")
+ (Assp
+ procedure:
+ (Assp ok?)
+ (Assp ok? xs)
+ "returns the biglist, whose First or car passes ok?")
+ (Assq
+ procedure:
+ (Assq key)
+ (Assq key xs)
+ "returns the biglist, whose First or car is Eq? to key")
+ (Assv
+ procedure:
+ (Assv key)
+ (Assv key xs)
+ "returns the biglist, whose First or car is Eqv? to key")
+ (At
+ procedure:
+ (At k)
+ (At k xs)
+ "returns the kth item of xs")
+ (BigList?
+ procedure:
+ (BigList? xpr)
+ "type predicate")
+ (BigList->list
+ procedure:
+ (BigList->list xs)
+ (BigList->list k xs)
+ "transforms a possibly infinite biglist xs into a list")
+ (Cons
+ macro:
+ (Cons x y finite?)
+ (Cons x y)
+ "returns either a lazy or an eager biglist")
+ (Cycle
+ procedure:
+ (Cycle xs)
+ "returns an infinite biglist by appending the finite"
+ "biglist xs over and over")
+ (Cycle-times
+ procedure:
+ (Cycle k xs)
+ "returns a finite biglist by appending the finite"
+ "biglist xs k times")
+ (Drop
+ procedure:
+ (Drop k)
+ (Drop k xs)
+ "drops the first k items of xs")
+ (Drop-while
+ procedure:
+ (Drop-while ok?)
+ (Drop-while ok? xs)
+ "returns the xs whith those front items x removed"
+ "which pass ok?")
+ (Drop-until
+ procedure:
+ (Drop-until ok?)
+ (Drop-until ok? xs)
+ "returns the xs whith those front items x removed"
+ "which don't pass ok?")
+ (Eager?
+ procedure:
+ (Eager? xpr)
+ "is xpr an eager biglist, i.e. a normal list?")
+ (Eq?
+ procedure:
+ (Eq? xs ys)
+ "returns #t if both lists have same length"
+ "and corresponding items are eq?")
+ (Eqp?
+ procedure:
+ (Eqp? =?)
+ (Eqp? =? xs ys)
+ "returns #t if both lists have same length"
+ "and corresponding items are =?")
+ (Equal?
+ procedure:
+ (Equal? xs ys)
+ "returns #t if both lists have same length"
+ "and corresponding items are equal?")
+ (Eqv?
+ procedure:
+ (Eqv? xs ys)
+ "returns #t if both lists have same length"
+ "and corresponding items are eqv?")
+ (Every?
+ procedure:
+ (Every? ok?)
+ (Every? ok? xs)
+ "returns #t if every item of the finite biglist xs"
+ "passes the ok? test")
+ (Filter
+ procedure:
+ (Filter ok?)
+ (Filter ok? xs)
+ "removes all items from the biglist xs which"
+ "do not pass the ok? test")
+ (Fold-left
+ procedure:
+ (Fold-left op init)
+ (Fold-left op init . xss)
+ "folds the finite biglists xss from the left")
+ (Fold-left0
+ procedure:
+ (Fold-left0 op)
+ (Fold-left0 op . xss)
+ "folds the finite biglists (map Rest xss) from the left"
+ "with init (map First xss)")
+ (Fold-right
+ procedure:
+ (Fold-right op init)
+ (Fold-right op init . xss)
+ "folds the finite biglists xss from the right")
+ (Fold-right0
+ procedure:
+ (Fold-right0 op)
+ (Fold-right0 op . xss)
+ "folds the finite biglists (map Rest xss) from the right"
+ "with init (map First xss)")
+ (For
+ macro:
+ (For ((var xs ok-xpr ...) (var1 xs1 ok-xpr1 ...) ...) item-xpr)
+ "creates a new list by binding var to each element"
+ "of the list xs in sequence, and if it passes the checks,"
+ "ok-xpr ..., inserts the value of item-xpr into the result list."
+ "The qualifieres, (var xs ok-xpr ...), are processed"
+ "sequentially from left to right, so that filters of a"
+ "qualifier have access to the variables of qualifiers"
+ "to its left.")
+ (For-each
+ procedure:
+ (For-each fn)
+ (For-each fn . xss)
+ "applies the procedure fn to each list of items"
+ "of xss at each commeon index")
+ (First
+ procedure:
+ (First xs)
+ "returns the front item of xs, which might be eos"
+ "if xs is empty")
+ (Index
+ procedure:
+ (Index ok?)
+ (Index ok? xs)
+ "returns the index of the first item of the biglist xs,"
+ "which passes the ok? test")
+ (Iterate
+ procedure:
+ (Iterate fn)
+ (Iterate fn x)
+ "returns an infinite list by iteratively"
+ "applying fn to x")
+ (Iterate-times
+ procedure:
+ (Iterate-times fn times)
+ (Iterate-times fn times x)
+ "returns a finite list of lentgh times by"
+ "iteratively applying fn to x")
+ (Iterate-until
+ procedure:
+ (Iterate-until fn ok?)
+ (Iterate-until fn ok? x)
+ "returns a finite list by iteratively applying"
+ "fn to x until ok? returns #t on the result")
+ (Iterate-while
+ procedure:
+ (Iterate-while fn ok?)
+ "returns a finite list by iteratively applying"
+ "fn to x as long as ok? returns #t on the result")
+ (Lazy?
+ procedure:
+ (Lazy? xpr)
+ "is xpr a lazy biglist?")
+ (Length
+ procedure:
+ (Length xs)
+ "retuns the length of a finite biglist or #f"
+ "of an infinite one")
+ (List
+ procedure:
+ (List . args)
+ "creates a lazy finite biglist with items args")
+ (List?
+ procedure:
+ (List? xpr)
+ "is xpr a finite biglist?")
+ (List-of?
+ procedure:
+ (List-of? . oks?)
+ (List-of? k . oks?)
+ "returs a predicate on a biglist, which checks,"
+ "if every item (or Take k item) is a finite biglist")
+ (Map
+ procedure:
+ (Map fn)
+ (Map fn . xss)
+ "maps every list of of items at fixed index of xss"
+ "with function fn")
+ (Member
+ procedure:
+ (Member x)
+ (Member x xs)
+ "returns the first tail af the biglist xs"
+ "whose first item is equal? to x")
+ (Memp
+ procedure:
+ (Memp ok?)
+ (Memp ok? xs)
+ "returns the first tail af the biglist xs"
+ "which passes the ok? test")
+ (Memq
+ procedure:
+ (Memq x)
+ (Memq x xs)
+ "returns the first tail af the biglist xs"
+ "whose first item is eq? to x")
+ (Memv
+ procedure:
+ (Memv x)
+ (Memv x xs)
+ "returns the first tail af the biglist xs"
+ "whose first item is eqv? to x")
+ (Merge
+ procedure:
+ (Merge (* (First ps) (First ps)) n) #t)
+ ((zero? (remainder n (First ps))) #f)
+ (else (loop (Rest ps))))))
+
+(define four (List 0 1 2 3))
+(define five (list 0 1 2 3 4))
+
+(define-test (biglists?)
+ (= (First (Cons 1 2 #f)) 1)
+ (= (Rest (Cons 1 2 #f)) 2)
+ (= (First tree) 1)
+ (= (First (First (Rest tree))) 2)
+ (= (First (Rest (Rest tree))) 3)
+ (= (At 5 ones) 1)
+ (= (At 2 five) 2)
+ (not (List? ones))
+ (= (At 5 twos) 2)
+ (= (At 5 (Map (lambda (x) (* 10 x)) twos)) 20)
+ (= (At 3 (List 0 1 2 3 4)) 3)
+ (BigList? eos)
+ (Null? eos)
+ (List? eos)
+ (not (Null? ones))
+ (= (At 5 integers) 5)
+ (= (At 5 (Map * integers integers)) 25)
+ (= (At 5 (Map + ones integers)) 6)
+ (= (At 3 (Map + four five)) 6)
+ (zero? (First (Take 3 integers)))
+ (equal? (Take 2 five) '(0 1))
+ (equal? (Take-while (cut < <> 2) five) '(0 1))
+ (equal? (BigList->list (Take-while (cut < <> 2) integers)) '(0 1))
+ (equal? (BigList->list (Take-while (cut < <> 2) integers)) '(0 1))
+ (equal? (Take-until (cut = <> 2) five) '(0 1))
+ (equal? (BigList->list (Take-until (cut = <> 2) integers)) '(0 1))
+ (= (At 5 (Filter even? integers)) 10)
+ (equal? (Filter even? five) '(0 2 4))
+ (= (At 5 positive-integers) 6)
+ (not (List? fibs))
+ (equal? (BigList->list 5 fibs) '(0 1 1 2 3))
+ (equal? (BigList->list 5 primes) '(2 3 5 7 11))
+ (not (List? primes))
+ (BigList? fibs)
+ (BigList? primes)
+ (BigList? integers)
+ (not (List? integers))
+ (BigList? ones)
+ (BigList? tree)
+ ((List-of? number? odd?) '(1 3 5 7))
+ ((List-of? number? odd?) (List 1 3 5 7))
+ ((List-of? integer?) (Take 10 integers))
+ (not ((List-of? odd?) four))
+ (not ((List-of? odd?) five))
+ (equal? (BigList->list four) '(0 1 2 3))
+ (= (Fold-right + 0 five) 10)
+ (= (Fold-left + 0 five) 10)
+ (= (Fold-right + 0 four) 6)
+ (= (Fold-left + 0 four) 6)
+ (= (Fold-left0 + four) 6)
+ (= (Fold-left0 + five) 10)
+ (BigList? (Take 5 integers))
+ (List? (Take 5 integers))
+ (= (Fold-right + 0 (Take 5 integers) (Take 5 integers)) 20)
+ (= (Fold-right + 0 (Take 3 integers) integers) 6)
+ (= (Fold-left + 0 (Take 3 integers) integers) 6)
+ (equal? (BigList->list 5 (Scan-right + 0 integers integers))
+ '(0 0 2 6 12))
+ (equal? (BigList->list 5 (Scan-left + 0 integers integers))
+ '(0 0 2 6 12))
+ (not (List? (Scan-left + 0 integers integers)))
+ (List? (Scan-left + 0 four four))
+ (List? (Scan-right + 0 four integers))
+ (not (Length integers))
+ (not (Length (Scan-right + 0 integers)))
+ (print "XXX " (BigList->list (Scan-right + 0 five)))
+ (= (At 2 (Scan-right + 0 five)) 1)
+ (= (Length (Scan-right + 0 five)) 5)
+ (= (Length (Scan-right + 0 five five)) 5)
+ (= (Length (Scan-left + 0 five five)) 5)
+ (= (At 3 (Scan-right + 0 four)) 3)
+ (Null? (At 4 (Scan-right + 0 four)))
+ (Null? (At 4 (Scan-right + 0 four four)))
+ (eq? (At 4 (Scan-right + 0 four)) eos)
+ (eq? (At 4 (Scan-right + 0 four four)) eos)
+ (= (Length (Scan-right + 0 four four)) 4)
+ (= (Length (Scan-left + 0 four four)) 4)
+ (symbol? (At 4 (Scan-left + 0 four four)))
+ (symbol? (At 10 (Scan-left + 0 four four)))
+ (symbol? (At 20 (Scan-right + 0 four four)))
+ (symbol? (At 4 (Take 10 four)))
+ (equal? (Drop 2 five) '(2 3 4))
+ (= (First (Drop 3 integers)) 3)
+ (List? (Drop 10 four))
+ (Null? (Drop 10 four))
+ (equal? (Drop-while even? five) '(1 2 3 4))
+ (equal? (Drop-until odd? five) '(1 2 3 4))
+ (equal? (BigList->list (Drop-while odd? (List 1 3 5 2 3 4)))
+ '(2 3 4))
+ (equal? (BigList->list 5 (Drop-while even? integers))
+ '(1 2 3 4 5))
+ (not (List? (Drop 10 integers)))
+ (equal? (BigList->list (Append four four)) '(0 1 2 3 0 1 2 3))
+ (equal? (BigList->list (Append four four four))
+ '(0 1 2 3 0 1 2 3 0 1 2 3))
+ (equal? (BigList->list (Reverse four)) '(3 2 1 0))
+ (equal? (Reverse four '()) '(3 2 1 0))
+ (equal? (Reverse five) '(4 3 2 1 0))
+ (equal? (BigList->list 10 (Reverse four integers))
+ '(3 2 1 0 0 1 2 3 4 5))
+ (equal? (BigList->list 5 (Map BigList->list (Reverse* integers)))
+ '(() (0) (1 0) (2 1 0) (3 2 1 0)))
+ (equal? (Reverse* five)
+ '(() (0) (1 0) (2 1 0) (3 2 1 0) (4 3 2 1 0)))
+ (equal? (BigList->list (Map BigList->list (Reverse* four)))
+ '(() (0) (1 0) (2 1 0) (3 2 1 0)))
+ (equal? (BigList->list (Zip four four))
+ '(0 0 1 1 2 2 3 3))
+ (equal? (Zip five five)
+ '(0 0 1 1 2 2 3 3 4 4))
+ (equal? (BigList->list 12 (Zip four integers))
+ '(0 0 1 1 2 2 3 3 4 5 6 7))
+ (equal? (BigList->list 5 (Iterate add1 0))
+ '(0 1 2 3 4))
+ (equal? (BigList->list 5 (Repeat 0))
+ '(0 0 0 0 0))
+ (equal? (BigList->list 5 integers) '(0 1 2 3 4))
+ (equal? (BigList->list 10 (nth-value 0 (Unzip integers)))
+ '(0 2 4 6 8 10 12 14 16 18))
+ (equal? (BigList->list 10 (nth-value 1 (Unzip integers)))
+ '(1 3 5 7 9 11 13 15 17 19))
+ (equal? (BigList->list (nth-value 1 (Unzip four)))
+ '(1 3))
+ (equal? (nth-value 0 (Unzip five)) '(0 2 4))
+ (equal? (nth-value 1 (Unzip five)) '(1 3))
+ (Some? odd? four)
+ (Some? odd? five)
+ (not ((Every? odd?) four))
+ (not ((Every? odd?) five))
+ (Sorted? <= four)
+ (Sorted? <= five)
+ (equal? (BigList->list (Merge <= four four))
+ '(0 0 1 1 2 2 3 3))
+ (equal? (Merge <= five five)
+ '(0 0 1 1 2 2 3 3 4 4))
+ (equal? (Sort <= '(2 1 5 1 3 0))
+ '(0 1 1 2 3 5))
+ (equal? (BigList->list (Sort <= (Append four four)))
+ '(0 0 1 1 2 2 3 3))
+ (equal? (BigList->list (Sort <= (List 5 3 2 7 5 1 0)))
+ '(0 1 2 3 5 5 7))
+ (equal? (BigList->list (Sort < (List 5 3 2 7 5 1 0)))
+ '(0 1 2 3 5 5 7))
+ (equal? (bind (x . xs) integers (list x (BigList->list 5 xs)))
+ '(0 (1 2 3 4 5)))
+ (equal? (bind (x (y . ys) z) (List 1 integers 3)
+ (list x y z (BigList->list 5 ys)))
+ '(1 0 3 (1 2 3 4 5)))
+ (equal? (BigList->list (Remp odd? four)) '(0 2))
+ (equal? (Remv 1 '(0 1 2 1 3 1 4)) '(0 2 3 4))
+ (equal? (BigList->list (Remv 1 four)) '(0 2 3))
+ (= (Index (cut = <> 5) integers) 5)
+ (= (Index odd? four) 1)
+ (= (Index (cut = <> 2) five) 2)
+ (= (Index odd? five) 1)
+ (equal? (BigList->list 10 (Memp odd? integers))
+ '(1 2 3 4 5 6 7 8 9 10))
+ (equal? (BigList->list 10 (Memv 3 integers))
+ '(3 4 5 6 7 8 9 10 11 12))
+ (not (Eqv? four (list 0 1 2 3)))
+ (Eqv? four (List 0 1 2 3))
+ (Eqp? = four (List 0 1 2 3))
+ (equal? (list 0 1 2 3) (list 0 1 2 3))
+ (Equal? (list 0 1 2 3) (list 0 1 2 3))
+ (Equal? (List 0 1 2 3) (List 0 1 2 3))
+ (Eqp? = integers integers)
+ (equal? (Assv 1 (List '(0 5) '(1 6) '(2 7))) '(1 6))
+ (equal? (Assv 1 '((0 5) (1 6) (2 7))) '(1 6))
+ (equal? (BigList->list
+ (Assv 2 (List (List 0 5) (List 1 6) (List 2 7))))
+ '(2 7))
+ (equal? (BigList->list
+ (Assp odd? (List (list 0 5) (list 1 6) (list 2 7))))
+ '(1 6))
+ (equal? (BigList->list
+ (Assp odd? (List (List 0 5) (List 1 6) (List 2 7))))
+ '(1 6))
+ (equal? (Assp (cut eq? <> 'b) '((a A) (b B) (c C))) '(b B))
+ (equal? (Assq 'b '((a A) (b B) (c C))) '(b B))
+ (not (Assq 'x '((a A) (b B) (c C))))
+ (equal? (BigList->list 5 (Range #f)) '(0 1 2 3 4))
+ (equal? (BigList->list 5 (Range 0 #f)) '(0 1 2 3 4))
+ (equal? (BigList->list 5 (Range 0 #f -2)) '(0 -2 -4 -6 -8))
+ (not (List? (Range 0 #f 1)))
+ (not (List? (Range 0 #f)))
+ (equal? (BigList->list 4 (Range 0 5 1)) '(0 1 2 3))
+ (equal? (BigList->list (Range 0 5 1)) '(0 1 2 3 4))
+ (equal? (BigList->list (Range 5 0 -1)) '(5 4 3 2 1))
+ (equal? (BigList->list (Range 0 -1)) '(0))
+ (equal? (BigList->list (Iterate-while sub1 positive? 5))
+ '(5 4 3 2 1))
+ (equal? (BigList->list (Iterate-times add1 5 1))
+ '(1 2 3 4 5))
+ (Print five)
+ (equal? (BigList->list (For ((x four)) (add1 x)))
+ '(1 2 3 4)); map
+ (equal? (BigList->list
+ (For ((x (List 0 1 2 3 4 5 6) (odd? x))) x)) ; filter
+ '(1 3 5))
+ (equal? (BigList->list
+ (For ((n (List 0 1 2 3 4 5 6) (positive? n) (even? n)))
+ (* 10 n)))
+ '(20 40 60))
+ (equal? (BigList->list
+ (For ((c (List 'A 'B 'C)) ;lazy
+ (k '(1 2 3 4))) ;eager
+ (list c k)))
+ '((A 1) (A 2) (A 3) (A 4)
+ (B 1) (B 2) (B 3) (B 4)
+ (C 1) (C 2) (C 3) (C 4)))
+ (equal? (BigList->list
+ (For ((c (List 'A 'B 'C)) ;lazy
+ (k (List 1 2 3 4))) ;lazy
+ (list c k)))
+ '((A 1) (A 2) (A 3) (A 4)
+ (B 1) (B 2) (B 3) (B 4)
+ (C 1) (C 2) (C 3) (C 4)))
+ (equal? (For ((c '(A B C)) ;eager
+ (k (List 1 2 3 4))) ;lazy
+ (list c k))
+ '((A 1) (A 2) (A 3) (A 4)
+ (B 1) (B 2) (B 3) (B 4)
+ (C 1) (C 2) (C 3) (C 4)))
+ (equal? (For ((c '(A B C)) ;eager
+ (k '(1 2 3 4))) ;eager
+ (list c k))
+ '((A 1) (A 2) (A 3) (A 4)
+ (B 1) (B 2) (B 3) (B 4)
+ (C 1) (C 2) (C 3) (C 4)))
+ )
+
+(compound-test (BIGLISTS)
+ (biglists?)
+ )
+
Index: /release/5/biglists/trunk/biglists.egg
===================================================================
--- /release/5/biglists/trunk/biglists.egg (revision 37453)
+++ /release/5/biglists/trunk/biglists.egg (revision 37454)
@@ -6,5 +6,5 @@
(dependencies bindings)
(author "[[Juergen Lorenz]]")
- (version "0.1.1")
+ (version "0.1.2")
(components (extension biglists)))
Index: /release/5/biglists/trunk/biglists.scm
===================================================================
--- /release/5/biglists/trunk/biglists.scm (revision 37453)
+++ /release/5/biglists/trunk/biglists.scm (revision 37454)
@@ -260,5 +260,5 @@
(At (- n 1) (Rest xs)))
(error 'At "not a biglist" xs))))
- (else (error 'At "to many arguments"))))
+ (else (error 'At "too many arguments"))))
(define (List . args)
@@ -296,5 +296,5 @@
; (Cons (First xs) (Take (- k 1) (Rest xs)) #t)))
; (else (error 'Take "not a biglist" xs)))))
- (else (error 'Take "to many arguments"))))
+ (else (error 'Take "too many arguments"))))
(define (Take-while ok? . xss)
@@ -319,5 +319,5 @@
eos)))
(else (error 'Take-while "not a biglist" xs)))))
- (else (error 'Take-while "to many arguments"))))
+ (else (error 'Take-while "too many arguments"))))
(define (Take-until ok? . xss)
@@ -345,5 +345,5 @@
(Cons (First xs) (recur (Rest xs)) #t)))))
(else (error 'Take-until "not a biglist" xs)))))
- (else (error 'Take-while "to many arguments"))))
+ (else (error 'Take-while "too many arguments"))))
(define (Drop k . xss)
@@ -359,5 +359,5 @@
(Drop (- k 1) (Rest xs)))
(error 'Drop "not a biglist" xs))))
- (else (error 'Drop "to many arguments"))))
+ (else (error 'Drop "too many arguments"))))
(define (Drop-while ok? . xss)
@@ -378,5 +378,5 @@
(loop (Rest xs)))
(else xs)))))
- (else (error 'Drop-while "to many arguments"))))
+ (else (error 'Drop-while "too many arguments"))))
(define (Drop-until ok? . xss)
@@ -396,5 +396,5 @@
((ok? (First xs)) xs)
(else (loop (Rest xs)))))))
- (else (error 'Drop-until "to many arguments"))))
+ (else (error 'Drop-until "too many arguments"))))
(define BigList->list
@@ -423,5 +423,5 @@
(else (error 'BigList->list "not a biglist" xs)))))
(else
- (error 'BigList->list "to many arguments"))))
+ (error 'BigList->list "too many arguments"))))
))
@@ -468,5 +468,5 @@
(error 'Filter "not a biglist" xs)))))
(else
- (error 'Filter "to many arguments"))
+ (error 'Filter "too many arguments"))
))
@@ -579,5 +579,5 @@
(else
(error 'Reverse "invalid arguments" xs ys)))))
- (else (error 'Reverse "to many arguments"))))
+ (else (error 'Reverse "too many arguments"))))
(define (Reverse* xs)
@@ -688,5 +688,5 @@
(else #f)))
(error 'Sorted? "not a finite biglist" xs))))
- (else (error 'Sorted? "to many arguments"))))
+ (else (error 'Sorted? "too many arguments"))))
(define (Merge