summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorThien-Thi Nguyen <ttn@gnuvola.org>2002-01-21 01:11:35 +0000
committerThien-Thi Nguyen <ttn@gnuvola.org>2002-01-21 01:11:35 +0000
commit513a3bd72d5a646f3a0277bf07bce30dc4d91e73 (patch)
tree8a1bf7ebed7508285a65f83969009389e3a08d85
parentcdd2e6500e09efdf2a52655a1a3750adba686d3b (diff)
downloadguile-513a3bd72d5a646f3a0277bf07bce30dc4d91e73.tar.gz
(map1): Rewrite to be tail-recursive.
Thanks to Panagiotis Vossos for the bug report.
-rw-r--r--srfi/srfi-1.scm35
1 files changed, 20 insertions, 15 deletions
diff --git a/srfi/srfi-1.scm b/srfi/srfi-1.scm
index badd967fc..21475e323 100644
--- a/srfi/srfi-1.scm
+++ b/srfi/srfi-1.scm
@@ -1,17 +1,17 @@
;;;; srfi-1.scm --- SRFI-1 procedures for Guile
;;;;
;;;; Copyright (C) 2001 Free Software Foundation, Inc.
-;;;;
+;;;;
;;;; This program is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU General Public License as
;;;; published by the Free Software Foundation; either version 2, or
;;;; (at your option) any later version.
-;;;;
+;;;;
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;;; General Public License for more details.
-;;;;
+;;;;
;;;; You should have received a copy of the GNU General Public License
;;;; along with this software; see the file COPYING. If not, write to
;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
@@ -60,7 +60,7 @@
:use-module (ice-9 session)
:use-module (ice-9 receive))
-(export
+(export
;;; Constructors
;; cons <= in the core
;; list <= in the core
@@ -306,7 +306,7 @@
((not-pair? hare) #t)
(else
(let ((hare (cdr hare)))
- (cond
+ (cond
((null? hare) #f)
((not-pair? hare) #t)
((eq? hare tortoise) #f)
@@ -315,7 +315,7 @@
(define (null-list? x)
(cond
- ((proper-list? x)
+ ((proper-list? x)
(null? x))
((circular-list? x)
#f)
@@ -375,7 +375,7 @@
s
(lp0 (cdr s) (cdr l))))
(lp (- n 1) (cdr l)))))
-
+
(define (drop-right flist i)
(let lp ((n i) (l flist))
(if (<= n 0)
@@ -390,7 +390,7 @@
'()
(let lp ((n (- i 1)) (l x))
(if (<= n 0)
- (begin
+ (begin
(set-cdr! l '())
x)
(lp (- n 1) (cdr l))))))
@@ -468,7 +468,7 @@
(begin
(set-cdr! ntail (car l))
(lp (cdr l) (last-pair ntail))))))))))
-
+
(define (append-reverse rev-head tail)
(let lp ((l rev-head) (acc tail))
@@ -484,7 +484,7 @@
(if (any null? l)
(reverse! acc)
(lp (map1 cdr l) (cons (map1 car l) acc)))))
-
+
(define (unzip1 l)
(map1 first l))
@@ -603,10 +603,15 @@
;; 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))))))
+ (if (null? ls)
+ ls
+ (let ((ret (list (f (car ls)))))
+ (let lp ((ls (cdr ls)) (p ret)) ; tail pointer
+ (if (null? ls)
+ ret
+ (begin
+ (set-cdr! p (list (f (car ls))))
+ (lp (cdr ls) (cdr p))))))))
;; This `map' is extended from the standard `map'. It allows argument
;; lists of different length, so that the shortest list determines the
@@ -901,7 +906,7 @@
(define (delete-duplicates list . rest)
(let ((l= (if (pair? rest) (car rest) equal?)))
(let lp ((list list))
- (if (null? list)
+ (if (null? list)
'()
(cons (car list) (lp (delete (car list) (cdr list) l=)))))))