diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2018-04-09 07:07:20 -0700 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2018-04-09 07:07:20 -0700 |
| commit | fa9427261659eb1ebaf2c752edf2979248204d7b (patch) | |
| tree | f22262d50a97d02cfda0f19971db16f883f7bbc1 /share | |
| parent | 987609ab14f56487735ff0ca190d91222aa03550 (diff) | |
| download | txr-fa9427261659eb1ebaf2c752edf2979248204d7b.tar.gz txr-fa9427261659eb1ebaf2c752edf2979248204d7b.tar.bz2 txr-fa9427261659eb1ebaf2c752edf2979248204d7b.zip | |
compiler: improve and & or.
* share/txr/stdlib/compiler.tl (compiler comp-and-or): Handle
the trivial zero and one argument cases separately. In
particular, the one-argument case results in better code
because it eliminates a temporary register. We don't have
to test for the zero-arg case any more in the general case,
so it is simplified in a few cases.
Diffstat (limited to 'share')
| -rw-r--r-- | share/txr/stdlib/compiler.tl | 57 |
1 files changed, 30 insertions, 27 deletions
diff --git a/share/txr/stdlib/compiler.tl b/share/txr/stdlib/compiler.tl index 2977b865..499466ba 100644 --- a/share/txr/stdlib/compiler.tl +++ b/share/txr/stdlib/compiler.tl @@ -789,33 +789,36 @@ (new (frag (if lastfrag lastfrag.oreg ^(t 0)) code fvars ffuns)))) (defmeth compiler comp-and-or (me oreg env form) - (mac-param-bind form (op . args) form - (let* (ffuns fvars - (nargs (len args)) - lastfrag - (is-and (eq op 'and)) - (lout (gensym "l")) - (treg me.(maybe-alloc-treg oreg)) - (code (build - (each ((form args) - (n (range 1))) - (let ((islast (eql n nargs))) - (let ((frag me.(compile treg env form))) - (when islast - (set lastfrag frag)) - (pend frag.code - (maybe-mov treg frag.oreg)) - (unless islast - (add (if is-and - ^(if ,treg ,lout) - ^(ifq ,treg ,nil ,lout)))) - (set fvars (uni fvars frag.fvars)) - (set ffuns (uni ffuns frag.ffuns)))))))) - me.(maybe-free-treg treg oreg) - (new (frag (if args oreg (if is-and me.(get-dreg t) ^(t 0))) - (append code ^(,lout - ,*(if args (maybe-mov oreg treg)))) - fvars ffuns))))) + (tree-case form + ((op) me.(compile oreg env (if (eq op 'and) t))) + ((op arg) me.(compile oreg env arg)) + ((op . args) + (let* (ffuns fvars + (nargs (len args)) + lastfrag + (is-and (eq op 'and)) + (lout (gensym "l")) + (treg me.(maybe-alloc-treg oreg)) + (code (build + (each ((form args) + (n (range 1))) + (let ((islast (eql n nargs))) + (let ((frag me.(compile treg env form))) + (when islast + (set lastfrag frag)) + (pend frag.code + (maybe-mov treg frag.oreg)) + (unless islast + (add (if is-and + ^(if ,treg ,lout) + ^(ifq ,treg ,nil ,lout)))) + (set fvars (uni fvars frag.fvars)) + (set ffuns (uni ffuns frag.ffuns)))))))) + me.(maybe-free-treg treg oreg) + (new (frag oreg + (append code ^(,lout + ,*(maybe-mov oreg treg))) + fvars ffuns)))))) (defmeth compiler comp-prog1 (me oreg env form) (tree-case form |