From cc6c5af03fce54d440787adf3d8d60727b53b51f Mon Sep 17 00:00:00 2001 From: marting Date: Sat, 2 Oct 1999 15:39:39 +0000 Subject: [PATCH] Small fixes & updates. Olin --- scsh/lib/list-lib.scm | 74 ++++++++++++++++++++++++++---------------- scsh/lib/list-pack.scm | 4 +-- scsh/lib/srfi-1.html | 72 ++++++++++++++++++++++------------------ scsh/lib/srfi-1.txt | 53 +++++++++++++++--------------- 4 files changed, 115 insertions(+), 88 deletions(-) diff --git a/scsh/lib/list-lib.scm b/scsh/lib/list-lib.scm index c952b33..c042618 100644 --- a/scsh/lib/list-lib.scm +++ b/scsh/lib/list-lib.scm @@ -79,18 +79,34 @@ ;;; This is carefully tuned code; do not modify casually. ;;; - It is careful to share storage when possible; ;;; - Side-effecting code tries not to perform redundant writes. +;;; ;;; That said, a port of this library to a specific Scheme system might wish -;;; to tune this code to exploit particulars of the implementation. In -;;; particular, the n-ary mapping functions are particularly slow and -;;; cons-intensive, and are good candidates for tuning. I have coded fast -;;; paths for the single-list cases, but what you really want to do is exploit -;;; the fact that the compiler usually knows how many arguments are being -;;; passed to a particular application of these functions -- they are usually -;;; explicitly called, not passed around as higher-order values. If you can -;;; arrange to have your compiler produce custom code or custom linkages based -;;; on the number of arguments in the call, you can speed these functions up -;;; a *lot*. But this kind of compiler technology no longer exists in the -;;; Scheme world as far as I can see. +;;; to tune this code to exploit particulars of the implementation. +;;; The single most important compiler-specific optimisation you could make +;;; to this library would be to add rewrite rules or transforms to: +;;; - transform applications of n-ary procedures (e.g. LIST=, CONS*, APPEND, +;;; LSET-UNION) into multiple applications of a primitive two-argument +;;; variant. +;;; - transform applications of the mapping functions (MAP, FOR-EACH, FOLD, +;;; ANY, EVERY) into open-coded loops. The killer here is that these +;;; functions are n-ary. Handling the general case is quite inefficient, +;;; requiring many intermediate data structures to be allocated and +;;; discarded. +;;; - transform applications of procedures that take optional arguments +;;; into calls to variants that do not take optional arguments. This +;;; eliminates unnecessary consing and parsing of the rest parameter. +;;; +;;; These transforms would provide BIG speedups. In particular, the n-ary +;;; mapping functions are particularly slow and cons-intensive, and are good +;;; candidates for tuning. I have coded fast paths for the single-list cases, +;;; but what you really want to do is exploit the fact that the compiler +;;; usually knows how many arguments are being passed to a particular +;;; application of these functions -- they are usually explicitly called, not +;;; passed around as higher-order values. If you can arrange to have your +;;; compiler produce custom code or custom linkages based on the number of +;;; arguments in the call, you can speed these functions up a *lot*. But this +;;; kind of compiler technology no longer exists in the Scheme world as far as +;;; I can see. ;;; ;;; Note that this code is, of course, dependent upon standard bindings for ;;; the R5RS procedures -- i.e., it assumes that the variable CAR is bound @@ -1192,23 +1208,25 @@ ;;; linear-time algorithm to kill the dups. Or use an algorithm based on ;;; element-marking. The former gives you O(n lg n), the latter is linear. -(define (delete-duplicates elt= lis) - (check-arg procedure? elt= delete-duplicates) - (let recur ((lis lis)) - (if (null-list? lis) lis - (let* ((x (car lis)) - (tail (cdr lis)) - (new-tail (recur (delete x tail elt=)))) - (if (eq? tail new-tail) lis (cons x new-tail)))))) +(define (delete-duplicates lis . maybe-=) + (let ((elt= (:optional maybe-= equal?))) + (check-arg procedure? elt= delete-duplicates) + (let recur ((lis lis)) + (if (null-list? lis) lis + (let* ((x (car lis)) + (tail (cdr lis)) + (new-tail (recur (delete x tail elt=)))) + (if (eq? tail new-tail) lis (cons x new-tail))))))) -(define (delete-duplicates! elt= lis) - (check-arg procedure? elt= delete-duplicates!) - (let recur ((lis lis)) - (if (null-list? lis) lis - (let* ((x (car lis)) - (tail (cdr lis)) - (new-tail (recur (delete! x tail elt=)))) - (if (eq? tail new-tail) lis (cons x new-tail)))))) +(define (delete-duplicates! lis maybe-=) + (let ((elt= (:optional maybe-= equal?))) + (check-arg procedure? elt= delete-duplicates!) + (let recur ((lis lis)) + (if (null-list? lis) lis + (let* ((x (car lis)) + (tail (cdr lis)) + (new-tail (recur (delete! x tail elt=)))) + (if (eq? tail new-tail) lis (cons x new-tail))))))) ;;; alist stuff @@ -1382,7 +1400,7 @@ ((null? ans) lis) ; if we don't have to. ((eq? lis ans) ans) (else - (fold (lambda (elt ans) (if (any (lambda (x) (= x elt))) + (fold (lambda (elt ans) (if (any (lambda (x) (= x elt)) ans) ans (cons elt ans))) ans lis)))) diff --git a/scsh/lib/list-pack.scm b/scsh/lib/list-pack.scm index 0c171ce..6fa562a 100644 --- a/scsh/lib/list-pack.scm +++ b/scsh/lib/list-pack.scm @@ -60,7 +60,7 @@ ;; list-copy lis (list-copy (proc (:value) :value)) - (circular-list (proc (:value &opt :value) :pair)) + (circular-list (proc (:value &rest :value) :pair)) ; ((:iota iota:) ; (proc (:number &opt :number :number) :value)) @@ -102,7 +102,7 @@ (unzip4 (proc (:value) (some-values :value :value :value :value))) (unzip5 (proc (:value) (some-values :value :value :value :value :value))) - (count (proc ((proc (:value) :boolean) :value) :exact-integer)) + (count (proc ((proc (:value &rest :value) :boolean) :value) :exact-integer)) ((fold fold-right) (proc ((proc (:value :value &rest :value) :value) diff --git a/scsh/lib/srfi-1.html b/scsh/lib/srfi-1.html index 73f9c50..8457db0 100644 --- a/scsh/lib/srfi-1.html +++ b/scsh/lib/srfi-1.html @@ -1,8 +1,7 @@ -

