The Lambda Lab
/
projects
/
scheme.forth.jl.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Fixed bug in set-var.
[scheme.forth.jl.git]
/
src
/
scheme.4th
diff --git
a/src/scheme.4th
b/src/scheme.4th
index
bf3301d
..
cf3ddc5
100644
(file)
--- a/
src/scheme.4th
+++ b/
src/scheme.4th
@@
-458,7
+458,7
@@
variable read-line-buffer-offset
nil? false =
while
2over 2over first-frame
nil? false =
while
2over 2over first-frame
- get-va
rs-va
ls-frame nil? false = if
+ get-vals-frame nil? false = if
2swap 2drop 2swap 2drop
exit
then
2swap 2drop 2swap 2drop
exit
then
@@
-475,7
+475,7
@@
objvar var \ Used only for error messages
: lookup-var ( var env -- val )
2over var obj!
: lookup-var ( var env -- val )
2over var obj!
- get-va
rs-va
ls nil? if
+ get-vals nil? if
except-message: ." tried to read unbound variable '" var obj@ print ." '."
recoverable-exception throw
then
except-message: ." tried to read unbound variable '" var obj@ print ." '."
recoverable-exception throw
then
@@
-485,7
+485,8
@@
objvar var \ Used only for error messages
: set-var ( var val env -- )
2rot 2dup var obj! ( val env var )
: set-var ( var val env -- )
2rot 2dup var obj! ( val env var )
- get-vars-vals nil? if
+ 2swap ( val var env )
+ get-vals nil? if
except-message: ." tried to set unbound variable '" var obj@ print ." '."
recoverable-exception throw
else
except-message: ." tried to set unbound variable '" var obj@ print ." '."
recoverable-exception throw
else
@@
-497,15
+498,16
@@
hide var
: define-var ( var val env -- )
first-frame ( var val frame )
: define-var ( var val env -- )
first-frame ( var val frame )
- 2rot 2
over 2over ( val frame var frame var
)
+ 2rot 2
swap 2over 2over ( val var frame var frame
)
get-vals-frame nil? if
get-vals-frame nil? if
- 2drop ( val frame var )
- 2swap add-binding
+ 2drop
+ -2rot 2swap 2rot
+ add-binding
else
else
- ( val
frame var
vals )
+ ( val
var frame
vals )
2swap 2drop 2swap 2drop
2swap 2drop 2swap 2drop
- cons
+ set-car!
then
;
then
;
@@
-1933,6
+1935,7
@@
parse-idx-stack parse-idx-sp !
except-message: ." tried to print object with unknown type." recoverable-exception throw
; is print
except-message: ." tried to print object with unknown type." recoverable-exception throw
; is print
+xxxx
\ }}}
\ ---- Garbage Collection ---- {{{
\ }}}
\ ---- Garbage Collection ---- {{{