Added $set-symbol-proc!

This commit is contained in:
Abdulaziz Ghuloum 2007-08-28 23:49:50 -04:00
parent f83af98967
commit 1ca0e11fb3
4 changed files with 9 additions and 6 deletions

Binary file not shown.

View File

@ -2272,7 +2272,7 @@
macro*))))
(define (library-expander x)
(let-values ([(name imp* inv* vis* invoke-code macro* export-subst export-env)
(core-library-expander x)])
(core-library-expander x)])
(let ([id (gensym)]
[name name]
[ver '()] ;;; FIXME
@ -2295,7 +2295,8 @@
(define build-export
(lambda (x)
;;; exports use the same gensym
`(#%$set-symbol-value! ',x ,x)))
`(begin
(#%$set-symbol-value! ',x ,x))))
(define (make-export-subst int* ext* rib)
(map
(lambda (int ext)

View File

@ -696,6 +696,7 @@
[$symbol-string $symbols]
[$symbol-plist $symbols]
[$set-symbol-value! $symbols]
[$set-symbol-proc! $symbols]
[$set-symbol-string! $symbols]
[$set-symbol-unique-string! $symbols]
[$set-symbol-plist! $symbols]

View File

@ -452,10 +452,6 @@
(prm 'mset x (K (- disp-symbol-record-value symbol-ptag)) (K unbound))
(prm 'mset x (K (- disp-symbol-record-proc symbol-ptag)) (K unbound))
(prm 'mset x (K (- disp-symbol-record-plist symbol-ptag)) (K nil))
;(prm 'mset x (K (- disp-symbol-system-value symbol-tag)) (K unbound))
;(prm 'mset x (K (- disp-symbol-function symbol-ptag)) (K 0))
;(prm 'mset x (K (- disp-symbol-error-function symbol-ptag)) (K 0))
;(prm 'mset x (K (- disp-symbol-unused symbol-tag)) (K 0))
x)]
[(P str) (K #t)]
[(E str) (nop)])
@ -491,6 +487,11 @@
(prm 'mset x (K (- disp-symbol-record-value symbol-ptag)) (T v))
(dirty-vector-set x))])
(define-primop $set-symbol-proc! unsafe
[(E x v)
(with-tmp ([x (T x)])
(prm 'mset x (K (- disp-symbol-record-proc symbol-ptag)) (T v))
(dirty-vector-set x))])
(define-primop top-level-value safe
[(V x)