Constructors

@@ -771,7 +772,7 @@ an error or diverge when passed a circular list.
(cons elt1 (cons elt2 (cons ... eltn)))
- This function is called list* in Common Lisp and about + This function is called list* in Common Lisp and about half of the Schemes that provide it, and cons* in the other half. 
@@ -783,7 +784,7 @@ an error or diverge when passed a circular list.
 ==== make-list
 ============================================================================-->
 
-
 make-list n [fill] -> list
+
 make-list n [fill] -> list
 

     Returns an n-element list, 
     whose elements are all the value fill.
@@ -870,7 +871,7 @@ partition the entire universe of Scheme values.
     Note that this definition rules out circular lists. This
     function is required to detect this case and return false.
 

-    Nil-terminated lists are called "proper" lists by R5RS and Common Lisp.
+    Nil-terminated lists are called "proper" lists by R5RS and Common Lisp.
     The opposite of proper is improper.
 

     R5RS binds this function to the variable list?.
@@ -1011,7 +1012,8 @@ partition the entire universe of Scheme values.
         (eq? x y) => (elt= x y).
 
     Note that this implies that two lists which are eq? 
-    are always list=, as well.
+    are always list=, as well; implementations may exploit this
+    fact to "short-cut" the element-by-element comparisons.
 
 (list= eq?) => #t       ; Trivial cases
 (list= eq? '(a)) => #t
@@ -1318,6 +1320,8 @@ partition the entire universe of Scheme values.
 
 (append '(a b) '(c . d))  =>  (a b c . d)
 (append '() 'a)           =>  a
+(append '(x y))           =>  (x y)
+(append)                  =>  ()
 

 
     append! is the "linear-update" variant of append
@@ -1565,7 +1569,8 @@ partition the entire universe of Scheme values.
                               (pair-fold kons (kons lis knil) tail))
 (pair-fold kons knil '()) = knil
 

-    The kons function may reliably apply set-cdr! to the pairs it is given
+    For finite lists, the kons function may reliably apply
+    set-cdr! to the pairs it is given
     without altering the sequence of execution.
 

     Example:
@@ -1754,10 +1759,10 @@ Otherwise,    return (fold f (car list) (cdr li
 
 
 ;; List of squares: 1^2 ... 10^2
-(unfold (lambda (x) (> x 10))
-        (lambda (x) (* x x))
-	(lambda (x) (+ x 1))
-	1)
+(unfold-right (lambda (x) (> x 10))
+              (lambda (x) (* x x))
+	      (lambda (x) (+ x 1))
+	      1)
 		
 (unfold-right null-list? car cdr lis) ; Copy a proper list.
 
@@ -1870,10 +1875,7 @@ Otherwise,    return (fold f (car list) (cdr li
     specification to allow the arguments to be of unequal length; 
     it terminates when the shortest list runs out. 
 

-    At least one of the argument lists must be finite:
-
-(map + '(3 1 4 1) (circular-list 1 0)) => (4 1 5 1)
-

+    At least one of the argument lists must be finite.