diff options
| -rw-r--r-- | ChangeLog | 29 | ||||
| -rw-r--r-- | eval.c | 76 | ||||
| -rw-r--r-- | lib.c | 11 | ||||
| -rw-r--r-- | lib.h | 1 | ||||
| -rw-r--r-- | parser.l | 11 | ||||
| -rw-r--r-- | parser.y | 21 | ||||
| -rw-r--r-- | txr.1 | 82 | ||||
| -rw-r--r-- | txr.vim | 2 |
8 files changed, 211 insertions, 22 deletions
@@ -1,3 +1,32 @@ +2012-02-03 Kaz Kylheku <kaz@kylheku.com> + + * eval.c (rest_s, op_s): New variables. + (do_eval_args): Allow calls specified by improper lists + like (x y . z) where the z expression must evaluate to a list + that turns into addition arguments to be applied. + (transform_op, expand_op): New static functions. + (expand): Call expand_op. + (eval_init): Initialize rest_s and op_s. Use rest_s + to register rest function. + + * lib.c (gensym): New function based on gensymv. + (gensymv): Now calls gensym. + + * lib.h (gensym): Declared. + + * parser.l: Parse @ followed by digits as a new kind of token, + METANUM. + + * parser.y (METANUM): New token. + (meta_expr, exprs): Missing rlcp's added. + (expr): METANUM variant introduced. + (yybadtoken): Handle METANUM. + + * txr.1: Documented one-symbol argument list of lambda. + Documented op. Closed some unbalanced parentheses. + + * txr.vim: Highlight op. + 2012-02-02 Kaz Kylheku <kaz@kylheku.com> * utf8.c (utf8_from_uc, utf8_decode): Use upper case for hex constants. @@ -62,8 +62,8 @@ val inc_s, dec_s, push_s, pop_s, flip_s, gethash_s, car_s, cdr_s, vecref_s; val for_s, for_star_s, each_s, each_star_s, collect_each_s, collect_each_star_s; val dohash_s; val uw_protect_s, return_s, return_from_s; -val list_s, append_s, apply_s, gen_s, generate_s; -val delay_s, promise_s; +val list_s, append_s, apply_s, gen_s, generate_s, rest_s; +val delay_s, promise_s, op_s; val make_env(val vbindings, val fbindings, val up_env) { @@ -332,8 +332,10 @@ static val do_eval_args(val form, val env, val ctx_form, val (*lookup)(val env, val sym)) { list_collect_decl (values, ptail); - for (; form; form = cdr(form)) + for (; consp(form); form = cdr(form)) list_collect(ptail, do_eval(car(form), env, ctx_form, lookup)); + if (form) + list_collect_append(ptail, do_eval(form, env, ctx_form, lookup)); return values; } @@ -1325,6 +1327,67 @@ static val expand_delay(val args) cons(lambda_s, cons(nil, args)), nao); } +static val transform_op(val forms, val syms, val rg) +{ + if (atom(forms)) { + return cons(syms, forms); + } else { + val fi = first(forms); + val re = rest(forms); + + if (consp(fi) && car(fi) == var_s && consp(cdr(fi))) { + val vararg = car(cdr(fi)); + + if (numberp(vararg)) { + val prefix = format(nil, lit("arg-~,02s-"), vararg, nao); + val newsyms = syms; + val new_p; + val *place = acons_new_l(vararg, &new_p, &newsyms); + val sym = if3(new_p, *place = gensym(prefix), *place); + cons_bind (outsyms, outforms, transform_op(re, newsyms, rg)); + return cons(outsyms, rlcp(cons(sym, outforms), outforms)); + } else if (eq(vararg, rest_s)) { + cons_bind (outsyms, outforms, transform_op(re, syms, rg)); + return cons(outsyms, rlcp(cons(rg, outforms), outforms)); + } + } + + { + cons_bind (fisyms, fiform, transform_op(fi, syms, rg)); + cons_bind (resyms, reforms, transform_op(re, fisyms, rg)); + return cons(resyms, rlcp(cons(fiform, reforms), fiform)); + } + } +} + +static val expand_op(val body) +{ + val body_ex = expand_forms(body); + val rest_gensym = gensym(lit("rest-")); + cons_bind (syms, body_trans, transform_op(body_ex, nil, rest_gensym)); + val ssyms = sort(syms, func_n2(lt), car_f); + val nums = mapcar(car_f, ssyms); + val max = if3(nums, maxv(car(nums), cdr(nums)), zero); + val min = if3(nums, minv(car(nums), cdr(nums)), zero); + val has_rest = tree_find(rest_gensym, body_trans, eq_f); + + if (!eql(max, length(nums)) && !zerop(min)) + eval_error(body, lit("op: missing numeric arguments"), nao); + + rlcp(body_trans, body); + + { + val dwim_body = rlcp(cons(dwim_s, + append2(body_trans, if3(has_rest, nil, + rest_gensym))), + body_trans); + + return cons(lambda_s, + cons(append2(mapcar(cdr_f, ssyms), rest_gensym), + cons(dwim_body, nil))); + } +} + val expand(val form) { if (atom(form)) { @@ -1453,6 +1516,8 @@ val expand(val form) return expand(expand_gen(rest(form))); } else if (sym == delay_s) { return expand(expand_delay(rest(form))); + } else if (sym == op_s) { + return expand_op(rest(form)); } else { /* funtion call also handles: progn, prog1, call, if, and, or, @@ -1761,7 +1826,8 @@ void eval_init(void) generate_s = intern(lit("generate"), user_package); delay_s = intern(lit("delay"), user_package); promise_s = intern(lit("promise"), system_package); - + op_s = intern(lit("op"), user_package); + rest_s = intern(lit("rest"), user_package); sethash(op_table, quote_s, cptr((mem_t *) op_quote)); sethash(op_table, qquote_s, cptr((mem_t *) op_qquote_error)); sethash(op_table, unquote_s, cptr((mem_t *) op_unquote_error)); @@ -1807,7 +1873,7 @@ void eval_init(void) reg_fun(intern(lit("rplaca"), user_package), func_n2(rplaca)); reg_fun(intern(lit("rplacd"), user_package), func_n2(rplacd)); reg_fun(intern(lit("first"), user_package), func_n1(car)); - reg_fun(intern(lit("rest"), user_package), func_n1(cdr)); + reg_fun(rest_s, func_n1(cdr)); reg_fun(intern(lit("sub-list"), user_package), func_n3(sub_list)); reg_fun(intern(lit("replace-list"), user_package), func_n4(replace_list)); reg_fun(append_s, func_n0v(appendv)); @@ -1929,15 +1929,20 @@ val make_sym(val name) return obj; } -val gensymv(val args) +val gensym(val prefix) { - uses_or2; gensym_counter = plus(gensym_counter, one); - val prefix = or2(car(args), lit("g")); val name = format(nil, lit("~a~,04a"), prefix, gensym_counter, nao); return make_sym(name); } +val gensymv(val args) +{ + uses_or2; + val prefix = or2(car(args), lit("g")); + return gensym(prefix); +} + val make_package(val name) { if (find_package(name)) { @@ -453,6 +453,7 @@ val span_str(val str, val set); val compl_span_str(val str, val set); val break_str(val str, val set); val make_sym(val name); +val gensym(val prefix); val gensymv(val args); val make_package(val name); val find_package(val name); @@ -150,6 +150,7 @@ NUM [+\-]?[0-9]+ NSCHR [a-zA-Z0-9!$%&*+\-<=>?\\^_~] NSYM {NSCHR}({NSCHR}|#)* TOK :?{SYM} +ATNUM @{NUM} NTOK [:@]?{NSYM} ID_END [^a-zA-Z0-9_] WS [\t ]* @@ -182,6 +183,16 @@ UONLY {U2}{U}|{U3}{U}{U}|{U4}{U}{U}{U} return NUMBER; } +<NESTED>{ATNUM} { + val str = string_own(utf8_dup_from(yytext + 1)); + + if (yy_top_state() == INITIAL + || yy_top_state() == QSILIT) + yy_pop_state(); + yylval.num = int_str(str, num(10)); + return METANUM; + } + <SPECIAL>{TOK} | <NESTED>{NTOK} { if (yy_top_state() == INITIAL @@ -74,7 +74,7 @@ static val parsed_spec; %token <lineno> ERRTOK /* deliberately not used in grammar */ %token <lineno> HASH_BACKSLASH DOTDOT -%token <val> NUMBER +%token <val> NUMBER METANUM %token <chr> REGCHAR LITCHAR %token <chr> METAPAR METABKT SPLICE @@ -677,17 +677,19 @@ list : '(' exprs ')' { $$ = rl($2, num($1)); } meta_expr : METAPAR exprs ')' { $$ = rlcp(cons(expr_s, expand($2)), $2); } | METABKT exprs ']' { $$ = rlcp(cons(expr_s, - expand(cons(dwim_s, $2))), - $2); } + rlcp(expand(cons(dwim_s, $2)), + $2)), + $2); } | METAPAR ')' { $$ = rl(cons(expr_s, nil), num(lineno)); } - | METABKT ']' { $$ = rl(cons(expr_s, cons(dwim_s, nil)), - num(lineno)); } + | METABKT ']' { $$ = rl(cons(expr_s, rl(cons(dwim_s, nil), + num(lineno))), + num(lineno)); } | METAPAR error { $$ = nil; yybadtoken(yychar, lit("meta expression")); } ; -exprs : expr { $$ = cons($1, nil); } - | expr exprs { $$ = cons($1, $2); } - | expr '.' expr { $$ = cons($1, $3); } +exprs : expr { $$ = rlcp(cons($1, nil), $1); } + | expr exprs { $$ = rlcp(cons($1, $2), $1); } + | expr '.' expr { $$ = rlcp(cons($1, $3), $1); } ; exprs_opt : exprs { $$ = $1; } @@ -702,6 +704,8 @@ expr : IDENT { $$ = rl(intern(string_own($1), nil), | METAVAR { $$ = list(var_s, intern(string_own($1), nil), nao); rl($$, num(lineno)); } + | METANUM { $$ = cons(var_s, cons($1, nil)); + rl($$, num(lineno)); } | NUMBER { $$ = $1; } | list { $$ = $1; } | vector { $$ = $1; } @@ -1038,6 +1042,7 @@ void yybadtoken(int tok, val context) case IDENT: problem = lit("identifier"); break; case KEYWORD: problem = lit("keyword"); break; case METAVAR: problem = lit("metavar"); break; + case METANUM: problem = lit("metanum"); break; case ALL: problem = lit("\"all\""); break; case SOME: problem = lit("\"some\""); break; case NONE: problem = lit("\"none\""); break; @@ -3612,7 +3612,7 @@ as the final filter in a chain, it must produce a string. For instance, the following is a valid filter function: - @(define foo_to_bar (in out) + @(define foo_to_bar (in out)) @ (next :string in) @ (cases) foo @@ -3776,7 +3776,7 @@ take precedence. No warning is issued. The syntax of the filter directive is: - @(filter FILTER { VAR }+ } + @(filter FILTER { VAR }+ ) A filter is specified, followed by one or more variables whose values are filtered and stored back into each variable. @@ -4361,7 +4361,7 @@ in the quote stands for itself, except for the ,(+ 2 2) which is evaluated. The comma-star operator is used within a quoted list to denote a splicing unquote. Wheras the quote suppresses evaluation, the comma introduces an exception: the form which follows ,* must evaluate to a list. That list is spliced into -the quoted list. For example: '(a b c ,*(list (+ 3 3) (+ 4 4) d) evaluates +the quoted list. For example: '(a b c ,*(list (+ 3 3) (+ 4 4) d)) evaluates to (a b c 6 8 d). The expression (list (+ 3 3) (+ 4 4)) is evaluated to produce the list (6 8), and this list is spliced into the quoted template. @@ -4545,6 +4545,8 @@ Syntax: (lambda ({<sym>}*[. <sym>]) {<body-form>}*) + (lambda <sym> {<body-form>}*) + .TP Description: @@ -4555,7 +4557,7 @@ et cetera. The first argument of lambda is the list of parameters for the function. It may be empty, and it may also be an improper list (dot notation) where the -terminating atom is a symbol other than nil. +terminating atom is a symbol other than nil. It can also be a single symbol. The second and subsequent arguments are the forms making up the function body. The body may be empty. @@ -4565,7 +4567,8 @@ are visible to the body forms. The variables are initialized from the values of the argument expressions appearing in the function call. The dotted notation can be used to write a function that accepts -a variable number of arguments. +a variable number of arguments. To write a function that accepts +variable arguments only, with no required arguments, use a single symbol. Functions created by lambda capture the surrounding variable bindings. @@ -4585,6 +4588,75 @@ are aggregated into a list passed as the single parameter z: (lambda (x y . z) (list 'my-arguments-are x y z)) +Variadic funcion: + + (lambda args (list 'my-list-of-arguments args)) + +.SS Operator op + +.TP +Syntax: + + (op {<form>}+) + +.TP +Description: + +Like the lambda operator, the op operator creates an anonymous function. +The difference is that the arguments of the function are implicit, or +optionally specified within the function body. + +Also, the arguments of op are implicitly turned into a DWIM expression, +which means that argument evaluation follows Lisp-1 rules. (See the dwim +operator below). + +The argument forms are arbitrary expressions, within which a special +convention is permitted: + +.IP @<num> + +A number preceded by a @ is a metanumber. This is a special syntax +which denotes an argument. For instance @2 means that the second argument of +the anonymous function is to be substituted in place of the @2. If @2 is used +it means that @1 also has to appear somewhere, otherwise the op +construct is erroneous. + +.IP @rest + +The meta-symbol @rest indicates that any trailing arguments to the +function are to be inserted. If the @<num> syntax is not used anywhere, +it means that the function only has trailing arguments. If @1 is used, +it means that the second and subsequent arguments are trailing arguments. +If @rest is not used anywhere, then the rest arguments are automatically +applied to the op form. If @rest appears, then this is suppressed. + +The actions of form may be understood by these examples, which show +how op is rewritten to lambda. However, note that the real translator +uses generated symbols for the arguments, which are not equal to any +symbols in the program. + + (op) -> invalid + + ;; n-ary function that turns all its arguments into a list + + (op +) -> (lambda rest [+ . rest]) + + (op @1 @2) -> (lambda (arg1 arg2 . rest) [arg1 arg2 . rest]) + + (op foo @1 (@2) (bar @3)) -> (lambda (arg1 arg2 arg3 . rest) + [foo arg1 (arg2) (bar arg3) . rest]) + + (op foo @rest @1) -> (lambda (arg1 . rest) [foo rest arg1]) + +.TP + +Examples: + + ;; Take a list of pairs and produce a list in which those pairs + ;; are reversed. + + (mapcar (op list @2 @1) '((1 2) (a b))) -> ((2 1) (b a)) + .SS Operator call .TP @@ -26,7 +26,7 @@ syn keyword txr_keyword contained define try catch finally throw syn keyword txr_keyword contained defex throw deffilter filter eof eol do syn keyword txl_keyword contained progn prog1 let syn let* lambda call fun -syn keyword txl_keyword contained cond if and or dwim +syn keyword txl_keyword contained cond if and or dwim op syn keyword txl_keyword contained defvar defun inc dec set push pop flip syn keyword txl_keyword contained for for* dohash unwind-protect block syn keyword txl_keyword contained return return-from gen delay |