diff options
| -rw-r--r-- | ChangeLog | 12 | ||||
| -rw-r--r-- | lib.c | 3 | ||||
| -rw-r--r-- | lib.h | 2 | ||||
| -rw-r--r-- | match.c | 17 | ||||
| -rw-r--r-- | txr.1 | 40 |
5 files changed, 69 insertions, 5 deletions
@@ -1,5 +1,17 @@ 2012-03-24 Kaz Kylheku <kaz@kylheku.com> + * lib.c (rebind_s): New symbol variable. + + * lib.h (rebind_s): Declared. + + * match.c (v_rebind): New static function. + (dir_tables_init): Registered rebind_s to v_rebind, + and also to hv_trampoline in the horizontal directive table. + + * txr.1: Documented it. + +2012-03-24 Kaz Kylheku <kaz@kylheku.com> + Bug #35989 * match.c (syms_init): text_s must be in the system @@ -71,7 +71,7 @@ val skip_s, trailer_s, block_s, next_s, freeform_s, fail_s, accept_s; val all_s, some_s, none_s, maybe_s, cases_s, collect_s, until_s, coll_s; val define_s, output_s, single_s, first_s, last_s, empty_s; val repeat_s, rep_s, flatten_s, forget_s; -val local_s, merge_s, bind_s, cat_s; +val local_s, merge_s, bind_s, rebind_s, cat_s; val try_s, catch_s, finally_s, throw_s, defex_s, deffilter_s; val eof_s, eol_s; val error_s, type_error_s, internal_error_s; @@ -4093,6 +4093,7 @@ static void obj_init(void) local_s = intern(lit("local"), user_package); merge_s = intern(lit("merge"), user_package); bind_s = intern(lit("bind"), user_package); + rebind_s = intern(lit("rebind"), user_package); cat_s = intern(lit("cat"), user_package); try_s = intern(lit("try"), user_package); catch_s = intern(lit("catch"), user_package); @@ -298,7 +298,7 @@ extern val skip_s, trailer_s, block_s, next_s, freeform_s, fail_s, accept_s; extern val all_s, some_s, none_s, maybe_s, cases_s, collect_s, until_s, coll_s; extern val define_s, output_s, single_s, first_s, last_s, empty_s; extern val repeat_s, rep_s, flatten_s, forget_s; -extern val local_s, merge_s, bind_s, cat_s; +extern val local_s, merge_s, bind_s, rebind_s, cat_s; extern val try_s, catch_s, finally_s, throw_s, defex_s, deffilter_s; extern val eof_s, eol_s; extern val error_s, type_error_s, internal_error_s; @@ -2920,6 +2920,21 @@ static val v_set(match_files_ctx *c) return next_spec_k; } +static val v_rebind(match_files_ctx *c) +{ + spec_bind (specline, first_spec, c->spec); + val args = rest(first_spec); + val pattern = first(args); + val form = second(args); + val val = txeval(specline, form, c->bindings); + + c->bindings = alist_remove(c->bindings, args); + c->bindings = dest_bind(specline, c->bindings, + pattern, val, equal_f); + + return next_spec_k; +} + static val v_cat(match_files_ctx *c) { spec_bind (specline, first_spec, c->spec); @@ -3735,6 +3750,7 @@ static void dir_tables_init(void) sethash(v_directive_table, local_s, cptr((mem_t *) v_forget_local)); sethash(v_directive_table, merge_s, cptr((mem_t *) v_merge)); sethash(v_directive_table, bind_s, cptr((mem_t *) v_bind)); + sethash(v_directive_table, rebind_s, cptr((mem_t *) v_rebind)); sethash(v_directive_table, set_s, cptr((mem_t *) v_set)); sethash(v_directive_table, cat_s, cptr((mem_t *) v_cat)); sethash(v_directive_table, output_s, cptr((mem_t *) v_output)); @@ -3757,6 +3773,7 @@ static void dir_tables_init(void) sethash(h_directive_table, local_s, cptr((mem_t *) hv_trampoline)); sethash(h_directive_table, merge_s, cptr((mem_t *) hv_trampoline)); sethash(h_directive_table, bind_s, cptr((mem_t *) hv_trampoline)); + sethash(h_directive_table, rebind_s, cptr((mem_t *) hv_trampoline)); sethash(h_directive_table, set_s, cptr((mem_t *) hv_trampoline)); sethash(h_directive_table, cat_s, cptr((mem_t *) hv_trampoline)); sethash(h_directive_table, filter_s, cptr((mem_t *) hv_trampoline)); @@ -1297,15 +1297,20 @@ constituent strings, with an optional separator string between all of the values. .IP @(bind) -Binds one or more variables against another variable using a structural -pattern. A limited form of unification takes place which can cause a match to -fail. +Binds one or more variables against a value using a structural +pattern match. A limited form of unification takes place which can cause a +match to fail. .IP @(set) Destructively assigns one or more existing variables using a structural pattern, using syntax similar to bind. Assignment to unbound variables triggers an error. +.IP @(rebind) +Evaluates an expression in the current binding environment, and +then creates new bindings for the variables in the structural pattern. +Useful for temporarily overriding variable values in a scope. + .IP @(output) A directive which encloses an output clause in the query. An output section does not match text, but produces text. The directives above are not @@ -2718,6 +2723,35 @@ Destructuring assignment. D assumed to contain the list A ends up with "A", B ends up with ("B1" "B2") and C gets ("C1" and "C2"). +.SS The Rebind Directive + +The @(rebind) directive resembles @(set) but it is not an assignment. +It combines the semanticss of @(local), @(bind) and @(set). +The expression on the right hand side is evaluated in the current +environment. Then the variables in the pattern on the left are introduced +as new bindings, whose values come from the pattern. + +Rebind makes it easy to create temporary bindings based on existing +bindings. + + @(define pattern-function (arg)) + @;; inside a pattern function: + @(rebind recursion-level @(+ recursion-level 1)) + @;; ... + @(end) + +When the function terminates, the previous value of recursion-level +is restored. The effect is like the following, but much easier +to write and faster to execute: + + @(define pattern-function (arg)) + @;; inside a pattern function: + @(local temp) + @(set temp recursion-level) + @(local recursion-level) + @(set recursion-level @(+ temp 1)) + @;; ... + @(end) .SH BLOCKS |