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.
author: Kaz Kylheku <kaz@kylheku.com> 2019-11-05 23:50:22 -0800
committer: Kaz Kylheku <kaz@kylheku.com> 2019-11-05 23:50:22 -0800
commit: d3ec853013356d9c8267980a5146728c16e002ba (patch)
tree: a4cc5ae81784c16d6177b7a4a032b5ea014ab784
parent: a8d9b5d83b10ff215e40fffd1d88fd081a5f1728 (diff)
download: txr-d3ec853013356d9c8267980a5146728c16e002ba.tar.gz
txr-d3ec853013356d9c8267980a5146728c16e002ba.tar.bz2
txr-d3ec853013356d9c8267980a5146728c16e002ba.zip
5 files changed, 204 insertions, 58 deletions
diff --git a/lib.c b/lib.c
index 18764ad7..57ea4128 100644
--- a/lib.c
+++ b/lib.c
@@ -11526,20 +11526,34 @@ val obj_print_impl(val obj, val out, val pretty, struct strm_ctx *ctx)
         obj_print_impl(second(obj), out, pretty, ctx);
         put_string(lit(".."), out);
         obj_print_impl(third(obj), out, pretty, ctx);
-      } else if (sym == qref_s && simple_qref_args_p(cdr(obj), zero)) {
-        val iter, next;
-        for (iter = cdr(obj); iter; iter = next) {
-          next = cdr(iter);
-          obj_print_impl(car(iter), out, pretty, ctx);
-          if (next)
+      } else if ((sym == uref_s || sym == qref_s) &&
+                 simple_qref_args_p(cdr(obj), if3(sym == uref_s, zero, one)))
+      {
+        val iter = cdr(obj), next;
+
+        if (sym == uref_s) {
+          if (car(iter) == t) {
+            put_string(lit(".?"), out);
+            iter = cdr(iter);
+          } else {
             put_char(chr('.'), out);
-          iter = next;
+          }
         }
-      } else if (sym == uref_s && simple_qref_args_p(cdr(obj), one)) {
-        val iter;
-        for (iter = cdr(obj); iter; iter = cdr(iter)) {
-          put_char(chr('.'), out);
-          obj_print_impl(car(iter), out, pretty, ctx);
+
+        for (; iter; iter = next) {
+          val el = car(iter);
+          val qmark = nil;
+          next = cdr(iter);
+          if (next && consp(el) && car(el) == t && consp(cdr(el)) && !cddr(el)) {
+            el = cadr(el);
+            qmark = t;
+          }
+          obj_print_impl(el, out, pretty, ctx);
+          if (next) {
+            put_char(chr('.'), out);
+            if (qmark)
+              put_char(chr('?'), out);
+          }
         }
       } else if (sym == quasi_s && consp(cdr(obj))) {
         put_char(chr('`'), out);
diff --git a/parser.l b/parser.l
index bebe64f5..292615e1 100644
--- a/parser.l
+++ b/parser.l
@@ -801,6 +801,16 @@ UONLY   {U2}{U}|{U3}{U}{U}|{U4}{U}{U}{U}
   return '.';
 }
 
+<SPECIAL,QSPECIAL,NESTED>\.\? {
+  yylval->chr = '.';
+  return OREFDOT;
+}
+
+<SPECIAL,QSPECIAL,NESTED,BRACED>{REQWS}\.\? {
+  yylval->chr = '.';
+  return UOREFDOT;
+}
+
 <SPECIAL,QSPECIAL,NESTED,BRACED>[\\]{NL}{WS} {
   if (YYSTATE == SPECIAL)
     yy_pop_state(yyscanner);  /* @\ continuation */
diff --git a/parser.y b/parser.y
index 41fb965f..360ed36c 100644
--- a/parser.y
+++ b/parser.y
@@ -69,6 +69,8 @@ static val make_expr(parser_t *, val sym, val rest, val lineno);
 static val check_parse_time_action(val spec_rev);
 static void misplaced_consing_dot_check(scanner_t *scanner, val term_atom_cons);
 static val uref_helper(parser_t *, val expr);
+static val uoref_helper(parser_t *, val expr);
+static val qref_helper(parser_t *, val lexpr, val rexpr);
 static val fname_helper(parser_t *, val name);
 
 #if YYBISON
@@ -128,7 +130,8 @@ INLINE val expand_form_ver(val form, int ver)
 %token <val> NUMBER METANUM
 %token <val> HASH_N_EQUALS HASH_N_HASH
 
-%token <chr> REGCHAR REGTOKEN LITCHAR SPLICE CONSDOT LAMBDOT UREFDOT
+%token <chr> REGCHAR REGTOKEN LITCHAR SPLICE
+%token <chr> CONSDOT LAMBDOT UREFDOT OREFDOT UOREFDOT
 
 %type <val> spec hash_semi_or_n_expr hash_semi_or_i_expr
 %type <val> clauses_rev clauses_opt clause
@@ -166,7 +169,7 @@ INLINE val expand_form_ver(val form, int ver)
 %left '&'
 %right '~' '*' '?' '+' '%'
 %right DOTDOT
-%right '.' CONSDOT LAMBDOT UREFDOT REGCHAR REGTOKEN LITCHAR
+%right '.' CONSDOT LAMBDOT UREFDOT OREFDOT UOREFDOT REGCHAR REGTOKEN LITCHAR
 %right OLD_DOTDOT
 
 %%
@@ -1072,17 +1075,12 @@ n_expr : SYMTOK                 { $$ = ifnign(symhlpr($1, t)); }
                                                           uref_helper(parser, $4),
                                                           nao),
                                             or2($1, $4)); }
