conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
src/ikarus.boot
View File

Binary file not shown.

5
src/ikarus.syntax.ss
View File

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

1
src/makefile.ss
View File

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

9
src/pass-specify-rep-primops.ss
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-value symbol-ptag)) (K unbound))
(prm 'mset x (K (- disp-symbol-record-proc 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-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)] x)]
[(P str) (K #t)] [(P str) (K #t)]
[(E str) (nop)]) [(E str) (nop)])
@ -491,6 +487,11 @@
(prm 'mset x (K (- disp-symbol-record-value symbol-ptag)) (T v)) (prm 'mset x (K (- disp-symbol-record-value symbol-ptag)) (T v))
(dirty-vector-set x))]) (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 (define-primop top-level-value safe
[(V x) [(V x)