[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
guile/guile-core/srfi ChangeLog srfi-1.scm
From: |
Martin Grabmueller |
Subject: |
guile/guile-core/srfi ChangeLog srfi-1.scm |
Date: |
Mon, 02 Jul 2001 10:50:28 -0700 |
CVSROOT: /cvs
Module name: guile
Changes by: Martin Grabmueller <address@hidden> 01/07/02 10:50:28
Modified files:
guile-core/srfi: ChangeLog srfi-1.scm
Log message:
* srfi-1.scm: Replaced calls to `map' in several procedures to
calls to `map1'.
(map, for-each): New procedures, extended from R5RS.
CVSWeb URLs:
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/srfi/ChangeLog.diff?cvsroot=OldCVS&tr1=1.37&tr2=1.38&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/srfi/srfi-1.scm.diff?cvsroot=OldCVS&tr1=1.2&tr2=1.3&r1=text&r2=text
Patches:
Index: guile/guile-core/srfi/ChangeLog
diff -u guile/guile-core/srfi/ChangeLog:1.37
guile/guile-core/srfi/ChangeLog:1.38
--- guile/guile-core/srfi/ChangeLog:1.37 Thu Jun 28 09:39:00 2001
+++ guile/guile-core/srfi/ChangeLog Mon Jul 2 10:50:28 2001
@@ -1,3 +1,9 @@
+2001-07-02 Martin Grabmueller <address@hidden>
+
+ * srfi-1.scm: Replaced calls to `map' in several procedures to
+ calls to `map1'.
+ (map, for-each): New procedures, extended from R5RS.
+
2001-06-28 Martin Grabmueller <address@hidden>
* srfi-4.c: Minor cleanups.
Index: guile/guile-core/srfi/srfi-1.scm
diff -u guile/guile-core/srfi/srfi-1.scm:1.2
guile/guile-core/srfi/srfi-1.scm:1.3
--- guile/guile-core/srfi/srfi-1.scm:1.2 Thu Jun 7 10:54:40 2001
+++ guile/guile-core/srfi/srfi-1.scm Mon Jul 2 10:50:28 2001
@@ -164,8 +164,8 @@
reduce-right
unfold
unfold-right
- ;; map <= in the core
- ;; for-each <= in the core
+ map
+ for-each
append-map
append-map!
map!
@@ -471,20 +471,20 @@
(let lp ((l (cons clist1 rest)) (acc '()))
(if (any null? l)
(reverse! acc)
- (lp (map cdr l) (cons (map car l) acc)))))
+ (lp (map1 cdr l) (cons (map1 car l) acc)))))
(define (unzip1 l)
- (map first l))
+ (map1 first l))
(define (unzip2 l)
- (values (map first l) (map second l)))
+ (values (map1 first l) (map1 second l)))
(define (unzip3 l)
- (values (map first l) (map second l) (map third l)))
+ (values (map1 first l) (map1 second l) (map1 third l)))
(define (unzip4 l)
- (values (map first l) (map second l) (map third l) (map fourth l)))
+ (values (map1 first l) (map1 second l) (map1 third l) (map1 fourth l)))
(define (unzip5 l)
- (values (map first l) (map second l) (map third l) (map fourth l)
- (map fifth l)))
+ (values (map1 first l) (map1 second l) (map1 third l) (map1 fourth l)
+ (map1 fifth l)))
(define (count pred clist1 . rest)
(if (null? rest)
@@ -493,9 +493,9 @@
(cond ((any1 null? lists)
0)
(else
- (if (apply pred (map car lists))
- (+ 1 (lp (map cdr lists)))
- (lp (map cdr lists))))))))
+ (if (apply pred (map1 car lists))
+ (+ 1 (lp (map1 cdr lists)))
+ (lp (map1 cdr lists))))))))
(define (count1 pred clist)
(if (null? clist)
@@ -515,8 +515,8 @@
(let f ((knil knil) (lists (cons list1 rest)))
(if (any null? lists)
knil
- (let ((cars (map car lists))
- (cdrs (map cdr lists)))
+ (let ((cars (map1 car lists))
+ (cdrs (map1 cdr lists)))
(f (apply kons (append! cars (list knil))) cdrs))))))
(define (fold-right kons knil clist1 . rest)
@@ -528,7 +528,7 @@
(let f ((lists (cons clist1 rest)))
(if (any null? lists)
knil
- (apply kons (append! (map car lists) (list (f (map cdr lists)))))))))
+ (apply kons (append! (map1 car lists) (list (f (map1 cdr lists)))))))))
(define (pair-fold kons knil clist1 . rest)
(if (null? rest)
@@ -540,7 +540,7 @@
(let f ((knil knil) (lists (cons clist1 rest)))
(if (any null? lists)
knil
- (let ((tails (map cdr lists)))
+ (let ((tails (map1 cdr lists)))
(f (apply kons (append! lists (list knil))) tails))))))
@@ -553,7 +553,7 @@
(let f ((lists (cons clist1 rest)))
(if (any null? lists)
knil
- (apply kons (append! lists (list (f (map cdr lists)))))))))
+ (apply kons (append! lists (list (f (map1 cdr lists)))))))))
(define (unfold p f g seed . rest)
(let ((tail-gen (if (pair? rest)
@@ -587,6 +587,48 @@
(define (reduce-right f ridentity lst)
(fold-right f ridentity lst))
+
+;; Internal helper procedure. Map `f' over the single list `ls'.
+;;
+(define (map1 f ls)
+ (let lp ((l ls))
+ (if (null? l)
+ '()
+ (cons (f (car l)) (lp (cdr l))))))
+
+;; This `map' is extended from the standard `map'. It allows argument
+;; lists of different length, so that the shortest list determines the
+;; number of elements processed.
+;;
+(define (map f list1 . rest)
+ (if (null? rest)
+ (map1 f list1)
+ (let lp ((l (cons list1 rest)))
+ (if (any1 null? l)
+ '()
+ (cons (apply f (map1 car l)) (lp (map1 cdr l)))))))
+
+
+;; This `for-each' is extended from the standard `for-each'. It
+;; allows argument lists of different length, so that the shortest
+;; list determines the number of elements processed.
+;;
+(define (for-each f list1 . rest)
+ (if (null? rest)
+ (let lp ((l list1))
+ (if (null? l)
+ (if #f #f) ; Return unspecified value.
+ (begin
+ (f (car l))
+ (lp (cdr l)))))
+ (let lp ((l (cons list1 rest)))
+ (if (any1 null? l)
+ (if #f #f)
+ (begin
+ (apply f (map1 car l))
+ (lp (map1 cdr l)))))))
+
+
(define (append-map f clist1 . rest)
(if (null? rest)
(let lp ((l clist1))
@@ -596,7 +638,8 @@
(let lp ((l (cons clist1 rest)))
(if (any1 null? l)
'()
- (append (apply f (map car l)) (lp (map cdr l)))))))
+ (append (apply f (map1 car l)) (lp (map1 cdr l)))))))
+
(define (append-map! f clist1 . rest)
(if (null? rest)
@@ -607,7 +650,7 @@
(let lp ((l (cons clist1 rest)))
(if (any1 null? l)
'()
- (append! (apply f (map car l)) (lp (map cdr l)))))))
+ (append! (apply f (map1 car l)) (lp (map1 cdr l)))))))
(define (map! f list1 . rest)
(if (null? rest)
@@ -622,8 +665,8 @@
(if (any1 null? l)
'()
(begin
- (set-car! res (apply f (map car l)))
- (set-cdr! res (lp (map cdr l) (cdr res)))
+ (set-car! res (apply f (map1 car l)))
+ (set-cdr! res (lp (map1 cdr l) (cdr res)))
res)))))
(define (pair-for-each f clist1 . rest)
@@ -639,7 +682,7 @@
(if #f #f)
(begin
(apply f l)
- (lp (map cdr l)))))))
+ (lp (map1 cdr l)))))))
(define (filter-map f clist1 . rest)
(if (null? rest)
@@ -653,10 +696,10 @@
(let lp ((l (cons clist1 rest)))
(if (any1 null? l)
'()
- (let ((res (apply f (map car l))))
+ (let ((res (apply f (map1 car l))))
(if res
- (cons res (lp (map cdr l)))
- (lp (map cdr l))))))))
+ (cons res (lp (map1 cdr l)))
+ (lp (map1 cdr l))))))))
;;; Filtering & partitioning
@@ -753,10 +796,10 @@
(let lp ((lists (cons ls lists)))
(cond ((any1 null? lists)
#f)
- ((any1 null? (map cdr lists))
- (apply pred (map car lists)))
+ ((any1 null? (map1 cdr lists))
+ (apply pred (map1 car lists)))
(else
- (or (apply pred (map car lists)) (lp (map cdr lists))))))))
+ (or (apply pred (map1 car lists)) (lp (map1 cdr lists))))))))
(define (any1 pred ls)
(let lp ((ls ls))
@@ -773,10 +816,10 @@
(let lp ((lists (cons ls lists)))
(cond ((any1 null? lists)
#t)
- ((any1 null? (map cdr lists))
- (apply pred (map car lists)))
+ ((any1 null? (map1 cdr lists))
+ (apply pred (map1 car lists)))
(else
- (and (apply pred (map car lists)) (lp (map cdr lists))))))))
+ (and (apply pred (map1 car lists)) (lp (map1 cdr lists))))))))
(define (every1 pred ls)
(let lp ((ls ls))
@@ -798,9 +841,9 @@
(let lp ((lists (cons clist1 rest)) (i 0))
(cond ((any1 null? lists)
#f)
- ((apply pred (map car lists)) i)
+ ((apply pred (map1 car lists)) i)
(else
- (lp (map cdr lists) (+ i 1)))))))
+ (lp (map1 cdr lists) (+ i 1)))))))
(define (member x list . rest)
(let ((l= (if (pair? rest) (car rest) equal?)))
- guile/guile-core/srfi ChangeLog srfi-1.scm,
Martin Grabmueller <=