Commit a24d792f authored by ram's avatar ram
Browse files

Changed LET* and &AUX to allow duplicate variable names.

parent 793f4080
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir1tran.lisp,v 1.63 1991/12/19 22:10:44 ram Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir1tran.lisp,v 1.64 1992/02/07 14:42:57 ram Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -657,7 +657,7 @@ ...@@ -657,7 +657,7 @@
(dolist (spec aux) (dolist (spec aux)
(cond ((atom spec) (cond ((atom spec)
(let ((var (varify-lambda-arg spec (names-so-far)))) (let ((var (varify-lambda-arg spec nil)))
(aux-vars var) (aux-vars var)
(aux-vals nil) (aux-vals nil)
(names-so-far spec))) (names-so-far spec)))
...@@ -666,7 +666,7 @@ ...@@ -666,7 +666,7 @@
(compiler-error "Malformed &aux binding specifier: ~S." (compiler-error "Malformed &aux binding specifier: ~S."
spec)) spec))
(let* ((name (first spec)) (let* ((name (first spec))
(var (varify-lambda-arg name (names-so-far)))) (var (varify-lambda-arg name nil)))
(aux-vars var) (aux-vars var)
(aux-vals (second spec)) (aux-vals (second spec))
(names-so-far name))))) (names-so-far name)))))
...@@ -677,18 +677,23 @@ ...@@ -677,18 +677,23 @@
;;; Find-In-Bindings -- Internal ;;; Find-In-Bindings -- Internal
;;; ;;;
;;; Given a list of Lambda-Var structures and a variable name, return the ;;; Given a list of Lambda-Var structures and a variable name, return the
;;; structure for that name, or NIL if it isn't found. ;;; structure for that name, or NIL if it isn't found. We return the *last*
;;; variable with that name, since let* bindings may be duplicated, and
;;; declarations always apply to the last.
;;; ;;;
(proclaim '(function find-in-bindings (list symbol) (or lambda-var null))) (proclaim '(function find-in-bindings (list symbol) (or lambda-var null)))
(defun find-in-bindings (vars name) (defun find-in-bindings (vars name)
(dolist (var vars) (let ((found nil))
(when (eq (leaf-name var) name) (return var)) (dolist (var vars)
(let ((info (lambda-var-arg-info var))) (when (eq (leaf-name var) name)
(when info (setq found var))
(let ((supplied-p (arg-info-supplied-p info))) (let ((info (lambda-var-arg-info var)))
(when (and supplied-p (when info
(eq (leaf-name supplied-p) name)) (let ((supplied-p (arg-info-supplied-p info)))
(return supplied-p))))))) (when (and supplied-p
(eq (leaf-name supplied-p) name))
(setq found supplied-p))))))
found))
;;; Find-Lexically-Apparent-Function -- Internal ;;; Find-Lexically-Apparent-Function -- Internal
...@@ -2688,20 +2693,26 @@ ...@@ -2688,20 +2693,26 @@
(collect ((vars) (collect ((vars)
(vals) (vals)
(names)) (names))
(dolist (spec bindings) (flet ((get-var (name)
(cond ((atom spec) (varify-lambda-arg name
(let ((var (varify-lambda-arg spec (names)))) (if (eq context 'let*)
(vars var) nil
(names (cons spec var)) (names)))))
(vals nil))) (dolist (spec bindings)
(t (cond ((atom spec)
(unless (<= 1 (length spec) 2) (let ((var (get-var spec)))
(compiler-error "Malformed ~S binding spec: ~S." context spec)) (vars var)
(let* ((name (first spec)) (names (cons spec var))
(var (varify-lambda-arg name (names)))) (vals nil)))
(vars var) (t
(names name) (unless (<= 1 (length spec) 2)
(vals (second spec)))))) (compiler-error "Malformed ~S binding spec: ~S."
context spec))
(let* ((name (first spec))
(var (get-var name)))
(vars var)
(names name)
(vals (second spec)))))))
(values (vars) (vals) (names)))) (values (vars) (vals) (names))))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment