structure definitions without doom ensuing."
(error "No initializer for slot."))
-(compile-time-defun parse-body (body)
+(compile-time-defun parse-body (body &key (allow-docstring-p t))
"Given a BODY (a list of forms), parses it into three sections: a
docstring, a list of declarations (forms beginning with the symbol
`declare') and the body forms. The result is returned as three lists
(even the docstring), suitable for interpolation into a backquoted list
- using `@,'."
- (multiple-value-bind
- (doc body)
- (if (and (consp body)
- (stringp (car body)))
- (values (list (car body)) (cdr body))
- (values nil body))
- (loop for forms on body
- for form = (car forms)
- while (and (consp form)
- (eq (car form) 'declare))
- collect form into decls
- finally (return (values doc decls forms)))))
+ using `@,'. If ALLOW-DOCSTRING-P is nil, docstrings aren't allowed at
+ all."
+ (let ((doc nil) (decls nil))
+ (do ((forms body (cdr forms))) (nil)
+ (let ((form (and forms (car forms))))
+ (cond ((and allow-docstring-p (not doc) (stringp form) (cdr forms))
+ (setf doc form))
+ ((and (consp form)
+ (eq (car form) 'declare))
+ (setf decls (append decls (cdr form))))
+ (t (return (values (and doc (list doc))
+ (and decls (list (cons 'declare decls)))
+ forms))))))))
;;;--------------------------------------------------------------------------
;;; Generating symbols.
(,kind ,scrutinee
,@(mapcar (lambda (clause)
(destructuring-bind
- (cases (&optional var) &rest forms)
+ (cases (&optional varx vary) &rest forms)
clause
`(,cases
- ,@(if var
- (list `(let ((,var ,argument)) ,@forms))
+ ,@(if varx
+ (list `(let ((,(or vary varx) ,argument)
+ ,@(and vary
+ `((,varx ,scrutinee))))
+ ,@forms))
forms))))
clauses)))))
(defmacro case2 (vform &body clauses)
"VFORM is a form which evaluates to two values, SCRUTINEE and ARGUMENT.
- The CLAUSES have the form (CASES ([VAR]) FORMS...), where a standard
- `case' clause has the form (CASES FORMS...). The `case2' form evaluates
- the VFORM, and compares the SCRUTINEE to the various CASES, in order, just
- like `case'. If there is a match, then the corresponding FORMs are
- evaluated with VAR (if specified) bound to the value of ARGUMENT."
+ The CLAUSES have the form (CASES ([[SCRUVAR] ARGVAR]) FORMS...), where a
+ standard `case' clause has the form (CASES FORMS...). The `case2' form
+ evaluates the VFORM, and compares the SCRUTINEE to the various CASES, in
+ order, just like `case'. If there is a match, then the corresponding
+ FORMs are evaluated with ARGVAR bound to the ARGUMENT and SCRUVAR bound to
+ the SCRUTINEE (where specified). Note the bizarre defaulting behaviour:
+ ARGVAR is less optional than SCRUVAR."
(do-case2-like 'case vform clauses))
(defmacro ecase2 (vform &body clauses)