diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2019-06-29 22:02:11 -0700 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2019-06-29 22:02:11 -0700 |
| commit | 33ab516588d6c0526ef2d77e1764c2004492a4ea (patch) | |
| tree | a3b1f2d2b6d0034d92cc6ef46c81d216a233044c /share | |
| parent | 875dd9b8d942ba3b84dd8355f431cfde814f626f (diff) | |
| download | txr-33ab516588d6c0526ef2d77e1764c2004492a4ea.tar.gz txr-33ab516588d6c0526ef2d77e1764c2004492a4ea.tar.bz2 txr-33ab516588d6c0526ef2d77e1764c2004492a4ea.zip | |
keyparams: bugfix: key list order scrambled.
When the keyword parameter list contains a mixture of constant
and non-constant default value expressions, the order of the
extracted keys is scrambled, so values go to the wrong
variables.
* share/txr/stdlib/keyparams.tl (sys:build-key-list): Renamed
to build-key-list-expr and rewritten to preserve the key
order.
(:key): Follow rename of build-key-list.
Diffstat (limited to 'share')
| -rw-r--r-- | share/txr/stdlib/keyparams.tl | 28 |
1 files changed, 11 insertions, 17 deletions
diff --git a/share/txr/stdlib/keyparams.tl b/share/txr/stdlib/keyparams.tl index 7ee2d8f5..82899f2f 100644 --- a/share/txr/stdlib/keyparams.tl +++ b/share/txr/stdlib/keyparams.tl @@ -36,22 +36,16 @@ (each ((k keys)) (add (if (memp k args) t))))) -(defun sys:build-key-list (key-params menv) - (let ((constant (group-by (opip second (constantp @1 menv)) 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)))))) +(defun sys:build-key-list-expr (key-params menv) + (let ((exprs (collect-each ((kp key-params)) + (let ((kw (intern (symbol-name (first kp)) 'keyword)) + (ex (second kp))) + (if (constantp ex menv) + ^(quote (,kw . ,(second kp))) + ^(cons ,kw ,(second kp))))))) + (if [all exprs (op eq 'quote) car] + ^(quote ,[mapcar cadr exprs]) + ^(list ,*exprs)))) (define-param-expander :key (param body menv form) (let* ((excluding-rest (butlastn 0 param)) @@ -83,7 +77,7 @@ (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 menv)) + (keys (sys:build-key-list-expr key-params menv)) (keys-p (mapcar (op intern (symbol-name (first @1)) 'keyword) key-params-p))) (list eff-param |