mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-01 12:20:26 +02:00
Code Activity

(improper-list-copy): New.

Browse source 
(parse-arglist): Use it instead of list-copy.
This commit is contained in:
Marius Vollmer 2002-12-12 20:43:11 +00:00
parent e200ddeeb2
commit 2a05206662
1 changed files with 8 additions and 2 deletions
Download patch file Download diff file Expand all files Collapse all files

10
ice-9/optargs.scm
View file

@ -1,6 +1,6 @@
;;;; optargs.scm -- support for optional arguments
;;;;
;;;; Copyright (C) 1997, 1998, 1999, 2001 Free Software Foundation, Inc.
;;;; Copyright (C) 1997, 1998, 1999, 2001, 2002 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
@ -313,6 +313,12 @@
(or (symbol? obj)
(and (list? obj) (= 2 (length obj)) (symbol? (car obj)))))
;; XXX - not tail recursive
(define (improper-list-copy obj)
(if (pair? obj)
(cons (car obj) (improper-list-copy (cdr obj)))
obj))
(define (parse-arglist arglist cont)
(define (split-list-at val lst cont)
(cond
@ -355,7 +361,7 @@
((null? arglist) (cont '() '() '() #f #f))
((not (pair? arglist)) (cont '() '() '() #f arglist))
((not (list? arglist))
(let* ((copy (list-copy arglist))
(let* ((copy (improper-list-copy arglist))
(lp (last-pair copy))
(ra (cdr lp)))
(set-cdr! lp '())