diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2019-08-29 07:06:02 -0700 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2019-08-29 07:06:02 -0700 |
| commit | d875f05b0632c8e639d4d033f3654012080fb8ef (patch) | |
| tree | c3d97b3f27b2d3904911af7d4dc22540cc1f09da | |
| parent | b5c9b7ffd95b2934e503e8524ac0f571ed2b9f91 (diff) | |
| download | txr-d875f05b0632c8e639d4d033f3654012080fb8ef.tar.gz txr-d875f05b0632c8e639d4d033f3654012080fb8ef.tar.bz2 txr-d875f05b0632c8e639d4d033f3654012080fb8ef.zip | |
compiler: mac params: eliminate plen variable.
* share/txr/stdlib/compiler.tl (expand-bind-mac-params):
Remove the plen gensym. We don't need to store the form length
in a variable, because the generated length check code
references the value exactly once. Let's just propagate that
the length calculating expression into that code.
| -rw-r--r-- | share/txr/stdlib/compiler.tl | 19 |
1 files changed, 9 insertions, 10 deletions
diff --git a/share/txr/stdlib/compiler.tl b/share/txr/stdlib/compiler.tl index 60411e39..0fdf77ba 100644 --- a/share/txr/stdlib/compiler.tl +++ b/share/txr/stdlib/compiler.tl @@ -1373,7 +1373,7 @@ (defun expand-bind-mac-params (ctx-form err-form params menv-var obj-var strict err-block body) - (let (gen-stk stmt vars (plen (if (and strict (neq strict t)) (gensym)))) + (let (gen-stk stmt vars) (labels ((get-gen () (or (pop gen-stk) (gensym))) (put-gen (g) @@ -1398,9 +1398,6 @@ vars))) (let ((pars (new (mac-param-parser par-syntax ctx-form)))) (progn - (when plen - (emit-var plen ^(if (consp ,obj-var) - (len ,obj-var) 0))) (cond ((eq strict t) (emit-stmt @@ -1411,11 +1408,13 @@ ((null strict)) ((symbolp strict) (emit-stmt - (if pars.rest - ^(unless (<= ,pars.nreq ,plen) - (return-from ,err-block ',strict)) - ^(unless (<= ,pars.nreq ,plen ,pars.nfix) - (return-from ,err-block ',strict)))))) + (let ((len-expr ^(if (consp ,obj-var) + (len ,obj-var) 0))) + (if pars.rest + ^(unless (<= ,pars.nreq ,len-expr) + (return-from ,err-block ',strict)) + ^(unless (<= ,pars.nreq ,len-expr ,pars.nfix) + (return-from ,err-block ',strict))))))) (each ((k pars.key)) (tree-bind (key . sym) k (caseq key @@ -1478,7 +1477,7 @@ (expand-rec params obj-var nil) (when stmt (push ^(,(gensym) (progn ,*(nreverse stmt))) vars)) - ^(let* (,*(if plen ^(,plen)) ,*gen-stk ,*(nreverse vars)) + ^(let* (,*gen-stk ,*(nreverse vars)) ,*body)))) (defun expand-defvarl (form) |