(format): Wrap a monitor around format:format since it is not

[bpt/guile.git] / ice-9 / optargs.scm

diff --git a/ice-9/optargs.scm b/ice-9/optargs.scm
index 5506a38..bbeab8c 100644 (file)
--- a/ice-9/optargs.scm
+++ b/ice-9/optargs.scm
@@ -1,29 +1,51 @@
 ;;;; optargs.scm -- support for optional arguments
 ;;;;
 ;;;; optargs.scm -- support for optional arguments
 ;;;;

-;;;;   Copyright (C) 1997, 1998, 1999 Free Software Foundation, Inc.
-;;;; 
+;;;;   Copyright (C) 1997, 1998, 1999, 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 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.
 ;;;; 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,
 ;;;; Boston, MA 02111-1307 USA
 ;;;; 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,
 ;;;; Boston, MA 02111-1307 USA

-;;;; 
+;;;;
+;;;; As a special exception, the Free Software Foundation gives permission
+;;;; for additional uses of the text contained in its release of GUILE.
+;;;;
+;;;; The exception is that, if you link the GUILE library with other files
+;;;; to produce an executable, this does not by itself cause the
+;;;; resulting executable to be covered by the GNU General Public License.
+;;;; Your use of that executable is in no way restricted on account of
+;;;; linking the GUILE library code into it.
+;;;;
+;;;; This exception does not however invalidate any other reasons why
+;;;; the executable file might be covered by the GNU General Public License.
+;;;;
+;;;; This exception applies only to the code released by the
+;;;; Free Software Foundation under the name GUILE.  If you copy
+;;;; code from other Free Software Foundation releases into a copy of
+;;;; GUILE, as the General Public License permits, the exception does
+;;;; not apply to the code that you add in this way.  To avoid misleading
+;;;; anyone as to the status of such modified files, you must delete
+;;;; this exception notice from them.
+;;;;
+;;;; If you write modifications of your own for GUILE, it is your choice
+;;;; whether to permit this exception to apply to your modifications.
+;;;; If you do not wish that, delete this exception notice.
+;;;;

 ;;;; Contributed by Maciej Stachowiak <mstachow@alum.mit.edu>
 
 \f
 
 ;;;; Contributed by Maciej Stachowiak <mstachow@alum.mit.edu>
 
 \f
 

-(define-module (ice-9 optargs))
-
-\f
+;;; Commentary:

 
 ;;; {Optional Arguments}
 ;;;
 
 ;;; {Optional Arguments}
 ;;;


@@ -33,14 +55,13 @@
 ;;; a convenient and attractive syntax.
 ;;;
 ;;; exported macros are:
 ;;; a convenient and attractive syntax.
 ;;;
 ;;; exported macros are:

-;;;   bound?

 ;;;   let-optional
 ;;;   let-optional*
 ;;;   let-keywords
 ;;;   let-keywords*
 ;;;   lambda*
 ;;;   define*
 ;;;   let-optional
 ;;;   let-optional*
 ;;;   let-keywords
 ;;;   let-keywords*
 ;;;   lambda*
 ;;;   define*

-;;;   define*-public   
+;;;   define*-public

 ;;;   defmacro*
 ;;;   defmacro*-public
 ;;;
 ;;;   defmacro*
 ;;;   defmacro*-public
 ;;;


