diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2019-08-28 21:01:36 -0700 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2019-08-28 21:01:36 -0700 |
| commit | 516daa338a39f2758448ab019eed0a6c113f9cab (patch) | |
| tree | 501e26e04dc046b140896944f99a43918bb68a71 | |
| parent | c7c843d17a9eff4f7777524541bd407942280538 (diff) | |
| download | txr-516daa338a39f2758448ab019eed0a6c113f9cab.tar.gz txr-516daa338a39f2758448ab019eed0a6c113f9cab.tar.bz2 txr-516daa338a39f2758448ab019eed0a6c113f9cab.zip | |
compiler: mac params: simplify optional presence indicators.
* share/txr/stdlib/compiler.tl (expand-bind-mac-params):
Generate better Lisp code when presence indicating variables
on optional parameters are not used. It's possible to bind the
variable directly, instead of binding to nil and assigning it.
The cases are split accordingly.
| -rw-r--r-- | share/txr/stdlib/compiler.tl | 36 |
1 files changed, 21 insertions, 15 deletions
diff --git a/share/txr/stdlib/compiler.tl b/share/txr/stdlib/compiler.tl index e6ec7840..5553f293 100644 --- a/share/txr/stdlib/compiler.tl +++ b/share/txr/stdlib/compiler.tl @@ -1438,10 +1438,10 @@ (,obj-var (set ,curs (car ,obj-var)) (set ,obj-var (cdr ,obj-var)) - ,(if pres-p t)) + ,*(if pres-p '(t))) (t (set ,curs ,init-form) - ,(if pres-p nil))))) + ,*(if pres-p '(nil)))))) (if pres-p (emit-var pres-p stmt) (emit-stmt stmt)) @@ -1450,19 +1450,25 @@ (expand-rec p curs cv) (put-gen curs)))) (t - (let ((stmt ^(cond - (,obj-var - (set ,p (car ,obj-var)) - (set ,obj-var (cdr ,obj-var)) - ,(if pres-p t)) - (t - ,(if init-form - ^(set ,p ,init-form)) - ,(if pres-p nil))))) - (emit-var p nil) - (if pres-p - (emit-var pres-p stmt) - (emit-stmt stmt))))))) + (cond + (pres-p + (emit-var p nil) + (emit-var pres-p + ^(cond + (,obj-var + (set ,p (car ,obj-var)) + (set ,obj-var (cdr ,obj-var)) + ,(if pres-p t)) + (t + ,(if init-form + ^(set ,p ,init-form)) + ,(if pres-p nil))))) + (t + (emit-var p ^(if ,obj-var + (prog1 + (car ,obj-var) + (set ,obj-var (cdr ,obj-var))) + (if ,init-form ,init-form))))))))) (when pars.rest (emit-var pars.rest obj-var))))))) (expand-rec params obj-var nil) |