diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2015-09-30 20:22:30 -0700 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2015-09-30 20:22:30 -0700 |
| commit | 9729d5cdd70e81b001e267cbafd9fa221c6c61bb (patch) | |
| tree | 4444f7f0c67ad073fbf8e0f101646d4a7863ea63 | |
| parent | afb400eff15e7c77c5dd0fa5e35d91173f8df1ad (diff) | |
| download | txr-9729d5cdd70e81b001e267cbafd9fa221c6c61bb.tar.gz txr-9729d5cdd70e81b001e267cbafd9fa221c6c61bb.tar.bz2 txr-9729d5cdd70e81b001e267cbafd9fa221c6c61bb.zip | |
Optimize empty lambdas in defstruct.
* share/txr/stdlib/struct.tl (defstruct): Don't generate lambdas with
empty body; just generate nil, which make-struct-type accepts.
* tests/012/struct.tl: Updated defstruct expansion test.
| -rw-r--r-- | share/txr/stdlib/struct.tl | 33 | ||||
| -rw-r--r-- | tests/012/struct.tl | 30 |
2 files changed, 32 insertions, 31 deletions
diff --git a/share/txr/stdlib/struct.tl b/share/txr/stdlib/struct.tl index d1e42d2a..45d8b4e9 100644 --- a/share/txr/stdlib/struct.tl +++ b/share/txr/stdlib/struct.tl @@ -100,21 +100,24 @@ (type-sym (gensym))) ^(sys:make-struct-type ',name ',super ',stat-slots ',inst-slots - (lambda (,arg-sym) - ,*(mapcar (aret ^(when (static-slot-p ,arg-sym ',@2) - (static-slot-set ,arg-sym ',@2 ,@3))) - stat-si-forms)) - (lambda (,arg-sym) - (let ((,type-sym (struct-type ,arg-sym))) - ,*(mapcar (aret ^(unless (static-slot-p ,type-sym ',@2) - (slotset ,arg-sym ',@2 ,@3))) - inst-si-forms)) - ,*(if (cdr instance-init-form) - ^((let ((,(car instance-init-form) ,arg-sym)) - ,*(cdr instance-init-form)))) - ,*(if (cdr instance-fini-form) - ^((finalize ,arg-sym (lambda (,(car instance-fini-form)) - ,*(cdr instance-fini-form)))))) + ,(if stat-si-forms + ^(lambda (,arg-sym) + ,*(mapcar (aret ^(when (static-slot-p ,arg-sym ',@2) + (static-slot-set ,arg-sym ',@2 ,@3))) + stat-si-forms))) + ,(if (or inst-si-forms instance-init-form instance-fini-form) + ^(lambda (,arg-sym) + ,*(if inst-si-forms + ^((let ((,type-sym (struct-type ,arg-sym))) + ,*(mapcar (aret ^(unless (static-slot-p ,type-sym ',@2) + (slotset ,arg-sym ',@2 ,@3))) + inst-si-forms)))) + ,*(if (cdr instance-init-form) + ^((let ((,(car instance-init-form) ,arg-sym)) + ,*(cdr instance-init-form)))) + ,*(if (cdr instance-fini-form) + ^((finalize ,arg-sym (lambda (,(car instance-fini-form)) + ,*(cdr instance-fini-form))))))) ,(if args (let ((gens (mapcar (ret (gensym)) args))) ^(lambda (,arg-sym ,*gens) diff --git a/tests/012/struct.tl b/tests/012/struct.tl index 3eb5563c..209bae71 100644 --- a/tests/012/struct.tl +++ b/tests/012/struct.tl @@ -70,24 +70,22 @@ (set *gensym-counter* 0) (stest (sys:expand '(defstruct (boa x y) nil (x 0) (y 0))) - "(sys:make-struct-type 'boa '() '()\n \ - \ '(x y) (lambda (#:g0004))\n \ - \ (lambda (#:g0004)\n \ - \ (let ((#:g0005 (struct-type #:g0004)))\n\ - \ (if (static-slot-p #:g0005 'x)\n \ - \ () (progn (slotset #:g0004 'x\n \ - \ 0)))\n \ - \ (if (static-slot-p #:g0005 'y)\n \ - \ () (progn (slotset #:g0004 'y\n \ - \ 0)))))\n \ - \ (lambda (#:g0004 #:g0006\n \ - \ #:g0007)\n \ - \ (slotset #:g0004 'x\n \ - \ #:g0006)\n \ - \ (slotset #:g0004 'y\n \ + "(sys:make-struct-type 'boa '() '()\n \ + \ '(x y) () (lambda (#:g0004)\n \ + \ (let ((#:g0005 (struct-type #:g0004)))\n \ + \ (if (static-slot-p #:g0005 'x)\n \ + \ () (progn (slotset #:g0004 'x\n \ + \ 0)))\n \ + \ (if (static-slot-p #:g0005 'y)\n \ + \ () (progn (slotset #:g0004 'y\n \ + \ 0)))))\n \ + \ (lambda (#:g0004 #:g0006\n \ + \ #:g0007)\n \ + \ (slotset #:g0004 'x\n \ + \ #:g0006)\n \ + \ (slotset #:g0004 'y\n \ \ #:g0007)))") - (defstruct (boa x y) nil (x 0) (y 0)) |