@@ -49,55 +70,48 @@
 ;;; are used to indicate grouping only):
 ;;;
 ;;; ext-param-list ::= [identifier]* [#:optional [ext-var-decl]+]?
 ;;; are used to indicate grouping only):
 ;;;
 ;;; ext-param-list ::= [identifier]* [#:optional [ext-var-decl]+]?

-;;;   [#:key [ext-var-decl]+ [#:allow-other-keys]?]? 
+;;;   [#:key [ext-var-decl]+ [#:allow-other-keys]?]?

 ;;;   [[#:rest identifier]|[. identifier]]?
 ;;;
 ;;;   [[#:rest identifier]|[. identifier]]?
 ;;;

-;;; ext-var-decl ::= identifier | ( identifier expression )  
+;;; ext-var-decl ::= identifier | ( identifier expression )

 ;;;
 ;;; The characters `*', `+' and `?' are not to be taken literally; they
 ;;; mean respectively, zero or more occurences, one or more occurences,
 ;;; and one or zero occurences.
 ;;;
 
 ;;;
 ;;; The characters `*', `+' and `?' are not to be taken literally; they
 ;;; mean respectively, zero or more occurences, one or more occurences,
 ;;; and one or zero occurences.
 ;;;
 

+;;; Code:

 
 

-
-;; bound? var
-;;   Checks if a variable is bound in the current environment.
-;;
-;; defined? doesn't quite cut it as it stands, since it only
-;; checks bindings in the top-level environment, not those in
-;; local scope only.
-;;
-
-(defmacro-public bound? (var)
-  `(catch 'misc-error
-         (lambda () 
-           ,var 
-           (not (eq? ,var ,(variable-ref 
-                           (make-undefined-variable)))))
-         (lambda args #f)))
-
+(define-module (ice-9 optargs)
+  :export-syntax (let-optional
+                 let-optional*
+                 let-keywords
+                 let-keywords*
+                 define* lambda*
+                 define*-public
+                 defmacro*
+                 defmacro*-public))

 
 ;; let-optional rest-arg (binding ...) . body
 ;; let-optional* rest-arg (binding ...) . body
 ;;   macros used to bind optional arguments
 ;;
 
 ;; let-optional rest-arg (binding ...) . body
 ;; let-optional* rest-arg (binding ...) . body
 ;;   macros used to bind optional arguments
 ;;

-;; These two macros give you an optional argument interface that
-;; is very "Schemey" and introduces no fancy syntax. They are
-;; compatible with the scsh macros of the same name, but are slightly
+;; These two macros give you an optional argument interface that is
+;; very "Schemey" and introduces no fancy syntax. They are compatible
+;; with the scsh macros of the same name, but are slightly

 ;; extended. Each of binding may be of one of the forms <var> or
 ;; (<var> <default-value>). rest-arg should be the rest-argument of
 ;; the procedures these are used from. The items in rest-arg are
 ;; sequentially bound to the variable namess are given. When rest-arg
 ;; runs out, the remaining vars are bound either to the default values
 ;; extended. Each of binding may be of one of the forms <var> or
 ;; (<var> <default-value>). rest-arg should be the rest-argument of
 ;; the procedures these are used from. The items in rest-arg are
 ;; sequentially bound to the variable namess are given. When rest-arg
 ;; runs out, the remaining vars are bound either to the default values

-;; or left unbound if no default value was specified. rest-arg remains
+;; or to `#f' if no default value was specified. rest-arg remains

 ;; bound to whatever may have been left of rest-arg.
 ;;
 
 ;; bound to whatever may have been left of rest-arg.
 ;;
 

-(defmacro-public let-optional (REST-ARG BINDINGS . BODY)
+(defmacro let-optional (REST-ARG BINDINGS . BODY)

   (let-optional-template REST-ARG BINDINGS BODY 'let))
 
   (let-optional-template REST-ARG BINDINGS BODY 'let))
 

-(defmacro-public let-optional* (REST-ARG BINDINGS . BODY)
+(defmacro let-optional* (REST-ARG BINDINGS . BODY)

   (let-optional-template REST-ARG BINDINGS BODY 'let*))
 
 
   (let-optional-template REST-ARG BINDINGS BODY 'let*))
 
 


@@ -111,27 +125,26 @@
 ;; duplicates keyword args in the rest arg. More explanation of what
 ;; keyword arguments in a lambda list look like can be found below in
 ;; the documentation for lambda*.  Bindings can have the same form as
 ;; duplicates keyword args in the rest arg. More explanation of what
 ;; keyword arguments in a lambda list look like can be found below in
 ;; the documentation for lambda*.  Bindings can have the same form as

-;; for let-optional. If allow-other-keys? is false, an error will be 
+;; for let-optional. If allow-other-keys? is false, an error will be

 ;; thrown if anything that looks like a keyword argument but does not
 ;; match a known keyword parameter will result in an error.
 ;;
 
 
 ;; thrown if anything that looks like a keyword argument but does not
 ;; match a known keyword parameter will result in an error.
 ;;
 
 

-(defmacro-public let-keywords (REST-ARG ALLOW-OTHER-KEYS? BINDINGS . BODY)
+(defmacro let-keywords (REST-ARG ALLOW-OTHER-KEYS? BINDINGS . BODY)

   (let-keywords-template REST-ARG ALLOW-OTHER-KEYS? BINDINGS BODY 'let))
 
   (let-keywords-template REST-ARG ALLOW-OTHER-KEYS? BINDINGS BODY 'let))
 

-(defmacro-public let-keywords* (REST-ARG ALLOW-OTHER-KEYS? BINDINGS . BODY)
+(defmacro let-keywords* (REST-ARG ALLOW-OTHER-KEYS? BINDINGS . BODY)

   (let-keywords-template REST-ARG ALLOW-OTHER-KEYS? BINDINGS BODY 'let*))
 
 
 ;; some utility procedures for implementing the various let-forms.
 
 (define (let-o-k-template REST-ARG BINDINGS BODY let-type proc)
   (let-keywords-template REST-ARG ALLOW-OTHER-KEYS? BINDINGS BODY 'let*))
 
 
 ;; some utility procedures for implementing the various let-forms.
 
 (define (let-o-k-template REST-ARG BINDINGS BODY let-type proc)

-  (let ((bindings (map (lambda (x) 
+  (let ((bindings (map (lambda (x)

                         (if (list? x)
                             x
                         (if (list? x)
                             x

-                            (list x (variable-ref
-                                     (make-undefined-variable)))))
+                            (list x #f)))

                       BINDINGS)))
     `(,let-type ,(map proc bindings) ,@BODY)))
 
                       BINDINGS)))
     `(,let-type ,(map proc bindings) ,@BODY)))
 


@@ -139,8 +152,8 @@
     (if (null? BINDINGS)
        `(begin ,@BODY)
        (let-o-k-template REST-ARG BINDINGS BODY let-type
     (if (null? BINDINGS)
        `(begin ,@BODY)
        (let-o-k-template REST-ARG BINDINGS BODY let-type

-                         (lambda (optional) 
-                           `(,(car optional) 
+                         (lambda (optional)
+                           `(,(car optional)

                              (cond
                               ((not (null? ,REST-ARG))
                                (let ((result (car ,REST-ARG)))
                              (cond
                               ((not (null? ,REST-ARG))
                                (let ((result (car ,REST-ARG)))


@@ -157,11 +170,11 @@
               (bindfilter (lambda (key)
                             `(,(car key)
                               (cond
               (bindfilter (lambda (key)
                             `(,(car key)
                               (cond

-                               ((assq ',(car key) ,kb-list-gensym) 
+                               ((assq ',(car key) ,kb-list-gensym)

                                 => cdr)
                                 => cdr)

-                               (else 
+                               (else

                                 ,(cadr key)))))))
                                 ,(cadr key)))))))

-         `(let* ((ra->kbl ,rest-arg->keyword-binding-list) 
+         `(let* ((ra->kbl ,rest-arg->keyword-binding-list)

                  (,kb-list-gensym (ra->kbl ,REST-ARG ',(map
                                                         (lambda (x) (symbol->keyword (if (pair? x) (car x) x)))
                                                         BINDINGS)
                  (,kb-list-gensym (ra->kbl ,REST-ARG ',(map
                                                         (lambda (x) (symbol->keyword (if (pair? x) (car x) x)))
                                                         BINDINGS)


@@ -186,7 +199,7 @@
                    (error "Keyword argument has no value.")
                    (next (cons (cons (keyword->symbol first)
                                      (car rest)) accum))))
                    (error "Keyword argument has no value.")
                    (next (cons (cons (keyword->symbol first)
                                      (car rest)) accum))))

-              ((not allow-other-keys?) 
+              ((not allow-other-keys?)

                (error "Unknown keyword in arguments."))
               (else (if (null? rest)
                         accum
                (error "Unknown keyword in arguments."))
               (else (if (null? rest)
                         accum


@@ -195,32 +208,17 @@
                  accum
                  (loop (car rest) (cdr rest) accum)))))))
 
                  accum
                  (loop (car rest) (cdr rest) accum)))))))
 

-;; This is a reader extension to support the (deprecated) use of
-;; "#&optional" instead of "#:optional"
-
-(read-hash-extend #\& (lambda (c port)
-                       (display 
-                        "WARNING: `#&' is deprecated, use `#:' instead\n"
-                        (current-error-port))
-                       (case (read port)
-                         ((optional) #:optional)
-                         ((key) #:key)
-                         ((rest) #:rest)
-                         ((allow-other-keys) #:allow-other-keys)
-                         (else (error "Bad #& value.")))))
-

 
 ;; lambda* args . body
 ;;   lambda extended for optional and keyword arguments
 
 ;; lambda* args . body
 ;;   lambda extended for optional and keyword arguments

-;;   
+;;

 ;; lambda* creates a procedure that takes optional arguments. These
 ;; are specified by putting them inside brackets at the end of the
 ;; paramater list, but before any dotted rest argument. For example,
 ;;   (lambda* (a b #:optional c d . e) '())
 ;; creates a procedure with fixed arguments a and b, optional arguments c
 ;; and d, and rest argument e. If the optional arguments are omitted
 ;; lambda* creates a procedure that takes optional arguments. These
 ;; are specified by putting them inside brackets at the end of the
 ;; paramater list, but before any dotted rest argument. For example,
 ;;   (lambda* (a b #:optional c d . e) '())
 ;; creates a procedure with fixed arguments a and b, optional arguments c
 ;; and d, and rest argument e. If the optional arguments are omitted

-;; in a call, the variables for them are unbound in the procedure. This
-;; can be checked with the bound? macro.
+;; in a call, the variables for them are bound to `#f'.

 ;;
 ;; lambda* can also take keyword arguments. For example, a procedure
 ;; defined like this:
 ;;
 ;; lambda* can also take keyword arguments. For example, a procedure
 ;; defined like this:


@@ -232,11 +230,11 @@
 ;; Optional and keyword arguments can also be given default values
 ;; which they take on when they are not present in a call, by giving a
 ;; two-item list in place of an optional argument, for example in:
 ;; Optional and keyword arguments can also be given default values
 ;; which they take on when they are not present in a call, by giving a
 ;; two-item list in place of an optional argument, for example in:

-;;   (lambda* (foo #:optional (bar 42) #:key (baz 73)) (list foo bar baz)) 
+;;   (lambda* (foo #:optional (bar 42) #:key (baz 73)) (list foo bar baz))

 ;; foo is a fixed argument, bar is an optional argument with default
 ;; value 42, and baz is a keyword argument with default value 73.
 ;; Default value expressions are not evaluated unless they are needed
 ;; foo is a fixed argument, bar is an optional argument with default
 ;; value 42, and baz is a keyword argument with default value 73.
 ;; Default value expressions are not evaluated unless they are needed

-;; and until the procedure is called.  
+;; and until the procedure is called.

 ;;
 ;; lambda* now supports two more special parameter list keywords.
 ;;
 ;;
 ;; lambda* now supports two more special parameter list keywords.
 ;;


@@ -258,11 +256,11 @@
 ;; Lisp dialects.
 
 
 ;; Lisp dialects.
 
 

-(defmacro-public lambda* (ARGLIST . BODY)
-  (parse-arglist 
+(defmacro lambda* (ARGLIST . BODY)
+  (parse-arglist

    ARGLIST
    (lambda (non-optional-args optionals keys aok? rest-arg)
    ARGLIST
    (lambda (non-optional-args optionals keys aok? rest-arg)

-     ; Check for syntax errors.
+     ;; Check for syntax errors.

      (if (not (every? symbol? non-optional-args))
         (error "Syntax error in fixed argument declaration."))
      (if (not (every? ext-decl? optionals))
      (if (not (every? symbol? non-optional-args))
         (error "Syntax error in fixed argument declaration."))
      (if (not (every? ext-decl? optionals))


@@ -272,27 +270,37 @@
      (if (not (or (symbol? rest-arg) (eq? #f rest-arg)))
         (error "Syntax error in rest argument declaration."))
      ;; generate the code.
      (if (not (or (symbol? rest-arg) (eq? #f rest-arg)))
         (error "Syntax error in rest argument declaration."))
      ;; generate the code.

-     (let ((rest-gensym (or rest-arg (gensym "lambda*:G"))))
+     (let ((rest-gensym (or rest-arg (gensym "lambda*:G")))
+          (lambda-gensym (gensym "lambda*:L")))

        (if (not (and (null? optionals) (null? keys)))
        (if (not (and (null? optionals) (null? keys)))

-          `(lambda (,@non-optional-args . ,rest-gensym)
-             ;; Make sure that if the proc had a docstring, we put it
-             ;; here where it will be visible.
-             ,@(if (and (not (null? BODY))
-                        (string? (car BODY)))
-                   (list (car BODY))
-                   '())
-             (let-optional* 
-              ,rest-gensym
-              ,optionals
-              (let-keywords* ,rest-gensym
-                             ,aok?
-                             ,keys
-                             ,@(if (and (not rest-arg) (null? keys))
-                                   `((if (not (null? ,rest-gensym))
-                                         (error "Too many arguments.")))
-                                   '())
-                             ,@BODY)))
-          `(lambda (,@non-optional-args . ,(if rest-arg rest-arg '())) 
+          `(let ((,lambda-gensym
+                  (lambda (,@non-optional-args . ,rest-gensym)
+                    ;; Make sure that if the proc had a docstring, we put it
+                    ;; here where it will be visible.
+                    ,@(if (and (not (null? BODY))
+                               (string? (car BODY)))
+                          (list (car BODY))
+                          '())
+                    (let-optional*
+                     ,rest-gensym
+                     ,optionals
+                     (let-keywords* ,rest-gensym
+                                    ,aok?
+                                    ,keys
+                                    ,@(if (and (not rest-arg) (null? keys))
+                                          `((if (not (null? ,rest-gensym))
+                                                (error "Too many arguments.")))
+                                          '())
+                                    (let ()
+                                      ,@BODY))))))
+             (set-procedure-property! ,lambda-gensym 'arglist
+                                      '(,non-optional-args
+                                        ,optionals
+                                        ,keys
+                                        ,aok?
+                                        ,rest-arg))
+             ,lambda-gensym)
+          `(lambda (,@non-optional-args . ,(if rest-arg rest-arg '()))

              ,@BODY))))))
 
 
              ,@BODY))))))
 
 


@@ -302,7 +310,7 @@
           (every? pred (cdr lst)))))
 
 (define (ext-decl? obj)
           (every? pred (cdr lst)))))
 
 (define (ext-decl? obj)

-  (or (symbol? obj) 
+  (or (symbol? obj)

       (and (list? obj) (= 2 (length obj)) (symbol? (car obj)))))
 
 (define (parse-arglist arglist cont)
       (and (list? obj) (= 2 (length obj)) (symbol? (car obj)))))
 
 (define (parse-arglist arglist cont)


@@ -311,9 +319,9 @@
      ((memq val lst)
       => (lambda (pos)
           (if (memq val (cdr pos))
      ((memq val lst)
       => (lambda (pos)
           (if (memq val (cdr pos))

-              (error (with-output-to-string 
+              (error (with-output-to-string

                        (lambda ()
                        (lambda ()

-                         (map display `(,val 
+                         (map display `(,val

                                         " specified more than once in argument list.")))))
               (cont (reverse (cdr (memq val (reverse lst)))) (cdr pos) #t))))
      (else (cont lst '() #f))))
                                         " specified more than once in argument list.")))))
               (cont (reverse (cdr (memq val (reverse lst)))) (cdr pos) #t))))
      (else (cont lst '() #f))))


@@ -325,25 +333,25 @@
           (error "#:optional specified but no optional arguments declared.")
           (cont before after keys aok? rest)))))
   (define (parse-keys arglist rest cont)
           (error "#:optional specified but no optional arguments declared.")
           (cont before after keys aok? rest)))))
   (define (parse-keys arglist rest cont)

-    (split-list-at 
+    (split-list-at

      #:allow-other-keys arglist
      (lambda (aok-before aok-after aok-split?)
        (if (and aok-split? (not (null? aok-after)))
           (error "#:allow-other-keys not at end of keyword argument declarations.")
      #:allow-other-keys arglist
      (lambda (aok-before aok-after aok-split?)
        (if (and aok-split? (not (null? aok-after)))
           (error "#:allow-other-keys not at end of keyword argument declarations.")

-          (split-list-at 
+          (split-list-at

            #:key aok-before
            (lambda (key-before key-after key-split?)
            #:key aok-before
            (lambda (key-before key-after key-split?)

-             (cond 
+             (cond

               ((and aok-split? (not key-split?))
                (error "#:allow-other-keys specified but no keyword arguments declared."))
               ((and aok-split? (not key-split?))
                (error "#:allow-other-keys specified but no keyword arguments declared."))

-              (key-split? 
+              (key-split?

                (cond
                 ((null? key-after) (error "#:key specified but no keyword arguments declared."))
                 ((memq #:optional key-after) (error "#:optional arguments declared after #:key arguments."))
                 (else (parse-opt-and-fixed key-before key-after aok-split? rest cont))))
               (else (parse-opt-and-fixed arglist '() #f rest cont)))))))))
   (define (parse-rest arglist cont)
                (cond
                 ((null? key-after) (error "#:key specified but no keyword arguments declared."))
                 ((memq #:optional key-after) (error "#:optional arguments declared after #:key arguments."))
                 (else (parse-opt-and-fixed key-before key-after aok-split? rest cont))))
               (else (parse-opt-and-fixed arglist '() #f rest cont)))))))))
   (define (parse-rest arglist cont)

-    (cond 
+    (cond

      ((null? arglist) (cont '() '() '() #f #f))
      ((not (pair? arglist)) (cont '() '() '() #f arglist))
      ((not (list? arglist))
      ((null? arglist) (cont '() '() '() #f #f))
      ((not (pair? arglist)) (cont '() '() '() #f arglist))
      ((not (list? arglist))


@@ -354,8 +362,8 @@
            (if (memq #:rest copy)
                (error "Cannot specify both #:rest and dotted rest argument.")
                (parse-keys copy ra cont))))
            (if (memq #:rest copy)
                (error "Cannot specify both #:rest and dotted rest argument.")
                (parse-keys copy ra cont))))

-     (else (split-list-at 
-           #:rest arglist 
+     (else (split-list-at
+           #:rest arglist

            (lambda (before after split?)
              (if split?
                  (case (length after)
            (lambda (before after split?)
              (if split?
                  (case (length after)


@@ -382,15 +390,15 @@
 ;;   (define-public* ((foo #:optional bar) #:optional baz) '())
 ;; This illustrates currying. A procedure foo is defined, which,
 ;; when called with an optional argument bar, returns a procedure that
 ;;   (define-public* ((foo #:optional bar) #:optional baz) '())
 ;; This illustrates currying. A procedure foo is defined, which,
 ;; when called with an optional argument bar, returns a procedure that

-;; takes an optional argument baz. 
+;; takes an optional argument baz.

 ;;
 ;; Of course, define*[-public] also supports #:rest and #:allow-other-keys
 ;; in the same way as lambda*.
 
 ;;
 ;; Of course, define*[-public] also supports #:rest and #:allow-other-keys
 ;; in the same way as lambda*.
 

-(defmacro-public define* (ARGLIST . BODY)
+(defmacro define* (ARGLIST . BODY)

   (define*-guts 'define ARGLIST BODY))
 
   (define*-guts 'define ARGLIST BODY))
 

-(defmacro-public define*-public (ARGLIST . BODY)
+(defmacro define*-public (ARGLIST . BODY)

   (define*-guts 'define-public ARGLIST BODY))
 
 ;; The guts of define* and define*-public.
   (define*-guts 'define-public ARGLIST BODY))
 
 ;; The guts of define* and define*-public.


@@ -414,17 +422,17 @@
 ;; defmacro* name args . body
 ;; defmacro*-public args . body
 ;;   defmacro and defmacro-public extended for optional and keyword arguments
 ;; defmacro* name args . body
 ;; defmacro*-public args . body
 ;;   defmacro and defmacro-public extended for optional and keyword arguments

-;; 
+;;

 ;; These are just like defmacro and defmacro-public except that they
 ;; take lambda*-style extended paramter lists, where #:optional,
 ;; #:key, #:allow-other-keys and #:rest are allowed with the usual
 ;; semantics. Here is an example of a macro with an optional argument:
 ;;   (defmacro* transmorgify (a #:optional b)
 
 ;; These are just like defmacro and defmacro-public except that they
 ;; take lambda*-style extended paramter lists, where #:optional,
 ;; #:key, #:allow-other-keys and #:rest are allowed with the usual
 ;; semantics. Here is an example of a macro with an optional argument:
 ;;   (defmacro* transmorgify (a #:optional b)
 

-(defmacro-public defmacro* (NAME ARGLIST . BODY)
+(defmacro defmacro* (NAME ARGLIST . BODY)

   (defmacro*-guts 'define NAME ARGLIST BODY))
 
   (defmacro*-guts 'define NAME ARGLIST BODY))
 

-(defmacro-public defmacro*-public (NAME ARGLIST . BODY)
+(defmacro defmacro*-public (NAME ARGLIST . BODY)

   (defmacro*-guts 'define-public NAME ARGLIST BODY))
 
 ;; The guts of defmacro* and defmacro*-public
   (defmacro*-guts 'define-public NAME ARGLIST BODY))
 
 ;; The guts of defmacro* and defmacro*-public


@@ -432,3 +440,5 @@
   `(,DT ,NAME
        (,(lambda (transformer) (defmacro:transformer transformer))
         (lambda* ,ARGLIST ,@BODY))))
   `(,DT ,NAME
        (,(lambda (transformer) (defmacro:transformer transformer))
         (lambda* ,ARGLIST ,@BODY))))

+
+;;; optargs.scm ends here