compiler: disallow duplicate symbols in same env.

We want to diagnose (let (a a)) and (lambda (a a)), as well as
the analogous situations for function bindings. This is
certainly ambiguous: if the code accesses a, which one was
intended? The choice is undocumented and so this is a
likely programming error; nobody will write code this
deliberately, investigate what the implementation actually
does, and then rely on that.

However, multiple bindings of special variables are allowed.

Duplicates are also allowed in sequential binding.

Handling duplicates in let* binding creates the following
problem: (a a) means that a should be initialized from the
previous a. We would like to compile the init form in the
environment in which the second a doesn't exist, yet indicate
the destination location of the new a. Since we are clobbering
one environment as we go by adding bindings to it, this is not
possible. The solution is a rename hack: we introduce the new
a as a gensym, so that it is invisible.  We indicate the
gensym's location as the destination register for the
init-form code fragment. Then immediately after compiling the
init-form, we rename the gensym variable.

* share/txr/stdlib/compiler.tl (sys:env extend-var, sys:env
extend-fun): Diagnose duplicates.
(sys:env rename-var): New methods.

* share/txr/stdlib/compiler.tl (compile comp-let): Bind to a
gensym instead of the real symbol when binding sequentially.
Then rename the symbol.

1 files changed, 16 insertions, 3 deletions

diff --git a/share/txr/stdlib/compiler.tl b/share/txr/stdlib/compiler.tl
index 5fc71dfc..b5e3d645 100644
--- a/share/txr/stdlib/compiler.tl
+++ b/share/txr/stdlib/compiler.tl
@@ -65,14 +65,24 @@
       (t nil)))
 
   (:method extend-var (me sym)
+    (when (assoc sym me.vb)
+      (compile-error me.co.last-form "duplicate variable: ~s" sym))
     (let* ((loc ^(v ,(ppred me.lev) ,(pinc me.v-cntr)))
            (bn (new binding sym sym loc loc env me)))
       (set me.vb (acons-new sym bn me.vb))))
 
   (:method extend-fun (me sym)
+    (when (assoc sym me.fb)
+      (compile-error me.co.last-form "duplicate function ~s" sym))
     (let* ((loc ^(v ,me.lev ,(pinc me.v-cntr)))
            (bn (new binding sym sym loc loc env me)))
-      (set me.fb (acons-new sym bn me.fb))))
+      (set me.fb (acons sym bn me.fb))))
+
+  (:method rename-var (me from-sym to-sym)
+    (iflet ((cell (assoc from-sym me.vb)))
+      (rplaca cell to-sym)
+      (let ((bn (cdr cell)))
+        (set bn.sym to-sym))))
 
   (:method out-of-scope (me reg)
     (if (eq (car reg) 'v)
@@ -338,10 +348,13 @@
                               (set ffuns (uni ffuns frag.ffuns)
                                    fvars (uni fvars frag.fvars))))
                            (form
-                             (let* ((bind (progn
-                                            (if seq nenv.(extend-var sym))
+                             (let* ((tmp (if seq (gensym)))
+                                    (bind (if seq
+                                            (cdar nenv.(extend-var tmp))
                                             nenv.(lookup-var sym)))
                                     (frag me.(compile bind.loc fenv form)))
+                               (when seq
+                                 fenv.(rename-var tmp sym))
                                (pend frag.code
                                      (maybe-mov bind.loc frag.oreg))
                                (set ffuns (uni ffuns frag.ffuns)