diff options
author | Kaz Kylheku <kaz@kylheku.com> | 2021-07-31 13:07:06 -0700 |
---|---|---|
committer | Kaz Kylheku <kaz@kylheku.com> | 2021-07-31 13:07:06 -0700 |
commit | 0b4a373f69bf7e4684f03d622ee0c1f3be8e8df5 (patch) | |
tree | 75bfd519115bf59c59cd7638c382ef3672b40ac5 | |
parent | b6983a3098d26727b9ca81a37c58cc01cef51341 (diff) | |
download | txr-0b4a373f69bf7e4684f03d622ee0c1f3be8e8df5.tar.gz txr-0b4a373f69bf7e4684f03d622ee0c1f3be8e8df5.tar.bz2 txr-0b4a373f69bf7e4684f03d622ee0c1f3be8e8df5.zip |
oop: fix infelicity in new* and lnew* macros.
* stdlib/struct.tl (sys:new-expander): If the argument of
new* or lnew* is dwim, then treat that as an expression,
rather than as a boa-style construction.
* tests/012/oop.tl: Tests for new* focusing on this issue.
* txr.1: Documented.
-rw-r--r-- | stdlib/struct.tl | 21 | ||||
-rw-r--r-- | tests/012/oop.tl | 14 | ||||
-rw-r--r-- | txr.1 | 73 |
3 files changed, 98 insertions, 10 deletions
diff --git a/stdlib/struct.tl b/stdlib/struct.tl index 9108ab02..e156c3db 100644 --- a/stdlib/struct.tl +++ b/stdlib/struct.tl @@ -285,15 +285,18 @@ (let ((qpairs (mappend (aret ^(',@1 ,@2)) (tuples 2 pairs)))) (tree-case spec ((texpr . args) - (let ((type (sys:new-type op form texpr))) - (caseq op - ((new new*) (if qpairs - ^(make-struct ,type (list ,*qpairs) ,*args) - ^(struct-from-args ,type ,*args))) - ((lnew lnew*) ^(make-lazy-struct ,type - (lambda () - (cons (list ,*qpairs) - (list ,*args)))))))) + (if (and (eq texpr 'dwim) + (meq op 'new* 'lnew*)) + : + (let ((type (sys:new-type op form texpr))) + (caseq op + ((new new*) (if qpairs + ^(make-struct ,type (list ,*qpairs) ,*args) + ^(struct-from-args ,type ,*args))) + ((lnew lnew*) ^(make-lazy-struct ,type + (lambda () + (cons (list ,*qpairs) + (list ,*args))))))))) (texpr (let ((type (sys:new-type op form texpr))) (caseq op diff --git a/tests/012/oop.tl b/tests/012/oop.tl index ac93790f..e9c256b8 100644 --- a/tests/012/oop.tl +++ b/tests/012/oop.tl @@ -77,3 +77,17 @@ (prinl d) (prinl (list b.sa b.sb b.sc b.x b.y)) (prinl (list d.sa d.sb d.sc d.x d.y))) + +(defstruct (ab a : b) () a b) + +(mtest + (new* (find-struct-type 'ab) a 1) :error + (new* ((find-struct-type 'ab)) a 1) #S(ab a 1 b nil) + (new* [find-struct-type 'ab] a 1) #S(ab a 1 b nil) + (new* ([find-struct-type 'ab] 1 2)) #S(ab a 1 b 2) + (new* ((find-struct-type 'ab) 1 2)) #S(ab a 1 b 2) + (new* ([find-struct-type 'ab] 1) b 2) #S(ab a 1 b 2) + (let ((type (find-struct-type 'ab))) + (new* type a 3 b 4)) #S(ab a 3 b 4) + (let ((type (find-struct-type 'ab))) + (new* (type 3 4))) #S(ab a 3 b 4)) @@ -28264,7 +28264,7 @@ macros are variants, respectively, of and .codn lnew . -The only difference in behavior in these macros relative to +The difference in behavior in these macros relative to .code new and .code lnew @@ -28276,6 +28276,77 @@ which is evaluated. The value of .meta expr must be a struct type, or a symbol which is the name of a struct type. +With one exception, if +.meta expr0 +is a compound expression, then +.mono +.meti (new* < expr0 ...) +.onom +is interpreted as +.mono +.meti (new* >> ( expr1 << args... ) ...) +.onom +where the head of +.metn expr0 , +.metn expr1 , +is actually the expression which is evaluated to produce the type, and the remaining +constituents of +.metn expr0 , +.metn args , +become the boa arguments. The same requirement applies to +.codn lnew* . + +The exception is that if +.meta expr1 +is the symbol +.codn dwim , +this interpretation does not apply. Thus +.mono +.meti (new* >> [ fun << args... ] ...) +.onom +evaluates the +.mono +.meti >> [ fun << args... ] +.onom +expression, rather than treating it as +.mono +.meti (dwim < fun << args... ) +.onom +where +.code dwim +would be evaluated as a variable reference expected to produce a type. + +.TP* Examples: + +.verb + ;; struct with boa constructor + (defstruct (ab a : b) () a b) + + ;; error: find-struct-type is interpreted as a variable + (new* (find-struct-type 'ab) a 1) -> ;; error + + ;; OK: extra nesting. + (new* ((find-struct-type 'ab)) a 1) -> #S(ab a 1 b nil) + + ;; OK: dwim brackets without nesting. + (new* [find-struct-type 'ab] a 1) -> #S(ab a 1 b nil) + + ;; boa construction + (new* ([find-struct-type 'ab] 1 2)) -> #S(ab a 1 b 2) + (new* ((find-struct-type 'ab) 1 2)) -> #S(ab a 1 b 2) + + ;; mixed construction + (new* ([find-struct-type 'ab] 1) b 2) -> #S(ab a 1 b 2) + + (let ((type (find-struct-type 'ab))) + (new* type a 3 b 4)) + -> #S(ab a 3 b 4) + + (let ((type (find-struct-type 'ab))) + (new* (type 3 4))) + -> #S(ab a 3 b 4) +.brev + .coNP Macro @ with-slots .synb .mets (with-slots >> ({ slot | >> ( sym << slot )}*) < struct-expr |