From: David Vázquez <davazp@gmail.com>
Date: Sat, 9 Feb 2013 01:21:44 +0000 (+0100)
Subject: Parse lambda-list keywords
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=63d2bd9ac54e61f7b2db4e2c17a5480e94f768a5;p=jscl.git

Parse lambda-list keywords
---

diff --git a/ecmalisp.lisp b/ecmalisp.lisp
index a87a86e..6a0447d 100644
--- a/ecmalisp.lisp
+++ b/ecmalisp.lisp
@@ -1191,28 +1191,48 @@
           " : " (ls-compile false *multiple-value-p*)
           ")"))
 
-(defvar *lambda-list-keywords* '(&optional &rest))
+(defvar *lambda-list-keywords* '(&optional &rest &key))
 
 (defun list-until-keyword (list)
   (if (or (null list) (member (car list) *lambda-list-keywords*))
       nil
       (cons (car list) (list-until-keyword (cdr list)))))
 
+(defun lambda-list-section (keyword lambda-list)
+  (list-until-keyword (cdr (member keyword lambda-list))))
+
 (defun lambda-list-required-arguments (lambda-list)
   (list-until-keyword lambda-list))
 
 (defun lambda-list-optional-arguments-with-default (lambda-list)
-  (mapcar #'ensure-list (list-until-keyword (cdr (member '&optional lambda-list)))))
+  (mapcar #'ensure-list (lambda-list-section '&optional lambda-list)))
 
 (defun lambda-list-optional-arguments (lambda-list)
   (mapcar #'car (lambda-list-optional-arguments-with-default lambda-list)))
 
 (defun lambda-list-rest-argument (lambda-list)
-  (let ((rest (list-until-keyword (cdr (member '&rest lambda-list)))))
+  (let ((rest (lambda-list-section '&rest lambda-list)))
     (when (cdr rest)
       (error "Bad lambda-list"))
     (car rest)))
 
+(defun lambda-list-keyword-arguments-canonical (lambda-list)
+  (flet ((canonalize (keyarg)
+	   ;; Build a canonical keyword argument descriptor, filling
+	   ;; the optional fields. The result is a list of the form
+	   ;; ((keyword-name var) init-form).
+	   (let* ((arg (ensure-list keyarg))
+		  (init-form (cadr arg))
+		  var
+		  keyword-name)
+	     (if (listp (car arg))
+		 (setq var (cadr (car arg))
+		       keyword-name (car (car arg)))
+		 (setq var (car arg)
+		       keyword-name (intern (symbol-name (car arg)) "KEYWORD")))
+	     `((,keyword-name ,var) ,init-form))))
+    (mapcar #'canonalize (lambda-list-section '&key lambda-list))))
+
 (defun lambda-docstring-wrapper (docstring &rest strs)
   (if docstring
       (js!selfcall