diff options
author | Andy Wingo <wingo@pobox.com> | 2014-03-02 12:05:32 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2014-03-02 12:05:32 +0100 |
commit | 3c3de73d4da32d2ae6371134a26449302524b8e0 (patch) | |
tree | 09d9b6cf97faeca513e4b0bf5d13ac6fec88d99a /module/srfi/srfi-1.scm | |
parent | 1a95246a39ad63d8bd3bcdd05b08cb469a922841 (diff) | |
download | guile-3c3de73d4da32d2ae6371134a26449302524b8e0.tar.gz |
Port unrolled one-argument for-each from boot-9 to srfi-1
* module/srfi/srfi-1.scm (for-each): Port unrolled one-argument
implementation here from the boot-9 version.
Diffstat (limited to 'module/srfi/srfi-1.scm')
-rw-r--r-- | module/srfi/srfi-1.scm | 23 |
1 files changed, 12 insertions, 11 deletions
diff --git a/module/srfi/srfi-1.scm b/module/srfi/srfi-1.scm index d2531b59d..74b01bc93 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, 2009, 2010, 2011 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2009, 2010, 2011, 2014 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 @@ -606,22 +606,23 @@ has just one element then that's the return value." (case-lambda ((f l) (check-arg procedure? f for-each) - (let for-each1 ((hare l) (tortoise l) (move? #f)) + (let for-each1 ((hare l) (tortoise l)) (if (pair? hare) - (if move? - (if (eq? tortoise hare) - (scm-error 'wrong-type-arg "for-each" "Circular list: ~S" - (list l) #f) + (begin + (f (car hare)) + (let ((hare (cdr hare))) + (if (pair? hare) (begin + (when (eq? tortoise hare) + (scm-error 'wrong-type-arg "for-each" "Circular list: ~S" + (list l) #f)) (f (car hare)) - (for-each1 (cdr hare) (cdr tortoise) #f))) - (begin - (f (car hare)) - (for-each1 (cdr hare) tortoise #t))) - + (for-each1 (cdr hare) (cdr tortoise))) + (for-each1 hare tortoise)))) (if (not (null? hare)) (scm-error 'wrong-type-arg "for-each" "Not a list: ~S" (list l) #f))))) + ((f l1 . rest) (check-arg procedure? f for-each) |