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

* added symbol-bound?, symbol-value, and set-symbol-value! to the 

symbols library.
This commit is contained in:
Abdulaziz Ghuloum 2007-05-06 18:18:53 -04:00
parent 0d03979d60
commit aebad6ece7
3 changed files with 28 additions and 2 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.

27
src/ikarus.symbols.ss
View File

@ -3,7 +3,8 @@
(export gensym gensym? gensym->unique-string gensym-prefix (export gensym gensym? gensym->unique-string gensym-prefix
gensym-count print-gensym string->symbol symbol->string gensym-count print-gensym string->symbol symbol->string
getprop putprop remprop property-list getprop putprop remprop property-list
top-level-value top-level-bound? set-top-level-value!) top-level-value top-level-bound? set-top-level-value!
symbol-value symbol-bound? set-symbol-value!)
(import (import
(only (scheme) $make-symbol $symbol-string $set-symbol-string! (only (scheme) $make-symbol $symbol-string $set-symbol-string!
$symbol-unique-string $set-symbol-unique-string! $symbol-unique-string $set-symbol-unique-string!
@ -14,7 +15,8 @@
gensym-prefix gensym-count print-gensym gensym-prefix gensym-count print-gensym
string->symbol symbol->string string->symbol symbol->string
getprop putprop remprop property-list getprop putprop remprop property-list
top-level-value top-level-bound? set-top-level-value!)) top-level-value top-level-bound? set-top-level-value!
symbol-value symbol-bound? set-symbol-value!))
(define gensym (define gensym
(case-lambda (case-lambda
@ -53,6 +55,27 @@
(error 'set-top-level-value! "~s is not a symbol" x)) (error 'set-top-level-value! "~s is not a symbol" x))
($set-symbol-value! x v))) ($set-symbol-value! x v)))
(define symbol-value
(lambda (x)
(unless (symbol? x)
(error 'symbol-value "~s is not a symbol" x))
(let ([v ($symbol-value x)])
(when ($unbound-object? v)
(error 'symbol-value "unbound ~s" x))
v)))
(define symbol-bound?
(lambda (x)
(unless (symbol? x)
(error 'symbol-bound? "~s is not a symbol" x))
(not ($unbound-object? ($symbol-value x)))))
(define set-symbol-value!
(lambda (x v)
(unless (symbol? x)
(error 'set-symbol-value! "~s is not a symbol" x))
($set-symbol-value! x v)))
(define string->symbol (define string->symbol
(lambda (x) (lambda (x)
(unless (string? x) (unless (string? x)

3
src/makefile.ss
View File

@ -298,6 +298,9 @@
[string->symbol s i] [string->symbol s i]
[symbol->string s i] [symbol->string s i]
[gensym->unique-string s i] [gensym->unique-string s i]
[symbol-bound? s i]
[symbol-value s i]
[set-symbol-value! s i]
[top-level-bound? s ] [top-level-bound? s ]
[top-level-value s ] [top-level-value s ]
[set-top-level-value! s ] [set-top-level-value! s ]