This is partially related to #2: http://weblocks.lighthouseapp.com/projects/20431/tickets/2-lambda-list-for-defuncc
The patch adds proper parsing of declarations and doc strings via ALEXANDRIA:PARSE-BODY to DEFUN/CC. It also specializes DOCUMENTATION, (SETF DOCUMENTATION) and DESCRIBE-OBJECT on FUNCALLABLE/CC to support doc strings properly. No automatic tests included yet but passes existing. Please comment -- if this is received positively I will prepare the full patch. --~--~---------~--~----~------------~-------~--~----~ You received this message because you are subscribed to the Google Groups "weblocks" group. To post to this group, send email to [email protected] To unsubscribe from this group, send email to [email protected] For more options, visit this group at http://groups.google.com/group/weblocks?hl=en -~----------~----~----~----~------~----~------~--~---
diff -rN -u old-cl-cont/cl-cont.asd new-cl-cont/cl-cont.asd --- old-cl-cont/cl-cont.asd 2009-04-22 14:19:12.912757511 +0200 +++ new-cl-cont/cl-cont.asd 2009-04-22 14:19:12.919423256 +0200 @@ -12,7 +12,7 @@ :licence "LLGPL" :description "A library that implements continuations by transforming Common Lisp code to continuation passing style." - :depends-on (:closer-mop) + :depends-on (:closer-mop :alexandria) :components ((:module src :components diff -rN -u old-cl-cont/src/helper-transformers.lisp new-cl-cont/src/helper-transformers.lisp --- old-cl-cont/src/helper-transformers.lisp 2009-04-22 14:19:12.909425861 +0200 +++ new-cl-cont/src/helper-transformers.lisp 2009-04-22 14:19:12.919423256 +0200 @@ -21,18 +21,22 @@ ;;; DEFUN (defcpstransformer defun (cons k-expr env) "Transforms DEFUN expression to CPS form." - (let ((name (cadr cons)) - (args (caddr cons)) - (body (cdddr cons))) - `(progn - (setf (fdefinition ',name) - ,(lambda-expr->cps `(lambda ,args - ,@(extract-declarations body) - (block ,name - ,@(remove-declarations body))) - nil - env)) - (funcall ,k-expr ',name)))) + (let* ((name (cadr cons)) + (args (caddr cons)) + (body (cdddr cons))) + (multiple-value-bind (body declarations doc-string) (alexandria:parse-body body :documentation t) + (let ((cps-lambda (lambda-expr->cps `(lambda ,args + ,@declarations + ,doc-string + (block ,name + ,@body)) + nil + env))) + `(progn + (setf (fdefinition ',name) ,cps-lambda) + ,(when doc-string + `(setf (documentation ,cps-lambda 'function) ,doc-string)) + (funcall ,k-expr ',name)))))) (defmacro defun/cc (name arglist &body body) "A helper macro to define a function that supports CALL/CC." diff -rN -u old-cl-cont/src/special-transformers.lisp new-cl-cont/src/special-transformers.lisp --- old-cl-cont/src/special-transformers.lisp 2009-04-22 14:19:12.909425861 +0200 +++ new-cl-cont/src/special-transformers.lisp 2009-04-22 14:19:12.919423256 +0200 @@ -198,6 +198,15 @@ (:metaclass c2mop:funcallable-standard-class) (:documentation "A structure that represents a funcallable object")) +(defmethod documentation ((obj funcallable/cc) (doc-type (eql 'function))) + (documentation (f/cc-function obj) doc-type)) + +(defmethod (setf documentation) (value (obj funcallable/cc) (doc-type (eql 'function))) + (setf (documentation (f/cc-function obj) doc-type) value)) + +(defmethod describe-object :after ((obj funcallable/cc) stream) + (format stream "Documentation: ~A" (documentation obj 'function))) + (defun make-funcallable (function) "Creates an instance of FUNCALLABLE/CC." (let ((inst (make-instance 'funcallable/cc :function function)))
