[movitz-cvs] CVS movitz/losp/muerte

[ffjeld]

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 at 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)