diff --git a/scheme/ikarus.symbol-table.ss b/scheme/ikarus.symbol-table.ss index 9d9466e..2c46cdb 100644 --- a/scheme/ikarus.symbol-table.ss +++ b/scheme/ikarus.symbol-table.ss @@ -1,9 +1,9 @@ (library (ikarus.symbol-table) - (export string->symbol initialize-symbol-table!) + (export string->symbol initialize-symbol-table! $symbol-table-size) (import (except (ikarus) string->symbol) - (ikarus system $symbols)) + (except (ikarus system $symbols) $symbol-table-size)) (define-struct symbol-table (length mask vec guardian)) @@ -91,8 +91,10 @@ (chain-lookup str idx st (vector-ref v idx))))) - (module (string->symbol initialize-symbol-table!) + (module (string->symbol initialize-symbol-table! $symbol-table-size) (define st (make-symbol-table 0 3 (make-vector 4 '()) (make-guardian))) + (define ($symbol-table-size) + (symbol-table-length st)) (define (string->symbol x) (if (string? x) (lookup x (string-hash x) st) diff --git a/scheme/last-revision b/scheme/last-revision index 058fbb1..589edfd 100644 --- a/scheme/last-revision +++ b/scheme/last-revision @@ -1 +1 @@ -1713 +1714 diff --git a/scheme/makefile.ss b/scheme/makefile.ss index 2c55e3f..b030910 100755 --- a/scheme/makefile.ss +++ b/scheme/makefile.ss @@ -524,6 +524,7 @@ [$set-symbol-unique-string! $symbols] [$set-symbol-plist! $symbols] [$unintern-gensym $symbols] + [$symbol-table-size $symbols] [$init-symbol-value! ] [$unbound-object? $symbols] ;;; diff --git a/scheme/run-tests.ss b/scheme/run-tests.ss index 244fe74..f5e2775 100755 --- a/scheme/run-tests.ss +++ b/scheme/run-tests.ss @@ -22,7 +22,8 @@ lists strings bytevectors hashtables fixnums bignums numerics bitwise enums pointers sorting io fasl reader case-folding parse-flonums string-to-number bignum-to-flonum div-and-mod - fldiv-and-mod unicode normalization repl set-position guardians)) + fldiv-and-mod unicode normalization repl set-position guardians + symbol-table)) (define (run-test-from-library x) (printf "[testing ~a] ..." x) diff --git a/scheme/tests/symbol-table.ss b/scheme/tests/symbol-table.ss new file mode 100644 index 0000000..2562421 --- /dev/null +++ b/scheme/tests/symbol-table.ss @@ -0,0 +1,19 @@ + +(library (tests symbol-table) + (export run-tests) + (import + (ikarus) + (only (ikarus system $symbols) $symbol-table-size)) + + (define (test-gcable-symbols n) + (let ([st1 ($symbol-table-size)]) + (do ((i 0 (+ i 1))) + ((= i n)) + (string->symbol (number->string i))) + (collect) + (let ([st2 ($symbol-table-size)]) + (assert (< (- st2 st1) n))))) + + (define (run-tests) + (test-gcable-symbols 1000000))) +