Support keyword params via :key param list macro.

* eval.c (expand_param_macro): Use lisplib_try_load to retry
failed parameter macro lookup, thereby supporting auto-loading
of modules that define parameter macros.

* lisplib.c (keyparams_set_entries, keyparams_instantiate): New static
functions.
(lisplib_init): Support autoloading of keyparams.tl via new
functions.

* share/txr/stdlib/keyparams.tl: New file.

* txr.1: Documented :key param list macro.

* checkman.txr: Support "Parameter list macro" documentation
section type.

5 files changed, 277 insertions, 4 deletions

diff --git a/checkman.txr b/checkman.txr
index 7797f070..c6b11686 100644
--- a/checkman.txr
+++ b/checkman.txr
@@ -61,7 +61,7 @@
 @      (assert bad ln `no .synb after @{type}s heading`)
 @      (check-synb)
 @    (or)
-.coNP @{type /Function|Operator|Macro|Accessor|Method|Structure/}@(assert bad ln `bad @type heading`) @@ @{x /\S+/}@junk
+.coNP @{type /Function|Operator|Macro|Accessor|Method|Structure|Parameter list macro/}@(assert bad ln `bad @type heading`) @@ @{x /\S+/}@junk
 @      (assert bad ln `extra elements in singular @type heading`)
 @      (bind junk "")
 @      (assert bad ln `no .synb after @type heading`)
diff --git a/eval.c b/eval.c
index 015ee9af..fed5c7ed 100644
--- a/eval.c
+++ b/eval.c
@@ -941,9 +941,13 @@ static val expand_param_macro(val params, val body, val menv, val form)
         sym == env_k ||sym == colon_k)
       return cons(params, body);
 
-    if (!pmac)
-      eval_error(form, lit("~s: keyword ~s has no param macro binding"),
-                 car(form), sym, nao);
+    if (!pmac) {
+      lisplib_try_load(sym);
+      pmac = gethash(pm_table, sym);
+      if (!pmac)
+        eval_error(form, lit("~s: keyword ~s has no param macro binding"),
+                   car(form), sym, nao);
+    }
 
     {
       val prest = cdr(params);
diff --git a/lisplib.c b/lisplib.c
index 352abe55..f73b7919 100644
--- a/lisplib.c
+++ b/lisplib.c
@@ -498,6 +498,23 @@ static val error_instantiate(val set_fun)
   return nil;
 }
 
+static val keyparams_set_entries(val dlt, val fun)
+{
+  val key_k = intern(lit("key"), keyword_package);
+  if (fun)
+    sethash(dlt, key_k, fun);
+  else
+    remhash(dlt, key_k);
+  return nil;
+}
+
+static val keyparams_instantiate(val set_fun)
+{
+  funcall1(set_fun, nil);
+  load(format(nil, lit("~akeyparams.tl"), stdlib_path, nao));
+  return nil;
+}
+
 val dlt_register(val dlt,
                  val (*instantiate)(val),
                  val (*set_entries)(val, val))
@@ -536,6 +553,7 @@ void lisplib_init(void)
   dlt_register(dl_table, tagbody_instantiate, tagbody_set_entries);
   dlt_register(dl_table, pmac_instantiate, pmac_set_entries);
   dlt_register(dl_table, error_instantiate, error_set_entries);
+  dlt_register(dl_table, keyparams_instantiate, keyparams_set_entries);
 }
 
 val lisplib_try_load(val sym)
diff --git a/share/txr/stdlib/keyparams.tl b/share/txr/stdlib/keyparams.tl
new file mode 100644
index 00000000..b3474c4e
--- /dev/null
+++ b/share/txr/stdlib/keyparams.tl
@@ -0,0 +1,96 @@
+;; Copyright 2017
+;; Kaz Kylheku <kaz@kylheku.com>
+;; Vancouver, Canada
+;; All rights reserved.
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions are met:
+;;
+;; 1. Redistributions of source code must retain the above copyright notice, this
+;;    list of conditions and the following disclaimer.
+;;
+;; 2. Redistributions in binary form must reproduce the above copyright notice,
+;;    this list of conditions and the following disclaimer in the documentation
+;;    and/or other materials provided with the distribution.
+;;
+;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
+;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
+;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+;; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
+;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+(defun sys:extract-keys (keys args)
+  (build
+    (each ((k keys))
+      (iflet ((f (memq (car k) args)))
+        (add (cadr f))
+        (add (cdr k))))))
+
+(defun sys:extract-keys-p (keys args)
+  (build
+    (each ((k keys))
+      (add (if (memq k args) t)))))
+
+(defun sys:build-key-list (key-params)
+  (let ((constant (group-by [chain second constantp] key-params)))
+    (let ((var-keys (mapcar (ret ^(cons ',(intern (symbol-name (first @1))
+                                                  'keyword)
+                                        ,(second @1)))
+                            [constant nil]))
+          (const-keys (mapcar (op cons
+                                (intern (symbol-name (first @1)) 'keyword)
+                                (second @1))
+                              [constant t])))
+      (cond
+        ((empty const-keys)
+         ^(list ,*var-keys))
+        ((empty var-keys)
+         ^',const-keys)
+        (t ^(list* ,*var-keys ',const-keys))))))
+
+(define-param-expander :key (param body menv form)
+  (let* ((excluding-rest (butlastn 0 param))
+         (key-start (memq '-- excluding-rest))
+         (rest-param (or (nthlast 0 param) (gensym)))
+         (before-key (ldiff excluding-rest key-start))
+         (key-params-raw (butlastn 0 (cdr key-start)))
+         (key-params [mapcar [iffi atom (op list @1)] key-params-raw])
+         (eff-param (append before-key rest-param)))
+    (each ((key-spec key-params))
+      (tree-case key-spec
+        ((var init var-p . junk)
+         (when (consp junk)
+           (compile-error form "superfluous forms in ~s" key-spec))
+         (when junk
+           (compile-error form "invalid dotted form ~s" key-spec))
+         (unless (bindable var-p)
+           (compile-error form "~s isn't a bindable symbol" var-p))
+         :)
+        ((var init . more)
+         (unless (listp more)
+           (compile-error form "invalid dotted form ~s" key-spec))
+         :)
+        ((var . more)
+         (unless (listp more)
+           (compile-error form "invalid dotted form ~s" key-spec))
+         (unless (bindable var)
+           (compile-error form "~s isn't a bindable symbol" var)))))
+    (let* ((key-params-p [keep-if third key-params])
+           (key-vars [mapcar first key-params])
+           (key-vars-p [mapcar third key-params-p])
+           (keys (sys:build-key-list key-params))
+           (keys-p (mapcar (op intern (symbol-name (first @1)) 'keyword)
+                           key-params-p)))
+      (list eff-param
+            ^(tree-bind ,key-vars
+                        (sys:extract-keys ,keys ,rest-param)
+               ,*(if keys-p
+                   ^((tree-bind ,key-vars-p
+                                (sys:extract-keys-p ',keys-p ,rest-param)
+                        ,*body))
+                   body))))))
diff --git a/txr.1 b/txr.1
index afaff137..dd7b816e 100644
--- a/txr.1
+++ b/txr.1
@@ -28544,6 +28544,14 @@ final parameter list and its accompanying body are then
 taken in place of the original parameter list and
 body.
 
+\*(TL provides a built-in parameter list macro bound to the symbol
+.code :key
+which endows a function keyword parameters. The implementation is
+written entirely using this parameter list macro mechanism, by means
+of the
+.code define-parameter-macro
+macro.
+
 .coNP Special variable @ *param-macro*
 .desc
 The variable
@@ -28693,6 +28701,153 @@ All that is required is the insertion of the
 .code :memo
 keyword.
 
+.coNP Parameter list macro @ :key
+.synb
+.mets (:key << param *
+.mets \ \  [ -- >> { sym | >> ( sym >> [ init-form <> [ p-sym ]])}* ]
+.mets \ \  [ . rest-param ])
+.syne
+.desc
+Parameter list macro
+.code :key
+injects keyword parameter support into functions and macros.
+
+When
+.code :key
+appears as the first item in a function parameter list, a special syntax is
+recognized in the parameter list. After any required and optional parameters,
+the symbol
+.code --
+(two dashes) may appear. Parameters after this symbol are interpreted
+as keyword parameters. After the keyword parameters, a rest parameter
+may appear in the usual way as a symbol in the dotted position.
+
+Keyword parameters use the same syntax as optional parameters, except
+that if used in a macro parameter list, they do not support
+destructuring whereas optional parameters do. That is to say, regardless
+whether
+.code :key
+is used in a function or macro, keyword parameters are symbols.
+
+A keyword parameter takes three possible forms:
+
+.RS
+.meIP < sym
+A keyword parameter may be specified as a simple symbol
+.metn sym .
+If the argument for such a keyword parameter is missing,
+it takes on the value
+.codn nil .
+.meIP >> ( sym << init-form )
+If the keyword parameter symbol
+.meta sym
+is enclosed in a list, then the second element of that list
+specifies a default value, similarly to the default value for
+an optional argument. If the function is called in such a way
+that the argument for the parameter is missing, the
+.meta init-form
+is evaluated and the resulting value is bound to the keyword parameter.
+The evaluation takes place in a lexical scope in which the
+required and optional parameters are are already visible,
+and their values are bound. If there is a
+.meta rest-param
+it is also visible in this scope, even though in the parameter
+list it appears to the left.
+.meIP >> ( sym < init-form << p-sym )
+The three-element form of the keyword parameter specifies
+an additional symbol
+.metn p-sym ,
+which names an argument that implicitly receives a Boolean
+argument indicating the presence of the keyword argument.
+If an argument is not passed for the keyword parameter
+.metn sym ,
+then parameter
+.meta sym-p
+takes on the value
+.codn nil .
+If an argument is given for
+.metn sym ,
+then the
+.meta sym-p
+argument takes on the value
+.codn t .
+This mechanism also closely resembles the analogous
+one supported in optional arguments. See the previous
+paragraph regarding the evaluation scope of
+.metn init-form .
+.RE
+
+.IP
+Arguments to keyword appear as a property list which begins
+after the last required or optional argument. A property list
+consists of interleaved indicators and values. The indicators
+for keyword parameters are keyword symbols whose names match
+the parameter names. For instance, the indicator-value pair
+.code ":xyz 42"
+passes the value
+.code 42
+to a keyword parameter that may be named
+.code xyz
+in any package: it may be
+.code usr:xyz
+or
+.code mypackage:xyz
+and so forth.
+
+If the function has a
+.meta rest-param
+then that param receives the keyword parameter list. That is to say, the
+.code :key
+mechanism generates a regular variadic function which receives the keyword
+parameters as the trailing arguments. The function is endowed with code which
+parses these extra arguments out of the trailing list, and binds them to
+the keyword parameter symbols. If a
+.meta rest-param
+argument present, then it specifies a symbol to be used as the name of
+the rest parameter, making the entire keyword argument list available
+under that name. If there is no
+.meta rest-param
+then a machine-generated rest parameter is substituted; the keyword argument
+parsing logic refers to that instead.
+
+.TP* Example:
+
+Define a function
+.code fun
+with two required arguments
+.codn "a b" ,
+one optional argument
+.codn c ,
+two keyword arguments
+.code foo
+and
+.codn bar ,
+and a rest parameter
+.codn klist :
+
+.cblk
+  (defun fun (:key a b : c -- foo bar . klist)
+    (list a b c foo bar klist))
+
+  (fun 1 2 3 :bar 4) -> (1 2 3 nil 4 (:bar 4))
+.cble
+
+Define a function with only keyword arguments, with default expressions and
+Boolean indicator params:
+
+.cblk
+  (defun keyfun (:key -- (a 10 a-p) (b 20 b-p))
+    (list a a-p b b-p))
+
+  (keyfun :a 3) -> (3 t 20 nil)
+
+  (keyfun :b 4) -> (10 nil 4 t)
+
+  (keyfun :c 4) -> (10 nil 20 nil)
+
+  (keyfun) -> (10 nil 20 nil)
+.cble
+
 .SS* Mutation of Syntactic Places
 .coNP Macro @ set
 .synb