1 |
;;;; optargs.scm -- support for optional arguments |
;;;; optargs.scm -- support for optional arguments |
2 |
;;;; |
;;;; |
3 |
;;;; Copyright (C) 1997, 1998, 1999, 2001 Free Software Foundation, Inc. |
;;;; Copyright (C) 1997, 1998, 1999, 2001, 2002 Free Software Foundation, Inc. |
4 |
;;;; |
;;;; |
5 |
;;;; This program is free software; you can redistribute it and/or modify |
;;;; This program is free software; you can redistribute it and/or modify |
6 |
;;;; it under the terms of the GNU General Public License as published by |
;;;; it under the terms of the GNU General Public License as published by |
326 |
(or (symbol? obj) |
(or (symbol? obj) |
327 |
(and (list? obj) (= 2 (length obj)) (symbol? (car obj))))) |
(and (list? obj) (= 2 (length obj)) (symbol? (car obj))))) |
328 |
|
|
329 |
|
;; XXX - not tail recursive |
330 |
|
(define (improper-list-copy obj) |
331 |
|
(if (pair? obj) |
332 |
|
(cons (car obj) (improper-list-copy (cdr obj))) |
333 |
|
obj)) |
334 |
|
|
335 |
(define (parse-arglist arglist cont) |
(define (parse-arglist arglist cont) |
336 |
(define (split-list-at val lst cont) |
(define (split-list-at val lst cont) |
337 |
(cond |
(cond |
374 |
((null? arglist) (cont '() '() '() #f #f)) |
((null? arglist) (cont '() '() '() #f #f)) |
375 |
((not (pair? arglist)) (cont '() '() '() #f arglist)) |
((not (pair? arglist)) (cont '() '() '() #f arglist)) |
376 |
((not (list? arglist)) |
((not (list? arglist)) |
377 |
(let* ((copy (list-copy arglist)) |
(let* ((copy (improper-list-copy arglist)) |
378 |
(lp (last-pair copy)) |
(lp (last-pair copy)) |
379 |
(ra (cdr lp))) |
(ra (cdr lp))) |
380 |
(set-cdr! lp '()) |
(set-cdr! lp '()) |
381 |
(if (memq #:rest copy) |
(if (memq #:rest copy) |
382 |
(error "Cannot specify both #:rest and dotted rest argument.") |
(error "Cannot specify both #:rest and dotted rest argument.") |
383 |
(parse-keys copy ra cont)))) |
(parse-keys copy ra cont)))) |
384 |
(else (split-list-at |
(else (split-list-at |
385 |
#:rest arglist |
#:rest arglist |
386 |
(lambda (before after split?) |
(lambda (before after split?) |