Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv13658

Modified Files: basic-functions.lisp Log Message: Implement macro destructuring-bind.

--- /project/movitz/cvsroot/movitz/losp/muerte/basic-functions.lisp 2007/02/19 20:24:51 1.22 +++ /project/movitz/cvsroot/movitz/losp/muerte/basic-functions.lisp 2008/03/07 23:38:19 1.23 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld frodef@acm.org ;;;; Created at: Tue Sep 4 18:41:57 2001 ;;;; -;;;; $Id: basic-functions.lisp,v 1.22 2007/02/19 20:24:51 ffjeld Exp $ +;;;; $Id: basic-functions.lisp,v 1.23 2008/03/07 23:38:19 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------

@@ -48,6 +48,33 @@ (:movl :ecx :eax)))

+(defun d-bind-veryfy-keys (args keys) + (do ((allow-allow-p t) + (mismatches nil)) + ((null args) + (when mismatches + (error "Unexpected destructuring keys ~{~S~^, ~}, expected ~{~S~^, ~}." + mismatches keys))) + (let ((a (pop args)) + (v (pop args))) + (cond + ((eq a :allow-other-keys) + (when (and v allow-allow-p) + (return)) + (setf allow-allow-p nil)) + ((not (member a keys)) + (pushnew a mismatches)))))) + +(defun d-bind-lookup-key (key list) + (do () + ((endp list) + nil) + (unless (cdr list) + (error "Odd number of keyword arguments.")) + (when (eq key (pop list)) + (return list)) + (setf list (cdr list)))) + (defmacro numargs () `(with-inline-assembly (:returns :ecx) (:movzxb :cl :ecx)