diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2016-09-08 06:44:00 -0700 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2016-09-08 06:44:00 -0700 |
| commit | f6946d73027e1f3213336a6fd721f4ab85036664 (patch) | |
| tree | 8e93cb2cd7026ed149a27495d965065e9ab10eee | |
| parent | 6752067fbbeb3813fe991a02c03dd26dd6aae1b0 (diff) | |
| download | txr-f6946d73027e1f3213336a6fd721f4ab85036664.tar.gz txr-f6946d73027e1f3213336a6fd721f4ab85036664.tar.bz2 txr-f6946d73027e1f3213336a6fd721f4ab85036664.zip | |
Optimize qref and sys:rslot using slet.
* share/txr/stdlib/struct.tl (qref): Use slet instead of let
in expansion so that in the common case of var.(method ...)
the expansion simply produces a form with var evaluated in two
places.
(sys:rslot): Use slet instead of rlet.
* tests/012/struct.tl: Update qref expansion test-cases
to test for the now simpler expansions.
| -rw-r--r-- | share/txr/stdlib/struct.tl | 6 | ||||
| -rw-r--r-- | tests/012/struct.tl | 22 |
2 files changed, 11 insertions, 17 deletions
diff --git a/share/txr/stdlib/struct.tl b/share/txr/stdlib/struct.tl index 9b37ae0b..0f3d79eb 100644 --- a/share/txr/stdlib/struct.tl +++ b/share/txr/stdlib/struct.tl @@ -196,11 +196,11 @@ (if (eq dw 'dwim) ^(qref [(slot ,obj ',sym) ,*args] ,*more) :)) (((sym . args)) (let ((osym (gensym))) - ^(let ((,osym ,obj)) + ^(slet ((,osym ,obj)) (call (slot ,osym ',sym) ,osym ,*args)))) (((sym . args) . more) (let ((osym (gensym))) - ^(qref (let ((,osym ,obj)) + ^(qref (slet ((,osym ,obj)) (call (slot ,osym ',sym) ,osym ,*args)) ,*more))) ((sym) ^(slot ,obj ',sym)) ((sym . more) ^(qref (slot ,obj ',sym) ,*more)) @@ -270,7 +270,7 @@ (defplace (sys:rslot struct sym meth-sym) body (getter setter (with-gensyms (struct-sym slot-sym meth-sym) - ^(rlet ((,struct-sym ,struct) + ^(slet ((,struct-sym ,struct) (,slot-sym ,sym) (,meth-sym ,meth-sym)) (macrolet ((,getter () ^(slot ,',struct-sym ,',slot-sym)) diff --git a/tests/012/struct.tl b/tests/012/struct.tl index e7c025f4..de5ab0f8 100644 --- a/tests/012/struct.tl +++ b/tests/012/struct.tl @@ -38,30 +38,24 @@ (set *gensym-counter* 0) (stest (sys:expand 's.(a)) - "(let ((#:g0004 s))\n \ - \ (call (slot #:g0004 'a)\n \ - \ #:g0004))") + "(call (slot s 'a)\n \ + \ s)") (set *gensym-counter* 0) (stest (sys:expand 's.(a b c)) - "(let ((#:g0004 s))\n \ - \ (call (slot #:g0004 'a)\n \ - \ #:g0004 b c))") + "(call (slot s 'a)\n \ + \ s b c)") (test (sys:expand 's.[a].d) (slot [(slot s 'a)] 'd)) (test (sys:expand 's.[a b c].d) (slot [(slot s 'a) b c] 'd)) (set *gensym-counter* 0) (stest (sys:expand 's.(a).d) - "(slot (let ((#:g0004 s))\n \ - \ (call (slot #:g0004 'a)\n \ - \ #:g0004))\n \ - \ 'd)") + "(slot (call (slot s 'a)\n \ + \ s) 'd)") (set *gensym-counter* 0) (stest (sys:expand 's.(a b c).d) - "(slot (let ((#:g0004 s))\n \ - \ (call (slot #:g0004 'a)\n \ - \ #:g0004 b c))\n \ - \ 'd)") + "(slot (call (slot s 'a)\n \ + \ s b c)\n 'd)") (test s.a 100) |