From 3d9e60cb8ba2a9698336ae4697f59e14282a673d Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Fri, 27 May 2016 06:47:50 -0700
Subject: Fix 2011-11-17 regression.

This addresses a regression caused by commit
68ca87bc780e25dea1418019161d99727225d1ce, affecting a hundred
releases of TXR from 42 to 141.

The copy_alist call to deeply clone the variable bindings was
carelessly replaced with copy_list, to address the problem
that functions weren't able to mutate outer bindings.

However, the parameter binding code depends on the deep
cloning; it destructively manipulates bindings with the
understanding that they are copies that will be thrown away.

Test case:

@(define f0 (var))
@(end)
@(define f1 (out1 out2 var))
@  (bind out1 `a:@var`)
@  (maybe)
@    (f0 `b:@var`)
@  (end)
@  (bind out2 `a:@var`)
@(end)
@(f1 o1 o2 "z")

This program incorrectly binds o1 and o2 to different
strings, "a:z" and "a:b:z" respectively, because
the f0 pattern function call has the unwanted effect of
mutating var. Expected behavior is that both o1 and
o2 are bound to identical strings, "a:z" and "a:z".

* match.c (h_fun, v_fun): When binding arguments, extend
the environment with new bindings instead of trying to
re-use existing ones, because we do not have a copy of the
binding cells, like we used to when bindings_cp was
produced by a copy_alist call.
---
 match.c | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/match.c b/match.c
index f3b05abe..dcadde0b 100644
--- a/match.c
+++ b/match.c
@@ -1139,14 +1139,14 @@ static val h_fun(match_line_ctx *c)
       if (arg && bindable(arg)) {
         val val = tx_lookup_var(arg, c->bindings);
         if (val) {
-          bindings_cp = acons_new(param, cdr(val), bindings_cp);
+          bindings_cp = cons(cons(param, cdr(val)), bindings_cp);
         } else {
           bindings_cp = alist_nremove1(bindings_cp, param);
           ub_p_a_pairs = cons(cons(param, arg), ub_p_a_pairs);
         }
       } else {
         val val = txeval(elem, arg, c->bindings);
-        bindings_cp = acons_new(param, val, bindings_cp);
+        bindings_cp = cons(cons(param, val), bindings_cp);
       }
     }
 
@@ -3608,14 +3608,14 @@ static val v_fun(match_files_ctx *c)
       if (bindable(arg)) {
         val val = tx_lookup_var(arg, c->bindings);
         if (val) {
-          bindings_cp = acons_new(param, cdr(val), bindings_cp);
+          bindings_cp = cons(cons(param, cdr(val)), bindings_cp);
         } else {
           bindings_cp = alist_nremove1(bindings_cp, param);
           ub_p_a_pairs = cons(cons(param, arg), ub_p_a_pairs);
         }
       } else {
         val val = txeval(specline, arg, c->bindings);
-        bindings_cp = acons_new(param, val, bindings_cp);
+        bindings_cp = cons(cons(param, val), bindings_cp);
       }
     }
 
-- 
cgit v1.2.3