mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-30 23:10:21 +02:00
Code Activity

Port unrolled one-argument for-each from boot-9 to srfi-1

Browse source 
* module/srfi/srfi-1.scm (for-each): Port unrolled one-argument
  implementation here from the boot-9 version.
This commit is contained in:
Andy Wingo 2014-03-02 12:05:32 +01:00
parent 1a95246a39
commit 3c3de73d4d
1 changed files with 12 additions and 11 deletions
Download patch file Download diff file Expand all files Collapse all files

23
module/srfi/srfi-1.scm
View file

@ -1,6 +1,6 @@
;;; srfi-1.scm --- List Library ;;; 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 ;; This library is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public ;; modify it under the terms of the GNU Lesser General Public
@ -606,23 +606,24 @@ has just one element then that's the return value."
(case-lambda (case-lambda
((f l) ((f l)
(check-arg procedure? f for-each) (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 (pair? hare)
(if move? (begin
(if (eq? tortoise hare) (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" (scm-error 'wrong-type-arg "for-each" "Circular list: ~S"
(list l) #f) (list l) #f))
(begin
(f (car hare)) (f (car hare))
(for-each1 (cdr hare) (cdr tortoise) #f))) (for-each1 (cdr hare) (cdr tortoise)))
(begin (for-each1 hare tortoise))))
(f (car hare))
(for-each1 (cdr hare) tortoise #t)))
(if (not (null? hare)) (if (not (null? hare))
(scm-error 'wrong-type-arg "for-each" "Not a list: ~S" (scm-error 'wrong-type-arg "for-each" "Not a list: ~S"
(list l) #f))))) (list l) #f)))))
((f l1 . rest) ((f l1 . rest)
(check-arg procedure? f for-each) (check-arg procedure? f for-each)
(let ((len (fold (lambda (ls len) (let ((len (fold (lambda (ls len)