Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
cmucl
cmucl
Commits
a24d792f
Commit
a24d792f
authored
Feb 07, 1992
by
ram
Browse files
Changed LET* and &AUX to allow duplicate variable names.
parent
793f4080
Changes
1
Hide whitespace changes
Inline
Side-by-side
compiler/ir1tran.lisp
View file @
a24d792f
...
@@ -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.6
3
199
1/12/19 22:10:44
ram Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir1tran.lisp,v 1.6
4
199
2/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
))))
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment