[Guile-commits] GNU Guile branch, master, updated. release_1-9-5-207-g2cf7ff2

[Ludovic Courtès]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=2cf7ff2e799cbbe80012545411a34653a6da2cf7

The branch, master has been updated
       via  2cf7ff2e799cbbe80012545411a34653a6da2cf7 (commit)
      from  dd902692fd307096121f32cfde135389c625ef78 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 2cf7ff2e799cbbe80012545411a34653a6da2cf7
Author: Ludovic Courtès <address@hidden>
Date:   Fri Dec 11 15:20:12 2009 +0100

    SRFI-1: Use the built-in optional argument support.
    
    * module/srfi/srfi-1.scm (iota, unfold, unfold-right, alist-delete,
      alist-delete!): Use `define*' and optional arguments instead of rest
      arguments.

-----------------------------------------------------------------------

Summary of changes:
 module/srfi/srfi-1.scm |   65 +++++++++++++++++------------------------------
 1 files changed, 24 insertions(+), 41 deletions(-)

diff --git a/module/srfi/srfi-1.scm b/module/srfi/srfi-1.scm
index db21122..c32eb1c 100644
--- a/module/srfi/srfi-1.scm
+++ b/module/srfi/srfi-1.scm
@@ -1,6 +1,6 @@
 ;;; srfi-1.scm --- List Library
 
-;;     Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006 Free Software 
Foundation, Inc.
+;;     Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2009 Free Software 
Foundation, Inc.
 ;;
 ;; This library is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU Lesser General Public
@@ -242,14 +242,12 @@
   (set-cdr! (last-pair elts) elts)
   elts)
 
-(define (iota count . rest)
+(define* (iota count #:optional (start 0) (step 1))
   (check-arg-type non-negative-integer? count "iota")
-  (let ((start (if (pair? rest) (car rest) 0))
-       (step (if (and (pair? rest) (pair? (cdr rest))) (cadr rest) 1)))
-    (let lp ((n 0) (acc '()))
-      (if (= n count)
+  (let lp ((n 0) (acc '()))
+    (if (= n count)
        (reverse! acc)
-       (lp (+ n 1) (cons (+ start (* n step)) acc))))))
+       (lp (+ n 1) (cons (+ start (* n step)) acc)))))
 
 ;;; Predicates
 
@@ -381,31 +379,18 @@
        knil
        (apply kons (append! lists (list (f (map1 cdr lists)))))))))
 
-(define (unfold p f g seed . rest)
-  (let ((tail-gen (if (pair? rest)
-                     (if (pair? (cdr rest))
-                         (scm-error 'wrong-number-of-args
-                                    "unfold" "too many arguments" '() '())
-                         (car rest))
-                     (lambda (x) '()))))
-    (let uf ((seed seed))
-      (if (p seed)
-         (tail-gen seed)
-         (cons (f seed)
-               (uf (g seed)))))))
-
-(define (unfold-right p f g seed . rest)
-  (let ((tail (if (pair? rest)
-                 (if (pair? (cdr rest))
-                     (scm-error 'wrong-number-of-args
-                                    "unfold-right" "too many arguments" '()
-                                    '())
-                     (car rest))
-                     '())))
-    (let uf ((seed seed) (lis tail))
-      (if (p seed)
-         lis
-         (uf (g seed) (cons (f seed) lis))))))
+(define* (unfold p f g seed #:optional (tail-gen (lambda (x) '())))
+  (let uf ((seed seed))
+    (if (p seed)
+        (tail-gen seed)
+        (cons (f seed)
+              (uf (g seed))))))
+
+(define* (unfold-right p f g seed #:optional (tail '()))
+  (let uf ((seed seed) (lis tail))
+    (if (p seed)
+        lis
+        (uf (g seed) (cons (f seed) lis)))))
 
 
 ;; Internal helper procedure.  Map `f' over the single list `ls'.
@@ -482,18 +467,16 @@
 
 (define alist-cons acons)
 
-(define (alist-delete key alist . rest)
-  (let ((k= (if (pair? rest) (car rest) equal?)))
-    (let lp ((a alist) (rl '()))
-      (if (null? a)
+(define* (alist-delete key alist #:optional (k= equal?))
+  (let lp ((a alist) (rl '()))
+    (if (null? a)
        (reverse! rl)
        (if (k= key (caar a))
-         (lp (cdr a) rl)
-         (lp (cdr a) (cons (car a) rl)))))))
+            (lp (cdr a) rl)
+            (lp (cdr a) (cons (car a) rl))))))
 
-(define (alist-delete! key alist . rest)
-  (let ((k= (if (pair? rest) (car rest) equal?)))
-    (alist-delete key alist k=)))      ; XXX:optimize
+(define* (alist-delete! key alist #:optional (k= equal?))
+  (alist-delete key alist k=)) ; XXX:optimize
 
 ;;; Set operations on lists
 


hooks/post-receive
-- 
GNU Guile