diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2023-07-17 21:59:56 -0700 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2023-07-17 21:59:56 -0700 |
| commit | 5c05a46da92cadf28e13f134bec61419113b973a (patch) | |
| tree | db1d27cf086eff5be3ec6d8e87ee32ef372caedf | |
| parent | f192d6b71169c24c6a79c071171ea7f0332c2d0b (diff) | |
| download | txr-5c05a46da92cadf28e13f134bec61419113b973a.tar.gz txr-5c05a46da92cadf28e13f134bec61419113b973a.tar.bz2 txr-5c05a46da92cadf28e13f134bec61419113b973a.zip | |
compiler: constant fold gapply like gcall.
* stdlib/optimize.tl (basic-blocks do-peephole-block): Extend
constant-folding case to recognize gapply as well as gcall.
We just have to take care in how we apply apply arguments
to the actual function to get the value.
| -rw-r--r-- | stdlib/optimize.tl | 9 |
1 files changed, 6 insertions, 3 deletions
diff --git a/stdlib/optimize.tl b/stdlib/optimize.tl index 1d423f3c..29fe0a64 100644 --- a/stdlib/optimize.tl +++ b/stdlib/optimize.tl @@ -528,15 +528,18 @@ (cons (car insns) ren)) (t insns)))) ;; constant folding - (@(require ((gcall @tgt @idx . @(all @(or (d @dn) - @(with (t 0) dn nil)))) + (@(require ((@(as op @(or gapply gcall)) @tgt @idx + . @(all @(or (d @dn) + @(with (t 0) dn nil)))) . @rest) [%const-foldable% [bb.symvec idx]]) (let* ((co bb.compiler) (dvec co.(get-datavec)) (fun [bb.symvec idx]) (args (mapcar [iffi true dvec] dn)) - (val (apply fun args)) + (val (if (eq op 'gcall) + (apply fun args) + (apply fun (append [args 0..-1] [args -1])))) (dreg co.(get-dreg val))) ^((mov ,tgt ,dreg) ,*rest))) ;; apply to gapply |