* moved symbol->string to ikarus.symbols
This commit is contained in:
parent
4a0db4a117
commit
86320acbdf
BIN
src/ikarus.boot
BIN
src/ikarus.boot
Binary file not shown.
|
@ -77,17 +77,6 @@
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(primitive-set! 'symbol->string
|
|
||||||
(lambda (x)
|
|
||||||
(unless (symbol? x)
|
|
||||||
(error 'symbol->string "~s is not a symbol" x))
|
|
||||||
(let ([str ($symbol-string x)])
|
|
||||||
(or str
|
|
||||||
(let ([ct (gensym-count)])
|
|
||||||
(let ([str (string-append (gensym-prefix) (fixnum->string ct))])
|
|
||||||
($set-symbol-string! x str)
|
|
||||||
(gensym-count ($fxadd1 ct))
|
|
||||||
str))))))
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -1,17 +1,18 @@
|
||||||
|
|
||||||
(library (ikarus symbols)
|
(library (ikarus symbols)
|
||||||
(export gensym gensym? gensym->unique-string gensym-prefix
|
(export gensym gensym? gensym->unique-string gensym-prefix
|
||||||
gensym-count print-gensym string->symbol
|
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!)
|
||||||
(import
|
(import
|
||||||
(only (scheme) $make-symbol $symbol-string $symbol-unique-string
|
(only (scheme) $make-symbol $symbol-string $set-symbol-string!
|
||||||
$set-symbol-unique-string! $symbol-value $set-symbol-value!
|
$symbol-unique-string $set-symbol-unique-string!
|
||||||
|
$symbol-value $set-symbol-value!
|
||||||
$set-symbol-plist! $symbol-plist
|
$set-symbol-plist! $symbol-plist
|
||||||
$car $cdr $fx>= $set-cdr! $unbound-object?)
|
$car $cdr $fx>= $fxadd1 $set-cdr! $unbound-object?)
|
||||||
(except (ikarus) gensym gensym? gensym->unique-string
|
(except (ikarus) gensym gensym? gensym->unique-string
|
||||||
gensym-prefix gensym-count print-gensym
|
gensym-prefix gensym-count print-gensym
|
||||||
string->symbol
|
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!))
|
||||||
|
|
||||||
|
@ -58,6 +59,18 @@
|
||||||
(error 'string->symbol "~s is not a string" x))
|
(error 'string->symbol "~s is not a string" x))
|
||||||
(foreign-call "ikrt_string_to_symbol" x)))
|
(foreign-call "ikrt_string_to_symbol" x)))
|
||||||
|
|
||||||
|
(define symbol->string
|
||||||
|
(lambda (x)
|
||||||
|
(unless (symbol? x)
|
||||||
|
(error 'symbol->string "~s is not a symbol" x))
|
||||||
|
(let ([str ($symbol-string x)])
|
||||||
|
(or str
|
||||||
|
(let ([ct (gensym-count)])
|
||||||
|
;;; FIXME: what if gensym-count is a bignum?
|
||||||
|
(let ([str (string-append (gensym-prefix) (fixnum->string ct))])
|
||||||
|
($set-symbol-string! x str)
|
||||||
|
(gensym-count ($fxadd1 ct))
|
||||||
|
str))))))
|
||||||
|
|
||||||
(define putprop
|
(define putprop
|
||||||
(lambda (x k v)
|
(lambda (x k v)
|
||||||
|
|
Loading…
Reference in New Issue