diff options
| -rw-r--r-- | lib.c | 38 | ||||
| -rw-r--r-- | parser.l | 10 | ||||
| -rw-r--r-- | parser.y | 44 | ||||
| -rw-r--r-- | share/txr/stdlib/struct.tl | 67 | ||||
| -rw-r--r-- | txr.1 | 103 |
5 files changed, 204 insertions, 58 deletions
@@ -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); @@ -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 */ @@ -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)))))) @@ -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 |