syntax: new .? operator for null-safe object access.

* lib.c (obj_print_impl): Render the new syntactic conventions
introduced in qref/uref back into the .? syntax. The printers
for qref and uref are united into a single implementation to
reduce code proliferation.

* parser.l (grammar): Produce new tokens OREFDOT and UOREFDOT.

* parser.y (OREFDOT, UREFDOT): New terminal symbols.
(n_expr): Handle .? syntax via the new OREFDOT and UOREFDOT
token via qref_helper and uoref_helper. Logic for the existing
referencing dot is moved into the new qref_helper function.
(n_dot_expr): Handle .? syntax via uoref_helper.
(uoref_helper, qref_helper): New static functions.

* share/txr/stdlib/struct.tl (qref): Handle the new case when
the expression which gives the object is (t expr).
Handle the new case when the first argument after the object
has this form, and is followed by more arguments. Both
these cases emit the right conditional code.
(uref): Handle the leading .? syntax indicated by a leading t
by generating a lambda which checks its argument for nil.
Transformations to qref handle the other cases.

* txr.1: Documentation updated in several places.

1 files changed, 40 insertions, 27 deletions

diff --git a/share/txr/stdlib/struct.tl b/share/txr/stdlib/struct.tl
index 67b50b9c..71bcf45b 100644
--- a/share/txr/stdlib/struct.tl
+++ b/share/txr/stdlib/struct.tl
@@ -206,33 +206,43 @@
 (defmacro qref (:form form obj . refs)
   (when (null refs)
     (throwf 'eval-error "~s: bad syntax" 'qref))
-  (tree-case refs
-    (() ())
-    (((dw sym . args))
-     (if (eq dw 'dwim)
-       ^[(slot ,obj ',(sys:check-slot form sym)) ,*args]
-       :))
-    (((dw sym . args) . more)
-     (if (eq dw 'dwim)
-       ^(qref [(slot ,obj ',(sys:check-slot form sym)) ,*args] ,*more)
-       :))
-    (((sym . args))
-     (let ((osym (gensym)))
-       (sys:check-slot form sym)
-       ^(slet ((,osym ,obj))
-          (call (slot ,osym ',sym) ,osym ,*args))))
-    (((sym . args) . more)
-     (let ((osym (gensym)))
-       (sys:check-slot form sym)
-       ^(qref (slet ((,osym ,obj))
-                (call (slot ,osym ',sym) ,osym ,*args)) ,*more)))
-    ((sym)
-     (sys:check-slot form sym)
-     ^(slot ,obj ',sym))
-    ((sym . more)
-     (sys:check-slot form sym)
-     ^(qref (slot ,obj ',sym) ,*more))
-    (obj (throwf 'eval-error "~s: bad syntax: ~s" 'qref refs))))
+  (tree-case obj
+    ((a b) (if (eq a 't)
+             ^(if ,b (qref ,b ,*refs))
+             :))
+    (x (tree-case refs
+         (() ())
+         (((pref sym) . more)
+           (if (eq pref t)
+             (let ((s (gensym)))
+               ^(let ((,s (slot ,obj ',sym)))
+                  (if ,s (qref ,s ,*more))))
+             :))
+         (((dw sym . args))
+          (if (eq dw 'dwim)
+            ^[(slot ,obj ',(sys:check-slot form sym)) ,*args]
+            :))
+         (((dw sym . args) . more)
+          (if (eq dw 'dwim)
+            ^(qref [(slot ,obj ',(sys:check-slot form sym)) ,*args] ,*more)
+            :))
+         (((sym . args))
+          (let ((osym (gensym)))
+            (sys:check-slot form sym)
+            ^(slet ((,osym ,obj))
+               (call (slot ,osym ',sym) ,osym ,*args))))
+         (((sym . args) . more)
+          (let ((osym (gensym)))
+            (sys:check-slot form sym)
+            ^(qref (slet ((,osym ,obj))
+                     (call (slot ,osym ',sym) ,osym ,*args)) ,*more)))
+         ((sym)
+          (sys:check-slot form sym)
+          ^(slot ,obj ',sym))
+         ((sym . more)
+          (sys:check-slot form sym)
+          ^(qref (slot ,obj ',sym) ,*more))
+         (obj (throwf 'eval-error "~s: bad syntax: ~s" 'qref refs))))))
 
 (defmacro uref (. args)
   (cond
@@ -241,6 +251,9 @@
      (if (consp (car args))
        ^(umeth ,*(car args))
        ^(usl ,(car args))))
+    ((eq t (car args))
+     (with-gensyms (ovar)
+       ^(lambda (,ovar) (qref (t ,ovar) ,*(cdr args)))))
     (t (with-gensyms (ovar)
          ^(lambda (,ovar) (qref ,ovar ,*args))))))