-       | n_expr '.' n_expr      { uses_or2;
-                                  if (consp($3) && car($3) == qref_s) {
-                                    rplacd($3, rlc(cons($1, cdr($3)), $1));
-                                    rl($$, num(parser->lineno));
-                                    $$ = $3;
-                                  } else {
-                                    $$ = rl(rlc(list(qref_s, $1, $3, nao),
-                                                 or2($1, $3)),
-                                                 num(parser->lineno));
-                                  } }
+       | n_expr '.' n_expr      { $$ = qref_helper(parser, $1, $3); }
+       | n_expr OREFDOT n_expr  { $$ = qref_helper(parser,
+                                                   cons(t, cons($1, nil)),
+                                                        $3); }
        | UREFDOT n_expr         { $$ = uref_helper(parser, $2); }
+       | UOREFDOT n_expr        { $$ = uoref_helper(parser, $2); }
        | HASH_N_EQUALS          { parser_circ_def(parser, $1, unique_s); }
          n_dot_expr             { parser_circ_def(parser, $1, $3);
                                   $$ = $3; }
@@ -1094,6 +1092,7 @@ n_exprs_opt : n_exprs           { $$ = $1; }
           ;
 
 n_dot_expr : '.' n_expr         { $$ = uref_helper(parser, $2); }
+           | OREFDOT n_expr     { $$ = uoref_helper(parser, $2); }
            | n_expr %prec LOW   { $$ = $1; }
            ;
 
@@ -1789,6 +1788,27 @@ static val uref_helper(parser_t *parser, val expr)
   }
 }
 
+static val uoref_helper(parser_t *parser, val expr)
+{
+  val uref = uref_helper(parser, expr);
+  rplacd(uref, cons(t, cdr(uref)));
+  return uref;
+}
+
+static val qref_helper(parser_t *parser, val lexpr, val rexpr)
+{
+  uses_or2;
+
+  if (consp(rexpr) && car(rexpr) == qref_s) {
+    rplacd(rexpr, rlc(cons(lexpr, cdr(rexpr)), lexpr));
+    return rl(rexpr, num(parser->lineno));
+  } else {
+    return rl(rlc(list(qref_s, lexpr, rexpr, nao),
+                  or2(lexpr, rexpr)),
+                  num(parser->lineno));
+  }
+}
+
 static val fname_helper(parser_t *parser, val name)
 {
   if (!name) {
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))))))
 
diff --git a/txr.1 b/txr.1
index 268869ce..a22b2423 100644
--- a/txr.1
+++ b/txr.1
@@ -11159,8 +11159,9 @@ A dot token which is flanked by expressions on both sides, without any
 intervening whitespace, is the referencing dot, and not the consing dot.
 The referencing dot is a syntactic sugar which translated to the
 .code qref
-syntax ("quoted ref"). This syntax denotes structure access;
-see Structures.
+syntax ("quoted ref"). When evaluated as a form, this syntax denotes structure
+access; see Structures. However, it is possible to put this syntax to use for
+other purposes, in other contexts.
 
 .verb
   ;; a.b may be almost any expressions
@@ -11186,6 +11187,31 @@ and then adjoining
 to produce
 .codn "(qref a b c)" .
 
+If the referencing dot is immediately followed by a question mark, it forms
+a single token, which produces the following syntactic variation:
+
+.verb
+  a.?b     <-->  (t a).b         <--> (qref (t a) b)
+  a.?b.?c  <-->  (t a).(t b).c   <--> (qref (t a) (t b) c)
+.brev
+
+This syntax denotes
+.I null-safe
+access to structure slots.
+.code a.?b
+means that
+.code a
+may evaluate to
+.codn nil ,
+in which case the expression yields
+.codn nil ;
+otherwise,
+.code a
+must evaluate to a
+.code struct
+which has a slot
+.codn b .
+
 Integer tokens cannot be involved in this syntax, because they
 form floating-point constants when juxtaposed with a dot.
 Such ambiguous uses of floating-point tokens are diagnosed as syntax errors:
