Implement REVERSE* and REVERSE*!, like REVERSE and REVERSE! but a

non-null tail element can be specified.

diff --git a/v7/src/runtime/list.scm b/v7/src/runtime/list.scm
index 2be56e5378e1cee40d1d08f305532fac319c36db..dddb93d0aa420b3ad81e213b49e648c812cd00cd 100644 (file)
--- a/v7/src/runtime/list.scm
+++ b/v7/src/runtime/list.scm
@@ -1,10 +1,10 @@
 #| -*-Scheme-*-
 
-$Id: list.scm,v 14.37 2003/04/25 03:31:49 cph Exp $
+$Id: list.scm,v 14.38 2004/01/09 21:12:16 cph Exp $
 
 Copyright 1986,1987,1988,1989,1990,1991 Massachusetts Institute of Technology
 Copyright 1992,1993,1994,1995,1996,2000 Massachusetts Institute of Technology
-Copyright 2001,2002,2003 Massachusetts Institute of Technology
+Copyright 2001,2002,2003,2004 Massachusetts Institute of Technology
 
 This file is part of MIT/GNU Scheme.
 
@@ -434,8 +434,8 @@ USA.
 ;;; clever compiler could optimize this into the obvious loop that
 ;;; everyone would write in assembly language.
 
-(define (append . lists)
-  (%append lists))
+(define (append . lists) (%append lists))
+(define (append! . lists) (%append! lists))
 
 (define (%append lists)
   (let ((lists (reverse! lists)))
@@ -466,9 +466,6 @@ USA.
              accum))
        '())))
 
-(define (append! . lists)
-  (%append! lists))
-
 (define (%append! lists)
   (if (pair? lists)
       (let loop ((head (car lists)) (tail (cdr lists)))
@@ -483,27 +480,27 @@ USA.
               (loop (car tail) (cdr tail)))))
       '()))
 
-(define (reverse l)
-  (%reverse l '()))
+(define (reverse l) (reverse* l '()))
+(define (reverse! l) (reverse*! l '()))
 
-(define (%reverse l tail)
+(define (reverse* l tail)
   (let loop ((rest l) (so-far tail))
     (if (pair? rest)
        (loop (cdr rest) (cons (car rest) so-far))
        (begin
          (if (not (null? rest))
-             (error:wrong-type-argument l "list" '%REVERSE))
+             (error:wrong-type-argument l "list" 'REVERSE*))
          so-far))))
 
-(define (reverse! l)
-  (let loop ((current l) (new-cdr '()))
+(define (reverse*! l tail)
+  (let loop ((current l) (new-cdr tail))
     (if (pair? current)
        (let ((next (cdr current)))
          (set-cdr! current new-cdr)
          (loop next current))
        (begin
          (if (not (null? current))
-             (error:wrong-type-argument l "list" 'REVERSE!))
+             (error:wrong-type-argument l "list" 'REVERSE*!))
          new-cdr))))
 \f
 ;;;; Mapping Procedures

diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index f1f84a1890cfa754c5d7a6db3048dea194490402..560f718785dc45c1bc59a4dde4836652252bd88b 100644 (file)
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.470 2004/01/06 06:22:37 cph Exp $
+$Id: runtime.pkg,v 14.471 2004/01/09 21:12:19 cph Exp $
 
 Copyright 1988,1989,1990,1991,1992,1993 Massachusetts Institute of Technology
 Copyright 1994,1995,1996,1997,1998,1999 Massachusetts Institute of Technology
@@ -2104,6 +2104,8 @@ USA.
          reduce-right
          reverse
          reverse!
+         reverse*
+         reverse*!
          second
          set-car!
          set-cdr!