diff options
| -rw-r--r-- | eval.c | 3 | ||||
| -rw-r--r-- | eval.h | 2 | ||||
| -rw-r--r-- | lib.c | 11 | ||||
| -rw-r--r-- | lisplib.c | 2 | ||||
| -rw-r--r-- | parser.l | 7 | ||||
| -rw-r--r-- | parser.y | 67 | ||||
| -rw-r--r-- | share/txr/stdlib/struct.tl | 10 | ||||
| -rw-r--r-- | txr.1 | 142 |
8 files changed, 224 insertions, 20 deletions
@@ -94,7 +94,7 @@ val gen_s, gun_s, generate_s, rest_s, plus_s; val promise_s, promise_forced_s, promise_inprogress_s, force_s; val op_s, ap_s, identity_s, apf_s, ipf_s; val ret_s, aret_s; -val hash_lit_s, hash_construct_s, struct_lit_s, qref_s; +val hash_lit_s, hash_construct_s, struct_lit_s, qref_s, uref_s; val vector_lit_s, vec_list_s; val macro_time_s, with_dyn_rebinds_s, macrolet_s; val defsymacro_s, symacrolet_s, prof_s, switch_s; @@ -5417,6 +5417,7 @@ void eval_init(void) hash_construct_s = intern(lit("hash-construct"), user_package); struct_lit_s = intern(lit("struct-lit"), system_package); qref_s = intern(lit("qref"), user_package); + uref_s = intern(lit("uref"), user_package); vector_lit_s = intern(lit("vector-lit"), system_package); vec_list_s = intern(lit("vec-list"), user_package); macro_time_s = intern(lit("macro-time"), user_package); @@ -26,7 +26,7 @@ */ extern val dwim_s, lambda_s, vector_lit_s, vec_list_s, list_s; -extern val hash_lit_s, hash_construct_s, struct_lit_s, qref_s; +extern val hash_lit_s, hash_construct_s, struct_lit_s, qref_s, uref_s; extern val eval_error_s, if_s, call_s; extern val eq_s, eql_s, equal_s; extern val car_s, cdr_s; @@ -9572,7 +9572,10 @@ static val simple_qref_args_p(val args, val pos) return nil; } else { val arg = car(args); - if (symbolp(arg) || (consp(arg) && car(arg) != qref_s)) { + if (symbolp(arg) || (consp(arg) && + car(arg) != qref_s && + car(arg) != uref_s)) + { return simple_qref_args_p(cdr(args), succ(pos)); } return nil; @@ -9800,6 +9803,12 @@ val obj_print_impl(val obj, val out, val pretty, struct strm_ctx *ctx) put_string(lit("."), 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_string(lit("."), out); + obj_print_impl(car(iter), out, pretty, ctx); + } } else if (sym == quasi_s && consp(cdr(obj))) { put_char(chr('`'), out); out_quasi_str(obj, out, ctx); @@ -182,7 +182,7 @@ static val path_test_instantiate(val set_fun) static val struct_set_entries(val dlt, val fun) { val name[] = { - lit("defstruct"), lit("qref"), lit("new"), lit("meth"), + lit("defstruct"), lit("qref"), lit("uref"), lit("new"), lit("meth"), lit("umeth"), lit("usl"), lit("defmeth"), lit("rslot"), nil }; @@ -743,7 +743,7 @@ UONLY {U2}{U}|{U3}{U}{U}|{U4}{U}{U}{U} return HASH_N_HASH; } -<NESTED>\.\. { +<NESTED>{WS}\.\. { yylval->lineno = yyextra->lineno; return DOTDOT; } @@ -773,6 +773,11 @@ UONLY {U2}{U}|{U3}{U}{U}|{U4}{U}{U}{U} return LAMBDOT; } +<SPECIAL,QSPECIAL,NESTED,BRACED>{REQWS}\. { + yylval->chr = '.'; + return UREFDOT; +} + <SPECIAL,QSPECIAL,NESTED,BRACED>\. { yylval->chr = '.'; return '.'; @@ -123,7 +123,7 @@ 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 +%token <chr> REGCHAR REGTOKEN LITCHAR SPLICE CONSDOT LAMBDOT UREFDOT %type <val> spec hash_semi_or_n_expr hash_semi_or_i_expr %type <val> clauses_rev clauses_opt clause @@ -135,7 +135,8 @@ INLINE val expand_form_ver(val form, int ver) %type <val> if_clause elif_clauses_opt else_clause_opt %type <val> line elems_opt elems clause_parts_h additional_parts_h %type <val> text texts elem var var_op modifiers vector hash struct range -%type <val> list exprs exprs_opt n_exprs r_exprs i_expr n_expr n_exprs_opt +%type <val> list exprs exprs_opt n_exprs r_exprs i_expr i_dot_expr +%type <val> n_expr n_exprs_opt n_dot_expr %type <val> out_clauses out_clauses_opt out_clause %type <val> repeat_clause repeat_parts_opt o_line %type <val> o_elems_opt o_elems o_elem o_var q_var rep_elem rep_parts_opt @@ -157,7 +158,7 @@ INLINE val expand_form_ver(val form, int ver) %left '|' '/' %left '&' %right '~' '*' '?' '+' '%' -%right '.' CONSDOT LAMBDOT REGCHAR REGTOKEN LITCHAR +%right '.' CONSDOT LAMBDOT UREFDOT REGCHAR REGTOKEN LITCHAR %right DOTDOT %% @@ -833,6 +834,23 @@ range : HASH_R list { if (length($2) != two) ; list : '(' n_exprs ')' { $$ = rl($2, num($1)); } + | '(' '.' n_exprs ')' { val a = car($3); + if (consp(a) && car(a) == qref_s) { + rplaca(a, uref_s); + $$ = $3; + } else { + $$ = cons(rl(rlcp(list(uref_s, a, nao), a), + num(parser->lineno)), cdr($3)); + } } + | '[' '.' n_exprs ']' { val a = car($3); + if (consp(a) && car(a) == qref_s) { + rplaca(a, uref_s); + $$ = rl(cons(dwim_s, $3), num($1)); + } else { + val ur = cons(rl(rlcp(list(uref_s, a, nao), a), + num(parser->lineno)), cdr($3)); + $$ = rl(cons(dwim_s, ur), num($1)); + } } | '(' ')' { $$ = nil; } | '(' LAMBDOT n_expr ')' { $$ = $3; } | '(' CONSDOT n_expr ')' { $$ = $3; } @@ -923,20 +941,28 @@ i_expr : SYMTOK { $$ = symhlpr($1, t); } | quasilit { $$ = $1; } | WORDS wordslit { $$ = rl($2, num($1)); } | QWORDS wordsqlit { $$ = rl(cons(quasilist_s, $2), num($1)); } - | '\'' i_expr { $$ = rl(rlcp(list(quote_s, $2, nao), $2), + | '\'' i_dot_expr { $$ = rl(rlcp(list(quote_s, $2, nao), $2), num(parser->lineno)); } - | '^' i_expr { $$ = rl(rlcp(list(sys_qquote_s, $2, nao), $2), + | '^' i_dot_expr { $$ = rl(rlcp(list(sys_qquote_s, $2, nao), $2), num(parser->lineno)); } - | ',' i_expr { $$ = rl(rlcp(list(sys_unquote_s, $2, nao), $2), + | ',' i_dot_expr { $$ = rl(rlcp(list(sys_unquote_s, $2, nao), $2), num(parser->lineno)); } - | SPLICE i_expr { $$ = rl(rlcp(list(sys_splice_s, $2, nao), $2), + | SPLICE i_dot_expr { $$ = rl(rlcp(list(sys_splice_s, $2, nao), $2), num(parser->lineno)); } | HASH_N_EQUALS { parser_circ_def(parser, $1, unique_s); } - i_expr { parser_circ_def(parser, $1, $3); + i_dot_expr { parser_circ_def(parser, $1, $3); $$ = $3; } | HASH_N_HASH { $$ = parser_circ_ref(parser, $1); } ; +i_dot_expr : '.' i_expr { if (consp($2) && car($2) == qref_s) { + $$ = rplaca($2, uref_s); + } else { + $$ = rl(rlcp(list(uref_s, $2, nao), $2), + num(parser->lineno)); + } } + | i_expr %prec LOW { $$ = $1; } + ; n_expr : SYMTOK { $$ = symhlpr($1, t); } | METANUM { $$ = cons(var_s, cons($1, nil)); rl($$, num(parser->lineno)); } @@ -952,13 +978,13 @@ n_expr : SYMTOK { $$ = symhlpr($1, t); } | quasilit { $$ = $1; } | WORDS wordslit { $$ = rl($2, num($1)); } | QWORDS wordsqlit { $$ = rl(cons(quasilist_s, $2), num($1)); } - | '\'' n_expr { $$ = rl(rlcp(list(quote_s, $2, nao), $2), + | '\'' n_dot_expr { $$ = rl(rlcp(list(quote_s, $2, nao), $2), num(parser->lineno)); } - | '^' n_expr { $$ = rl(rlcp(list(sys_qquote_s, $2, nao), $2), + | '^' n_dot_expr { $$ = rl(rlcp(list(sys_qquote_s, $2, nao), $2), num(parser->lineno)); } - | ',' n_expr { $$ = rl(rlcp(list(sys_unquote_s, $2, nao), $2), + | ',' n_dot_expr { $$ = rl(rlcp(list(sys_unquote_s, $2, nao), $2), num(parser->lineno)); } - | SPLICE n_expr { $$ = rl(rlcp(list(sys_splice_s, $2, nao), $2), + | SPLICE n_dot_expr { $$ = rl(rlcp(list(sys_splice_s, $2, nao), $2), num(parser->lineno)); } | n_expr DOTDOT n_expr { uses_or2; $$ = rlcp(list(rcons_s, $1, $3, nao), @@ -973,8 +999,14 @@ n_expr : SYMTOK { $$ = symhlpr($1, t); } or2($1, $3)), num(parser->lineno)); } } + | UREFDOT n_expr { if (consp($2) && car($2) == qref_s) { + $$ = rplaca($2, uref_s); + } else { + $$ = rl(rlcp(list(uref_s, $2, nao), $2), + num(parser->lineno)); + } } | HASH_N_EQUALS { parser_circ_def(parser, $1, unique_s); } - n_expr { parser_circ_def(parser, $1, $3); + n_dot_expr { parser_circ_def(parser, $1, $3); $$ = $3; } | HASH_N_HASH { $$ = parser_circ_ref(parser, $1); } ; @@ -983,6 +1015,15 @@ n_exprs_opt : n_exprs { $$ = $1; } | /* empty */ { $$ = nil; } ; +n_dot_expr : '.' n_expr { if (consp($2) && car($2) == qref_s) { + $$ = rplaca($2, uref_s); + } else { + $$ = rl(rlcp(list(uref_s, $2, nao), $2), + num(parser->lineno)); + } } + | n_expr %prec LOW { $$ = $1; } + ; + regex : '/' regexpr '/' { $$ = regex_compile($2, nil); end_of_regex(scnr); rl($$, num(parser->lineno)); } diff --git a/share/txr/stdlib/struct.tl b/share/txr/stdlib/struct.tl index ec48bcb3..7de81ae9 100644 --- a/share/txr/stdlib/struct.tl +++ b/share/txr/stdlib/struct.tl @@ -207,6 +207,16 @@ ((sym . more) ^(qref (slot ,obj ',sym) ,*more)) (obj (throwf 'eval-error "~s: bad syntax: ~s" 'qref refs)))) +(defmacro uref (:whole form . args) + (cond + ((null args) (throwf 'eval-error "~s: bad syntax" 'uref)) + ((null (cdr args)) + (if (consp (car args)) + ^(umeth ,*(car args)) + ^(usl ,(car args)))) + (t (with-gensyms (ovar) + ^(lambda (,ovar) (qref ,ovar ,*args)))))) + (defmacro new (spec . pairs) (if (oddp (length pairs)) (throwf 'eval-error "~s: slot initform arguments must occur pairwise" @@ -10595,6 +10595,56 @@ Such ambiguous uses of floating-point tokens are diagnosed as syntax errors: (a .4) ;; good: a followed by 0.4 .cble +.NP* Unbound Referencing Dot + +Closely related to the referencing dot syntax is the unbound +referencing dot. This is a dot which is flanked by an expression on the right, +without any intervening whitespace, but is not preceded by an expression +Rather, it is preceded by whitespace, +or some punctuation such as +.codn [ , +.code ( +or +.codn ' . +This is a syntactic sugar which translates to +.code uref +syntax: + +.cblk + .a <--> (uref a) + .a.b <--> (uref a b) +.cble + +When the unbound referencing dot is applied to a dotted expression, +this can be understood as a conversion of +.code qref +to +.codn uref . + +Indeed, this is exactly what happens if the unbound dot is applied to an +explicit +.code qref +expression: + + .(qref a b) <--> (uref a b) + +The unbound referencing dot takes its name from the semantics of the +.code uref +macro, which produces a function that implements late binding of an +object to a method slot. Whereas the expression +.code obj.a.b +denotes accessing object +.code obj +to retrieve slot +.code a +and then accessing slot +.code b +of the object from that slot, the expression +.code .a.b. +represents a "disembodied" reference: it produces a function which takes an +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". .NP* Quote and Quasiquote @@ -21632,9 +21682,12 @@ For more convenient and clutter-free expression of structure-based program code, macros are also provided. Furthermore, concise and expressive slot access syntax is provided courtesy of -the referencing dot syntax, a syntactic sugar for the +the referencing dot and unbound referencing dot syntax, a syntactic sugar +for the .code qref -macro. +and +.code uref +macros. Structure types have a name, which is a symbol. The .code typeof @@ -22557,6 +22610,91 @@ function which is particular to the object. Secondly, the object is passed to the selected function as the leftmost argument, so that the function has access to the object. +.coNP Macro @ uref +.synb +.mets (uref >> { slot | >> ( slot << arg *) | >> [ slot << arg *]}+) +.syne +.desc +The +.code uref +macro expands to an expression which evaluates to a function. +The function takes exactly one argument: an object. +When the function is invoked on an object, it references slots +or methods relative to that object. + +Note: the +.code uref +syntax may be used directly, but it is also produced by the unbound referencing +dot syntactic sugar: + +.cblk + .a --> (uref a) + .(f x) --> (uref (f x)) + .(f x).b --> (uref (f x) b) + .a.(f x).b --> (uref a (f x) b) +.cble + +The macro may be understood in terms of the following translation +scheme: + +.cblk + (uref a b c ...) --> (lambda (o) (qref o a b c ...)) +.cble + +where +.code o +is understood to be a unique symbol (for instance, as produced by the +.code gensym +function). + +When only one +.code uref +argument is present, these equivalences also hold: + +.cblk + (uref (f a b c ...)) <--> (umeth f a b c ...) + (uref s) <--> (usl s) +.cble + +.TP* Examples: + +Suppose that the objects in +.code list +have slots +.code a +and +.codn b . +Then, a list of the +.code a +slot values may be obtained using: + +.cblk + (mapcar .a list) +.cble + +because this is equivalent to + +.cblk + (mapcar (lambda (o) o.a) list) +.cble + +Because +.code uref +produces a function, its result can be operated upon by +functional combinators. For instance, we can use the +.code juxt +combinator to produce a list of two-element lists, +which hold the +.code a +and +.code b +slots from each object in +.codn list : + +.cblk + (mapcar (juxt .a .b) list) +.cble + .coNP Macro @ meth .synb .mets (meth < struct < slot << curried-expr *) |