@@ -11211,8 +11237,22 @@ This is a syntactic sugar which translates to
 syntax:
 
 .verb
-  .a            <--> (uref a)
-  .a.b          <--> (uref a b)
+  .a       <--> (uref a)
+  .a.b     <--> (uref a b)
+  .a.?b    <--> (uref (t a) b)
+.brev
+
+If the unbound referencing dot is itself combined with a question
+mark to form the
+.code .?
+token, then the translation to
+.code uref
+is as follows:
+
+.verb
+  .?a      <--> (uref t a)
+  .?a.b    <--> (uref t a b)
+  .?a.?b    <--> (uref t a (t b))
 .brev
 
 When the unbound referencing dot is applied to a dotted expression,
@@ -11248,6 +11288,15 @@ object as an argument and then performs the implied slot referencing on that
 argument. When the function is called, it is said to bind the referencing to
 the object. Hence that referencing is "unbound".
 
+Whereas the expression
+.code .a
+produces a function whose argument must be an object,
+.code .?a
+produces a function whose argument may be
+.codn nil .
+The function detects this case and returns
+.codn nil .
+
 .NP* Quote and Quasiquote
 
 .meIP >> ' expr
@@ -25975,15 +26024,25 @@ another
 .code qref
 operation, and so forth.
 
+If the null-safe syntax
+.code "(t ...)"
+is present, the equivalence becomes more complicated:
+
+.verb
+  (qref (t obj) d1 d2 ...)  <---> (qref (qref (t obj) d1) d2 ...)
+
+  (qref obj (t d1) d2 ...)  <---> (qref (t (qref obj d1)) d2 ...)
+.brev
+
 Thus,
 .code qref
-can be understood entirely in terms of the semantics of the
+can be understood in terms of the semantics of the
 binary form
 .mono
 .meti (qref < object-form << designator )
 .onom
 
-Designators come in three forms: a lone symbol, an ordinary compound expression
+Designators come in three basic forms: a lone symbol, an ordinary compound expression
 consisting of a symbol followed by arguments, or a DWIM expression
 consisting of a symbol followed by arguments.
 
@@ -26025,6 +26084,34 @@ indexable or callable object. The following equivalence applies:
   (qref obj [name arg ...])  <-->  [(slot obj 'name) arg ...]
 .brev
 
+If the
+.meta object-form
+has the syntax
+.mono
+.meti (t << expression )
+.onom
+this indicates null-safe access: if
+.meta expression
+evaluates to
+.code nil
+then the entire expression
+.mono
+.meti (qref (t << expression ) << designator )
+.onom
+form yields
+.codn nil .
+This syntax is produced by the
+.code .?
+notation.
+
+The null-safe access notation prevents not only slot access, but also
+method or function calls on
+.codn nil .
+When a method or function call is suppressed due to the object being
+.codn nil ,
+no aspect of the method or function call is evaluated; not only
+is the slot not accessed, but the argument expressions are not evaluated.
+
 .TP* Example:
 
 .verb
@@ -26078,6 +26165,7 @@ dot syntactic sugar:
 
 .verb
   .a          -->  (uref a)
+  .?a         -->  (uref t a)
   .(f x)      -->  (uref (f x))
   .(f x).b    -->  (uref (f x) b)
   .a.(f x).b  -->  (uref a (f x) b)
@@ -26087,7 +26175,8 @@ The macro may be understood in terms of the following translation
 scheme:
 
 .verb
-  (uref a b c ...)  -->  (lambda (o) (qref o a b c ...))
+  (uref a b ...)    -->  (lambda (o) (qref o a b ...))
+  (uref t a b ...)  -->  (lambda (o) (if o (qref o a b ...)))
 .brev
 
 where
author	Kaz Kylheku <kaz@kylheku.com>	2019-11-05 23:50:22 -0800
committer	Kaz Kylheku <kaz@kylheku.com>	2019-11-05 23:50:22 -0800
commit	d3ec853013356d9c8267980a5146728c16e002ba (patch)
tree	a4cc5ae81784c16d6177b7a4a032b5ea014ab784
parent	a8d9b5d83b10ff215e40fffd1d88fd081a5f1728 (diff)
download	txr-d3ec853013356d9c8267980a5146728c16e002ba.tar.gz txr-d3ec853013356d9c8267980a5146728c16e002ba.tar.bz2 txr-d3ec853013356d9c8267980a5146728c16e002ba.zip