[albert-cvs] CVS: albert/lisp2csf lisp2csf.lisp,1.21,1.22

[Stig E S. <st...@us...>]

Update of /cvsroot/albert/albert/lisp2csf
In directory sc8-pr-cvs1:/tmp/cvs-serv12350/lisp2csf

Modified Files:
	lisp2csf.lisp 
Log Message:
now handles &rest and &body parameters

Index: lisp2csf.lisp
===================================================================
RCS file: /cvsroot/albert/albert/lisp2csf/lisp2csf.lisp,v
retrieving revision 1.21
retrieving revision 1.22
diff -C2 -d -r1.21 -r1.22
*** lisp2csf.lisp	27 Oct 2003 01:04:34 -0000	1.21
--- lisp2csf.lisp	15 Dec 2003 22:39:27 -0000	1.22
***************
*** 234,241 ****
  	    (map nil #'analyse-body-expression (cdr expr)))
  	   ))
! 
! 
! 
! 		       
      ))
  
--- 234,238 ----
  	    (map nil #'analyse-body-expression (cdr expr)))
  	   ))
! 	       
      ))
  
***************
*** 645,649 ****
  	   (collected-args nil))
  
!       (destructuring-bind (&key required-names key-args optional-args &allow-other-keys)
  	  analysed-list
  
--- 642,646 ----
  	   (collected-args nil))
  
!       (destructuring-bind (&key required-names key-args optional-args rest-var body-var &allow-other-keys)
  	  analysed-list
  
***************
*** 759,762 ****
--- 756,799 ----
  		    )))
  
+       (when rest-var
+ 	(cond ((nonboolsym? rest-var) ;; single symbol, default is unspecified but nil
+ 	       (let ((some-arg (make-csf-arg)))
+ 		 (push (fill-info-obj (make-csf-info)
+ 				      "name"
+ 				      (format nil "~a" rest-var)
+ 				      nil)
+ 		       (csf-arg.info some-arg))
+ 		 (push (fill-info-obj (make-csf-info)
+ 				      "mod"
+ 				      "rest"
+ 				      nil)
+ 		       (csf-arg.info some-arg))
+ 		 (push some-arg collected-args)))
+ 	      
+ 	      (t
+ 	       (albert-warn "Unhandled rest-var ~s to function/method ~s"
+ 			    rest-var name))
+ 	      ))
+ 
+       (when body-var
+ 	(cond ((nonboolsym? body-var) ;; single symbol, default is unspecified but nil
+ 	       (let ((some-arg (make-csf-arg)))
+ 		 (push (fill-info-obj (make-csf-info)
+ 				      "name"
+ 				      (format nil "~a" body-var)
+ 				      nil)
+ 		       (csf-arg.info some-arg))
+ 		 (push (fill-info-obj (make-csf-info)
+ 				      "mod"
+ 				      "body"
+ 				      nil)
+ 		       (csf-arg.info some-arg))
+ 		 (push some-arg collected-args)))
+ 	      
+ 	      (t
+ 	       (albert-warn "Unhandled body-var ~s to function/method ~s"
+ 			    body-var name))
+ 	      ))
+       
        
        (setf (csf-method.args the-meth) (nreverse collected-args))))