compiler: new apply-to-gapply optimization

Let's consider the DIM expression [a . b c]. Without
this change we get:

  syms:
      0: a
      1: b
      2: c
  code:
      0: 98020000 getf t2 0
      1: 98030001 getf t3 1
      2: 98040002 getf t4 2
      3: 1C020002 apply t2 t2 t3 t4
      4: 00030002
      5: 00000004
      6: 10000002 end t2

With this change:

  syms:
      0: a
      1: b
      2: c
  code:
      0: 98030001 getf t3 1
      1: 98040002 getf t4 2
      2: 24020002 gapply t2 0 t3 t4
      3: 00030000
      4: 00000004
      5: 10000002 end t2

There are 17 hits for this optimization in optimize.tl
alone!

* stdlib/optimize.tl (basic-blocks do-peephole-block):
New pattern here. We recognize an instruction sequence
which begins with a (getf treg idx) and ends in
an (apply dest treg ...), without any instructions in
between accessing or redefining treg. Additionally,
the treg value must not be used after the apply,
unless the apply redefines it. In that case, we
rewrite this pattern to eliminate that initial getf
instruction, and substitute (gapply dest idsx ..)
for the apply.

1 files changed, 15 insertions, 0 deletions

diff --git a/stdlib/optimize.tl b/stdlib/optimize.tl
index 5002b1fd..1d423f3c 100644
--- a/stdlib/optimize.tl
+++ b/stdlib/optimize.tl
@@ -539,6 +539,21 @@
                (val (apply fun args))
                (dreg co.(get-dreg val)))
           ^((mov ,tgt ,dreg) ,*rest)))
+      ;; apply to gapply
+      (@(require @(with ((getf @(as treg (t @tn)) @idx) . @rest)
+                        @(scan @(or @(with @(as apl ((apply @dest @treg . @args)
+                                              . @arest))
+                                           li [bb.li-hash (car apl)])
+                                    @(require (@insn . @nil)
+                                              (find treg insn))))
+                        rest)
+                 apl
+                 (or (equal dest treg)
+                     (not (bit li.used tn))))
+        (set bb.recalc t)
+        (let* ((gapl ^(gapply ,dest ,idx ,*args)))
+          (set [bb.li-hash gapl] li)
+          ^(,*(ldiff rest apl) ,gapl ,*arest)))
       (@nil insns))))
 
 (defmeth basic-blocks peephole (bb)