summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKaz Kylheku <kaz@kylheku.com>2021-07-31 13:07:06 -0700
committerKaz Kylheku <kaz@kylheku.com>2021-07-31 13:07:06 -0700
commit0b4a373f69bf7e4684f03d622ee0c1f3be8e8df5 (patch)
tree75bfd519115bf59c59cd7638c382ef3672b40ac5
parentb6983a3098d26727b9ca81a37c58cc01cef51341 (diff)
downloadtxr-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.tl21
-rw-r--r--tests/012/oop.tl14
-rw-r--r--txr.173
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))
diff --git a/txr.1 b/txr.1
index ecae46d6..91dc6042 100644
--- a/txr.1
+++ b/txr.1
@@ -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