unused (garbage) symbols can be reclaimed now
This commit is contained in:
Abdulaziz Ghuloum
parent
b037b1b671
commit
f7d1d6b6a3
|
|
@ -28,7 +28,8 @@ EXTRA_DIST=ikarus.boot.4.prebuilt ikarus.boot.8.prebuilt \
|
||||||
ikarus.io.ss ikarus.time-and-date.ss ikarus.not-yet-implemented.ss \
|
ikarus.io.ss ikarus.time-and-date.ss ikarus.not-yet-implemented.ss \
|
||||||
ikarus.string-to-number.ss ikarus.compiler.source-optimizer.ss \
|
ikarus.string-to-number.ss ikarus.compiler.source-optimizer.ss \
|
||||||
ikarus.compiler.tag-annotation-analysis.ss ikarus.ontology.ss \
|
ikarus.compiler.tag-annotation-analysis.ss ikarus.ontology.ss \
|
||||||
ikarus.reader.annotated.ss ikarus.pointers.ss ikarus.equal.ss
|
ikarus.reader.annotated.ss ikarus.pointers.ss ikarus.equal.ss \
|
||||||
|
ikarus.symbol-table.ss
|
||||||
|
|
||||||
all: $(nodist_pkglib_DATA)
|
all: $(nodist_pkglib_DATA)
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -183,7 +183,8 @@ EXTRA_DIST = ikarus.boot.4.prebuilt ikarus.boot.8.prebuilt \
|
||||||
ikarus.io.ss ikarus.time-and-date.ss ikarus.not-yet-implemented.ss \
|
ikarus.io.ss ikarus.time-and-date.ss ikarus.not-yet-implemented.ss \
|
||||||
ikarus.string-to-number.ss ikarus.compiler.source-optimizer.ss \
|
ikarus.string-to-number.ss ikarus.compiler.source-optimizer.ss \
|
||||||
ikarus.compiler.tag-annotation-analysis.ss ikarus.ontology.ss \
|
ikarus.compiler.tag-annotation-analysis.ss ikarus.ontology.ss \
|
||||||
ikarus.reader.annotated.ss ikarus.pointers.ss ikarus.equal.ss
|
ikarus.reader.annotated.ss ikarus.pointers.ss ikarus.equal.ss \
|
||||||
|
ikarus.symbol-table.ss
|
||||||
|
|
||||||
revno = "$(shell sed 's/ .*//' ../.bzr/branch/last-revision 2>/dev/null)"
|
revno = "$(shell sed 's/ .*//' ../.bzr/branch/last-revision 2>/dev/null)"
|
||||||
sizeofvoidp = $(shell grep SIZEOF_VOID_P ../config.h | sed "s/.*\(.\)/\1/g")
|
sizeofvoidp = $(shell grep SIZEOF_VOID_P ../config.h | sed "s/.*\(.\)/\1/g")
|
||||||
|
|
|
||||||
|
|
@ -32,7 +32,7 @@
|
||||||
close-port port-closed? close-input-port close-output-port
|
close-port port-closed? close-input-port close-output-port
|
||||||
port-eof?
|
port-eof?
|
||||||
get-char lookahead-char read-char peek-char
|
get-char lookahead-char read-char peek-char
|
||||||
get-string-n get-string-n! get-string-all get-line
|
get-string-n get-string-n! get-string-all get-line read-line
|
||||||
get-u8 lookahead-u8
|
get-u8 lookahead-u8
|
||||||
get-bytevector-n get-bytevector-n!
|
get-bytevector-n get-bytevector-n!
|
||||||
get-bytevector-some get-bytevector-all
|
get-bytevector-some get-bytevector-all
|
||||||
|
|
@ -92,7 +92,7 @@
|
||||||
close-port port-closed? close-input-port close-output-port
|
close-port port-closed? close-input-port close-output-port
|
||||||
port-eof?
|
port-eof?
|
||||||
get-char lookahead-char read-char peek-char
|
get-char lookahead-char read-char peek-char
|
||||||
get-string-n get-string-n! get-string-all get-line
|
get-string-n get-string-n! get-string-all get-line read-line
|
||||||
get-u8 lookahead-u8
|
get-u8 lookahead-u8
|
||||||
get-bytevector-n get-bytevector-n!
|
get-bytevector-n get-bytevector-n!
|
||||||
get-bytevector-some get-bytevector-all
|
get-bytevector-some get-bytevector-all
|
||||||
|
|
@ -1918,7 +1918,7 @@
|
||||||
[($fx= c 0) 0]
|
[($fx= c 0) 0]
|
||||||
[else (die 'get-string-n! "count is negative" c)])))
|
[else (die 'get-string-n! "count is negative" c)])))
|
||||||
|
|
||||||
(define (get-line p)
|
(define ($get-line p who)
|
||||||
(import UNSAFE)
|
(import UNSAFE)
|
||||||
(define (get-it p)
|
(define (get-it p)
|
||||||
(let f ([p p] [n 0] [ac '()])
|
(let f ([p p] [n 0] [ac '()])
|
||||||
|
|
@ -1939,8 +1939,14 @@
|
||||||
(if (input-port? p)
|
(if (input-port? p)
|
||||||
(if (textual-port? p)
|
(if (textual-port? p)
|
||||||
(get-it p)
|
(get-it p)
|
||||||
(die 'get-line "not a textual port" p))
|
(die who "not a textual port" p))
|
||||||
(die 'get-line "not an input port" p)))
|
(die who "not an input port" p)))
|
||||||
|
(define (get-line p)
|
||||||
|
($get-line p 'get-line))
|
||||||
|
(define read-line
|
||||||
|
(case-lambda
|
||||||
|
[() ($get-line (current-input-port) 'read-line)]
|
||||||
|
[(p) ($get-line p 'read-line)]))
|
||||||
|
|
||||||
|
|
||||||
(define (get-string-all p)
|
(define (get-string-all p)
|
||||||
|
|
|
||||||
|
|
@ -77,7 +77,9 @@
|
||||||
(except (ikarus startup) host-info)
|
(except (ikarus startup) host-info)
|
||||||
(only (psyntax library-manager) current-library-expander)
|
(only (psyntax library-manager) current-library-expander)
|
||||||
(only (ikarus.reader.annotated) read-source-file)
|
(only (ikarus.reader.annotated) read-source-file)
|
||||||
|
(only (ikarus.symbol-table) initialize-symbol-table!)
|
||||||
(only (ikarus load) load-r6rs-top-level))
|
(only (ikarus load) load-r6rs-top-level))
|
||||||
|
(initialize-symbol-table!)
|
||||||
(init-library-path)
|
(init-library-path)
|
||||||
(let-values ([(files script script-type args)
|
(let-values ([(files script script-type args)
|
||||||
(let f ([args (command-line-arguments)])
|
(let f ([args (command-line-arguments)])
|
||||||
|
|
|
||||||
|
|
@ -0,0 +1,130 @@
|
||||||
|
|
||||||
|
(library (ikarus.symbol-table)
|
||||||
|
(export string->symbol initialize-symbol-table!)
|
||||||
|
(import
|
||||||
|
(except (ikarus) string->symbol)
|
||||||
|
(ikarus system $symbols))
|
||||||
|
|
||||||
|
(define-struct symbol-table (length mask vec guardian))
|
||||||
|
|
||||||
|
(define (extend-table st)
|
||||||
|
(let* ([v1 (symbol-table-vec st)]
|
||||||
|
[n1 (vector-length v1)]
|
||||||
|
[n2 (+ n1 n1)]
|
||||||
|
[mask (- n2 1)]
|
||||||
|
[v2 (make-vector n2 '())])
|
||||||
|
(define (insert p)
|
||||||
|
(unless (null? p)
|
||||||
|
(let ([a (car p)] [rest (cdr p)])
|
||||||
|
(let ([idx (fxand (symbol-hash a) mask)])
|
||||||
|
(set-cdr! p (vector-ref v2 idx))
|
||||||
|
(vector-set! v2 idx p))
|
||||||
|
(insert rest))))
|
||||||
|
(vector-for-each insert v1)
|
||||||
|
(set-symbol-table-vec! st v2)
|
||||||
|
(set-symbol-table-mask! st mask)))
|
||||||
|
|
||||||
|
(define intern-symbol!
|
||||||
|
(case-lambda
|
||||||
|
[(s idx st)
|
||||||
|
(let ([v (symbol-table-vec st)])
|
||||||
|
(vector-set! v idx (weak-cons s (vector-ref v idx)))
|
||||||
|
((symbol-table-guardian st) s)
|
||||||
|
(let ([n (fx+ (symbol-table-length st) 1)])
|
||||||
|
(set-symbol-table-length! st n)
|
||||||
|
(when (fx=? n (symbol-table-mask st))
|
||||||
|
(extend-table st))))]
|
||||||
|
[(s st)
|
||||||
|
(intern-symbol! s
|
||||||
|
(fxand (symbol-hash s) (symbol-table-mask st))
|
||||||
|
st)]))
|
||||||
|
|
||||||
|
(define (intern str idx st)
|
||||||
|
(let ([s ($make-symbol str)])
|
||||||
|
($set-symbol-unique-string! s #f)
|
||||||
|
(intern-symbol! s idx st)
|
||||||
|
s))
|
||||||
|
|
||||||
|
(define (unintern x st)
|
||||||
|
(let ([n (fx- (symbol-table-length st) 1)])
|
||||||
|
(set-symbol-table-length! st n))
|
||||||
|
(let ([idx (fxand (symbol-hash x) (symbol-table-mask st))]
|
||||||
|
[v (symbol-table-vec st)])
|
||||||
|
(let ([ls (vector-ref v idx)])
|
||||||
|
(cond
|
||||||
|
[(eq? (car ls) x)
|
||||||
|
(vector-set! v idx (cdr ls))]
|
||||||
|
[else
|
||||||
|
(let f ([prev ls] [ls (cdr ls)])
|
||||||
|
(cond
|
||||||
|
[(eq? (car ls) x)
|
||||||
|
(set-cdr! prev (cdr ls))]
|
||||||
|
[else (f ls (cdr ls))]))]))))
|
||||||
|
|
||||||
|
(define (guardian-lookup str idx st)
|
||||||
|
(let ([g (symbol-table-guardian st)])
|
||||||
|
(let f ()
|
||||||
|
(let ([a (g)])
|
||||||
|
(cond
|
||||||
|
[(not a) (intern str idx st)]
|
||||||
|
[(string=? str (symbol->string a))
|
||||||
|
(begin (g a) a)]
|
||||||
|
[else
|
||||||
|
(cond
|
||||||
|
[(and ($unbound-object? ($symbol-value a))
|
||||||
|
(null? ($symbol-plist a)))
|
||||||
|
(unintern a st)]
|
||||||
|
[else (g a)])
|
||||||
|
(f)])))))
|
||||||
|
|
||||||
|
(define (chain-lookup str idx st ls)
|
||||||
|
(if (null? ls)
|
||||||
|
(guardian-lookup str idx st)
|
||||||
|
(let ([a (car ls)])
|
||||||
|
(if (string=? str (symbol->string a))
|
||||||
|
a
|
||||||
|
(chain-lookup str idx st (cdr ls))))))
|
||||||
|
|
||||||
|
(define (lookup str ih st)
|
||||||
|
(let ([idx (fxand ih (symbol-table-mask st))])
|
||||||
|
(let ([v (symbol-table-vec st)])
|
||||||
|
(chain-lookup str idx st (vector-ref v idx)))))
|
||||||
|
|
||||||
|
|
||||||
|
(module (string->symbol initialize-symbol-table!)
|
||||||
|
(define st (make-symbol-table 0 3 (make-vector 4 '()) (make-guardian)))
|
||||||
|
(define (string->symbol x)
|
||||||
|
(if (string? x)
|
||||||
|
(lookup x (string-hash x) st)
|
||||||
|
(die 'string->symbol "not a string" x)))
|
||||||
|
(define (initialize-symbol-table!)
|
||||||
|
(define (f x)
|
||||||
|
(when (pair? x)
|
||||||
|
(intern-symbol! (car x) st)
|
||||||
|
(f (cdr x))))
|
||||||
|
(vector-for-each f (foreign-call "ikrt_get_symbol_table")))))
|
||||||
|
|
||||||
|
#!eof
|
||||||
|
|
||||||
|
(define (gen-list i n)
|
||||||
|
(let f ([i i])
|
||||||
|
(if (= i n)
|
||||||
|
'()
|
||||||
|
(let ([x (string->symbol (format "s~a" i))])
|
||||||
|
(cons x (f (+ i 1)))))))
|
||||||
|
|
||||||
|
(initialize-symbol-table!)
|
||||||
|
|
||||||
|
|
||||||
|
(time
|
||||||
|
(let ()
|
||||||
|
(gen-list 0 1000)
|
||||||
|
(gen-list 0 1000)
|
||||||
|
(time (do ((i 0 (+ i 1))) ((= i 1000)) (collect)))
|
||||||
|
(gen-list 0 1000)
|
||||||
|
(gen-list 1000 1001)
|
||||||
|
; (gen-list 1000 2000)
|
||||||
|
#f))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
@ -16,7 +16,7 @@
|
||||||
|
|
||||||
(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 symbol->string
|
gensym-count print-gensym 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!
|
symbol-value symbol-bound? set-symbol-value!
|
||||||
|
|
@ -28,8 +28,7 @@
|
||||||
(ikarus system $fx)
|
(ikarus system $fx)
|
||||||
(except (ikarus) gensym gensym? gensym->unique-string
|
(except (ikarus) gensym gensym? gensym->unique-string
|
||||||
gensym-prefix gensym-count print-gensym system-value
|
gensym-prefix gensym-count print-gensym system-value
|
||||||
string->symbol symbol->string
|
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! reset-symbol-proc!))
|
symbol-value symbol-bound? set-symbol-value! reset-symbol-proc!))
|
||||||
|
|
||||||
|
|
@ -117,6 +116,7 @@
|
||||||
(die 'apply "not a procedure"
|
(die 'apply "not a procedure"
|
||||||
(top-level-value x))))))))
|
(top-level-value x))))))))
|
||||||
|
|
||||||
|
#;
|
||||||
(define string->symbol
|
(define string->symbol
|
||||||
(lambda (x)
|
(lambda (x)
|
||||||
(unless (string? x)
|
(unless (string? x)
|
||||||
|
|
|
||||||
|
|
@ -1 +1 @@
|
||||||
1698
|
1699
|
||||||
|
|
|
||||||
|
|
@ -75,6 +75,7 @@
|
||||||
"ikarus.numerics.ss"
|
"ikarus.numerics.ss"
|
||||||
"ikarus.conditions.ss"
|
"ikarus.conditions.ss"
|
||||||
"ikarus.guardians.ss"
|
"ikarus.guardians.ss"
|
||||||
|
"ikarus.symbol-table.ss"
|
||||||
"ikarus.codecs.ss"
|
"ikarus.codecs.ss"
|
||||||
"ikarus.bytevectors.ss"
|
"ikarus.bytevectors.ss"
|
||||||
"ikarus.posix.ss"
|
"ikarus.posix.ss"
|
||||||
|
|
@ -1110,6 +1111,7 @@
|
||||||
[get-char i r ip]
|
[get-char i r ip]
|
||||||
[get-datum i r ip]
|
[get-datum i r ip]
|
||||||
[get-line i r ip]
|
[get-line i r ip]
|
||||||
|
[read-line i]
|
||||||
[get-string-all i r ip]
|
[get-string-all i r ip]
|
||||||
[get-string-n i r ip]
|
[get-string-n i r ip]
|
||||||
[get-string-n! i r ip]
|
[get-string-n! i r ip]
|
||||||
|
|
|
||||||
|
|
@ -1,957 +0,0 @@
|
||||||
#!/usr/bin/env scheme-script
|
|
||||||
;;; Ikarus Scheme -- A compiler for R6RS Scheme.
|
|
||||||
;;; Copyright (C) 2006,2007,2008 Abdulaziz Ghuloum
|
|
||||||
;;;
|
|
||||||
;;; This program is free software: you can redistribute it and/or modify
|
|
||||||
;;; it under the terms of the GNU General Public License version 3 as
|
|
||||||
;;; published by the Free Software Foundation.
|
|
||||||
;;;
|
|
||||||
;;; This program is distributed in the hope that it will be useful, but
|
|
||||||
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
||||||
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
||||||
;;; General Public License for more details.
|
|
||||||
;;;
|
|
||||||
;;; You should have received a copy of the GNU General Public License
|
|
||||||
;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
|
||||||
|
|
||||||
|
|
||||||
this-file-is-out-of-date!
|
|
||||||
(import (ikarus))
|
|
||||||
|
|
||||||
;;; library names:
|
|
||||||
|
|
||||||
(define library-names
|
|
||||||
'(
|
|
||||||
[se (scheme-report-environment)]
|
|
||||||
[r5 (rnrs r5rs (6))]
|
|
||||||
[ct (rnrs control (6))]
|
|
||||||
[ev (rnrs eval (6))]
|
|
||||||
[mp (rnrs mutable-pairs (6))]
|
|
||||||
[ms (rnrs mutable-strings (6))]
|
|
||||||
[pr (rnrs programs (6))]
|
|
||||||
[sc (rnrs syntax-case (6))]
|
|
||||||
[fi (rnrs files (6))]
|
|
||||||
[ne (null-environment)]
|
|
||||||
[sr (rnrs sorting (6))]
|
|
||||||
[ex (rnrs exceptions (6))]
|
|
||||||
[ls (rnrs lists (6))]
|
|
||||||
[ri (rnrs records inspection (6))]
|
|
||||||
[rp (rnrs records procedural (6))]
|
|
||||||
[rs (rnrs records syntactic (6))]
|
|
||||||
[co (rnrs conditions (6))]
|
|
||||||
[en (rnrs enums (6))]
|
|
||||||
[is (rnrs io simple (6))]
|
|
||||||
[fl (rnrs arithmetic flonums (6))]
|
|
||||||
[ba (rnrs base (6))]
|
|
||||||
[bv (rnrs bytevectors (6))]
|
|
||||||
[uc (rnrs unicode (6))]
|
|
||||||
[bw (rnrs arithmetic bitwise (6))]
|
|
||||||
[fx (rnrs arithmetic fixnums (6))]
|
|
||||||
[ht (rnrs hashtables (6))]
|
|
||||||
[ip (rnrs io ports (6))]
|
|
||||||
))
|
|
||||||
|
|
||||||
(define status-names
|
|
||||||
'(
|
|
||||||
[S scheduled]
|
|
||||||
[C completed]
|
|
||||||
))
|
|
||||||
|
|
||||||
(define identifier-names
|
|
||||||
'(
|
|
||||||
;;;
|
|
||||||
[lambda C ba se ne]
|
|
||||||
[and C ba se ne]
|
|
||||||
[begin C ba se ne]
|
|
||||||
[case C ba se ne]
|
|
||||||
[cond C ba se ne]
|
|
||||||
[define C ba se ne]
|
|
||||||
[define-syntax C ba se ne]
|
|
||||||
[identifier-syntax C ba]
|
|
||||||
[if C ba se ne]
|
|
||||||
[let C ba se ne]
|
|
||||||
[let* C ba se ne]
|
|
||||||
[let*-values C ba]
|
|
||||||
[let-syntax C ba se ne]
|
|
||||||
[let-values C ba]
|
|
||||||
[letrec C ba se ne]
|
|
||||||
[letrec* C ba]
|
|
||||||
[letrec-syntax C ba se ne]
|
|
||||||
[or C ba se ne]
|
|
||||||
[quasiquote C ba se ne]
|
|
||||||
[quote C ba se ne]
|
|
||||||
[set! C ba se ne]
|
|
||||||
[syntax-rules C ba se ne]
|
|
||||||
[unquote C ba se ne]
|
|
||||||
[unquote-splicing C ba se ne]
|
|
||||||
[< C ba se]
|
|
||||||
[<= C ba se]
|
|
||||||
[= C ba se]
|
|
||||||
[> C ba se]
|
|
||||||
[>= C ba se]
|
|
||||||
[+ C ba se]
|
|
||||||
[- C ba se]
|
|
||||||
[* C ba se]
|
|
||||||
[/ C ba se]
|
|
||||||
[abs C ba se]
|
|
||||||
[acos C ba se]
|
|
||||||
[angle S ba se]
|
|
||||||
[append C ba se]
|
|
||||||
[apply C ba se]
|
|
||||||
[asin C ba se]
|
|
||||||
[assert C ba]
|
|
||||||
[assertion-violation C ba]
|
|
||||||
[atan C ba se]
|
|
||||||
[boolean=? C ba]
|
|
||||||
[boolean? C ba se]
|
|
||||||
[car C ba se]
|
|
||||||
[cdr C ba se]
|
|
||||||
[caar C ba se]
|
|
||||||
[cadr C ba se]
|
|
||||||
[cdar C ba se]
|
|
||||||
[cddr C ba se]
|
|
||||||
[caaar C ba se]
|
|
||||||
[caadr C ba se]
|
|
||||||
[cadar C ba se]
|
|
||||||
[caddr C ba se]
|
|
||||||
[cdaar C ba se]
|
|
||||||
[cdadr C ba se]
|
|
||||||
[cddar C ba se]
|
|
||||||
[cdddr C ba se]
|
|
||||||
[caaaar C ba se]
|
|
||||||
[caaadr C ba se]
|
|
||||||
[caadar C ba se]
|
|
||||||
[caaddr C ba se]
|
|
||||||
[cadaar C ba se]
|
|
||||||
[cadadr C ba se]
|
|
||||||
[caddar C ba se]
|
|
||||||
[cadddr C ba se]
|
|
||||||
[cdaaar C ba se]
|
|
||||||
[cdaadr C ba se]
|
|
||||||
[cdadar C ba se]
|
|
||||||
[cdaddr C ba se]
|
|
||||||
[cddaar C ba se]
|
|
||||||
[cddadr C ba se]
|
|
||||||
[cdddar C ba se]
|
|
||||||
[cddddr C ba se]
|
|
||||||
[call-with-current-continuation C ba se]
|
|
||||||
[call/cc C ba]
|
|
||||||
[call-with-values C ba se]
|
|
||||||
[ceiling C ba se]
|
|
||||||
[char->integer C ba se]
|
|
||||||
[char<=? C ba se]
|
|
||||||
[char<? C ba se]
|
|
||||||
[char=? C ba se]
|
|
||||||
[char>=? C ba se]
|
|
||||||
[char>? C ba se]
|
|
||||||
[char? C ba se]
|
|
||||||
[complex? C ba se]
|
|
||||||
[cons C ba se]
|
|
||||||
[cos C ba se]
|
|
||||||
[denominator C ba se]
|
|
||||||
[div C ba]
|
|
||||||
[mod C ba]
|
|
||||||
[div-and-mod C ba]
|
|
||||||
[div0 C ba]
|
|
||||||
[mod0 C ba]
|
|
||||||
[div0-and-mod0 C ba]
|
|
||||||
[dynamic-wind C ba se]
|
|
||||||
[eq? C ba se]
|
|
||||||
[equal? C ba se]
|
|
||||||
[eqv? C ba se]
|
|
||||||
[error C ba]
|
|
||||||
[even? C ba se]
|
|
||||||
[exact C ba]
|
|
||||||
[exact-integer-sqrt C ba]
|
|
||||||
[exact? C ba se]
|
|
||||||
[exp C ba se]
|
|
||||||
[expt C ba se]
|
|
||||||
[finite? C ba]
|
|
||||||
[floor C ba se]
|
|
||||||
[for-each C ba se]
|
|
||||||
[gcd C ba se]
|
|
||||||
[imag-part C ba se]
|
|
||||||
[inexact C ba]
|
|
||||||
[inexact? C ba se]
|
|
||||||
[infinite? C ba]
|
|
||||||
[integer->char C ba se]
|
|
||||||
[integer-valued? C ba]
|
|
||||||
[integer? C ba se]
|
|
||||||
[lcm C ba se]
|
|
||||||
[length C ba se]
|
|
||||||
[list C ba se]
|
|
||||||
[list->string C ba se]
|
|
||||||
[list->vector C ba se]
|
|
||||||
[list-ref C ba se]
|
|
||||||
[list-tail C ba se]
|
|
||||||
[list? C ba se]
|
|
||||||
[log C ba se]
|
|
||||||
[magnitude C ba se]
|
|
||||||
[make-polar S ba se]
|
|
||||||
[make-rectangular S ba se]
|
|
||||||
[make-string C ba se]
|
|
||||||
[make-vector C ba se]
|
|
||||||
[map C ba se]
|
|
||||||
[max C ba se]
|
|
||||||
[min C ba se]
|
|
||||||
[nan? C ba]
|
|
||||||
[negative? C ba se]
|
|
||||||
[not C ba se]
|
|
||||||
[null? C ba]
|
|
||||||
[number->string C ba se]
|
|
||||||
[number? C ba se]
|
|
||||||
[numerator C ba se]
|
|
||||||
[odd? C ba se]
|
|
||||||
[pair? C ba se]
|
|
||||||
[positive? C ba se]
|
|
||||||
[procedure? C ba se]
|
|
||||||
[rational-valued? C ba]
|
|
||||||
[rational? C ba se]
|
|
||||||
[rationalize C ba se]
|
|
||||||
[real-part C ba se]
|
|
||||||
[real-valued? C ba]
|
|
||||||
[real? C ba se]
|
|
||||||
[reverse C ba se]
|
|
||||||
[round C ba se]
|
|
||||||
[sin C ba se]
|
|
||||||
[sqrt C ba se]
|
|
||||||
[string C ba se]
|
|
||||||
[string->list C ba se]
|
|
||||||
[string->number C ba se]
|
|
||||||
[string->symbol C ba se]
|
|
||||||
[string-append C ba se]
|
|
||||||
[string-copy C ba se]
|
|
||||||
[string-for-each C ba]
|
|
||||||
[string-length C ba se]
|
|
||||||
[string-ref C ba se]
|
|
||||||
[string<=? C ba se]
|
|
||||||
[string<? C ba se]
|
|
||||||
[string=? C ba se]
|
|
||||||
[string>=? C ba se]
|
|
||||||
[string>? C ba se]
|
|
||||||
[string? C ba se]
|
|
||||||
[substring C ba se]
|
|
||||||
[symbol->string C ba se]
|
|
||||||
[symbol=? C ba]
|
|
||||||
[symbol? C ba se]
|
|
||||||
[tan C ba se]
|
|
||||||
[truncate C ba se]
|
|
||||||
[values C ba se]
|
|
||||||
[vector C ba se]
|
|
||||||
[vector->list C ba se]
|
|
||||||
[vector-fill! C ba se]
|
|
||||||
[vector-for-each C ba]
|
|
||||||
[vector-length C ba se]
|
|
||||||
[vector-map C ba]
|
|
||||||
[vector-ref C ba se]
|
|
||||||
[vector-set! C ba se]
|
|
||||||
[vector? C ba se]
|
|
||||||
[zero? C ba se]
|
|
||||||
[... C ba sc]
|
|
||||||
[=> C ba ex]
|
|
||||||
[_ C ba sc]
|
|
||||||
[else C ba ex]
|
|
||||||
;;;
|
|
||||||
[bitwise-arithmetic-shift C bw]
|
|
||||||
[bitwise-arithmetic-shift-left C bw]
|
|
||||||
[bitwise-arithmetic-shift-right C bw]
|
|
||||||
[bitwise-not C bw]
|
|
||||||
[bitwise-and C bw]
|
|
||||||
[bitwise-ior S bw]
|
|
||||||
[bitwise-xor S bw]
|
|
||||||
[bitwise-bit-count C bw]
|
|
||||||
[bitwise-bit-field C bw]
|
|
||||||
[bitwise-bit-set? C bw]
|
|
||||||
[bitwise-copy-bit C bw]
|
|
||||||
[bitwise-copy-bit-field S bw]
|
|
||||||
[bitwise-first-bit-set C bw]
|
|
||||||
[bitwise-if S bw]
|
|
||||||
[bitwise-length C bw]
|
|
||||||
[bitwise-reverse-bit-field S bw]
|
|
||||||
[bitwise-rotate-bit-field S bw]
|
|
||||||
;;;
|
|
||||||
[fixnum? C fx]
|
|
||||||
[fixnum-width C fx]
|
|
||||||
[least-fixnum C fx]
|
|
||||||
[greatest-fixnum C fx]
|
|
||||||
[fx* C fx]
|
|
||||||
[fx*/carry C fx]
|
|
||||||
[fx+ C fx]
|
|
||||||
[fx+/carry C fx]
|
|
||||||
[fx- C fx]
|
|
||||||
[fx-/carry C fx]
|
|
||||||
[fx<=? C fx]
|
|
||||||
[fx<? C fx]
|
|
||||||
[fx=? C fx]
|
|
||||||
[fx>=? C fx]
|
|
||||||
[fx>? C fx]
|
|
||||||
[fxand C fx]
|
|
||||||
[fxarithmetic-shift C fx]
|
|
||||||
[fxarithmetic-shift-left C fx]
|
|
||||||
[fxarithmetic-shift-right C fx]
|
|
||||||
[fxbit-count C fx]
|
|
||||||
[fxbit-field C fx]
|
|
||||||
[fxbit-set? C fx]
|
|
||||||
[fxcopy-bit C fx]
|
|
||||||
[fxcopy-bit-field C fx]
|
|
||||||
[fxdiv C fx]
|
|
||||||
[fxdiv-and-mod C fx]
|
|
||||||
[fxdiv0 C fx]
|
|
||||||
[fxdiv0-and-mod0 C fx]
|
|
||||||
[fxeven? C fx]
|
|
||||||
[fxfirst-bit-set C fx]
|
|
||||||
[fxif C fx]
|
|
||||||
[fxior C fx]
|
|
||||||
[fxlength C fx]
|
|
||||||
[fxmax C fx]
|
|
||||||
[fxmin C fx]
|
|
||||||
[fxmod C fx]
|
|
||||||
[fxmod0 C fx]
|
|
||||||
[fxnegative? C fx]
|
|
||||||
[fxnot C fx]
|
|
||||||
[fxodd? C fx]
|
|
||||||
[fxpositive? C fx]
|
|
||||||
[fxreverse-bit-field S fx]
|
|
||||||
[fxrotate-bit-field S fx]
|
|
||||||
[fxxor C fx]
|
|
||||||
[fxzero? C fx]
|
|
||||||
;;;
|
|
||||||
[fixnum->flonum C fl]
|
|
||||||
[fl* C fl]
|
|
||||||
[fl+ C fl]
|
|
||||||
[fl- C fl]
|
|
||||||
[fl/ C fl]
|
|
||||||
[fl<=? C fl]
|
|
||||||
[fl<? C fl]
|
|
||||||
[fl=? C fl]
|
|
||||||
[fl>=? C fl]
|
|
||||||
[fl>? C fl]
|
|
||||||
[flabs C fl]
|
|
||||||
[flacos C fl]
|
|
||||||
[flasin C fl]
|
|
||||||
[flatan C fl]
|
|
||||||
[flceiling C fl]
|
|
||||||
[flcos C fl]
|
|
||||||
[fldenominator C fl]
|
|
||||||
[fldiv C fl]
|
|
||||||
[fldiv-and-mod C fl]
|
|
||||||
[fldiv0 C fl]
|
|
||||||
[fldiv0-and-mod0 C fl]
|
|
||||||
[fleven? C fl]
|
|
||||||
[flexp C fl]
|
|
||||||
[flexpt C fl]
|
|
||||||
[flfinite? C fl]
|
|
||||||
[flfloor C fl]
|
|
||||||
[flinfinite? C fl]
|
|
||||||
[flinteger? C fl]
|
|
||||||
[fllog C fl]
|
|
||||||
[flmax C fl]
|
|
||||||
[flmin C fl]
|
|
||||||
[flmod C fl]
|
|
||||||
[flmod0 C fl]
|
|
||||||
[flnan? C fl]
|
|
||||||
[flnegative? C fl]
|
|
||||||
[flnumerator C fl]
|
|
||||||
[flodd? C fl]
|
|
||||||
[flonum? C fl]
|
|
||||||
[flpositive? C fl]
|
|
||||||
[flround C fl]
|
|
||||||
[flsin C fl]
|
|
||||||
[flsqrt C fl]
|
|
||||||
[fltan C fl]
|
|
||||||
[fltruncate C fl]
|
|
||||||
[flzero? C fl]
|
|
||||||
[real->flonum C fl]
|
|
||||||
[make-no-infinities-violation C fl]
|
|
||||||
[make-no-nans-violation C fl]
|
|
||||||
[&no-infinities C fl]
|
|
||||||
[no-infinities-violation? C fl]
|
|
||||||
[&no-nans C fl]
|
|
||||||
[no-nans-violation? C fl]
|
|
||||||
;;;
|
|
||||||
[bytevector->sint-list C bv]
|
|
||||||
[bytevector->u8-list C bv]
|
|
||||||
[bytevector->uint-list C bv]
|
|
||||||
[bytevector-copy C bv]
|
|
||||||
[bytevector-copy! C bv]
|
|
||||||
[bytevector-fill! C bv]
|
|
||||||
[bytevector-ieee-double-native-ref C bv]
|
|
||||||
[bytevector-ieee-double-native-set! C bv]
|
|
||||||
[bytevector-ieee-double-ref C bv]
|
|
||||||
[bytevector-ieee-double-set! C bv]
|
|
||||||
[bytevector-ieee-single-native-ref C bv]
|
|
||||||
[bytevector-ieee-single-native-set! C bv]
|
|
||||||
[bytevector-ieee-single-ref C bv]
|
|
||||||
[bytevector-ieee-single-set! C bv]
|
|
||||||
[bytevector-length C bv]
|
|
||||||
[bytevector-s16-native-ref C bv]
|
|
||||||
[bytevector-s16-native-set! C bv]
|
|
||||||
[bytevector-s16-ref C bv]
|
|
||||||
[bytevector-s16-set! C bv]
|
|
||||||
[bytevector-s32-native-ref C bv]
|
|
||||||
[bytevector-s32-native-set! C bv]
|
|
||||||
[bytevector-s32-ref C bv]
|
|
||||||
[bytevector-s32-set! C bv]
|
|
||||||
[bytevector-s64-native-ref C bv]
|
|
||||||
[bytevector-s64-native-set! C bv]
|
|
||||||
[bytevector-s64-ref C bv]
|
|
||||||
[bytevector-s64-set! C bv]
|
|
||||||
[bytevector-s8-ref C bv]
|
|
||||||
[bytevector-s8-set! C bv]
|
|
||||||
[bytevector-sint-ref C bv]
|
|
||||||
[bytevector-sint-set! C bv]
|
|
||||||
[bytevector-u16-native-ref C bv]
|
|
||||||
[bytevector-u16-native-set! C bv]
|
|
||||||
[bytevector-u16-ref C bv]
|
|
||||||
[bytevector-u16-set! C bv]
|
|
||||||
[bytevector-u32-native-ref C bv]
|
|
||||||
[bytevector-u32-native-set! C bv]
|
|
||||||
[bytevector-u32-ref C bv]
|
|
||||||
[bytevector-u32-set! C bv]
|
|
||||||
[bytevector-u64-native-ref C bv]
|
|
||||||
[bytevector-u64-native-set! C bv]
|
|
||||||
[bytevector-u64-ref C bv]
|
|
||||||
[bytevector-u64-set! C bv]
|
|
||||||
[bytevector-u8-ref C bv]
|
|
||||||
[bytevector-u8-set! C bv]
|
|
||||||
[bytevector-uint-ref C bv]
|
|
||||||
[bytevector-uint-set! C bv]
|
|
||||||
[bytevector=? C bv]
|
|
||||||
[bytevector? C bv]
|
|
||||||
[endianness C bv]
|
|
||||||
[native-endianness C bv]
|
|
||||||
[sint-list->bytevector C bv]
|
|
||||||
[string->utf16 S bv]
|
|
||||||
[string->utf32 S bv]
|
|
||||||
[string->utf8 C bv]
|
|
||||||
[u8-list->bytevector C bv]
|
|
||||||
[uint-list->bytevector C bv]
|
|
||||||
[utf8->string C bv]
|
|
||||||
[utf16->string S bv]
|
|
||||||
[utf32->string S bv]
|
|
||||||
;;;
|
|
||||||
[condition? C co]
|
|
||||||
[&assertion C co]
|
|
||||||
[assertion-violation? C co]
|
|
||||||
[&condition C co]
|
|
||||||
[condition C co]
|
|
||||||
[condition-accessor C co]
|
|
||||||
[condition-irritants C co]
|
|
||||||
[condition-message C co]
|
|
||||||
[condition-predicate C co]
|
|
||||||
[condition-who C co]
|
|
||||||
[define-condition-type C co]
|
|
||||||
[&error C co]
|
|
||||||
[error? C co]
|
|
||||||
[&implementation-restriction C co]
|
|
||||||
[implementation-restriction-violation? C co]
|
|
||||||
[&irritants C co]
|
|
||||||
[irritants-condition? C co]
|
|
||||||
[&lexical C co]
|
|
||||||
[lexical-violation? C co]
|
|
||||||
[make-assertion-violation C co]
|
|
||||||
[make-error C co]
|
|
||||||
[make-implementation-restriction-violation C co]
|
|
||||||
[make-irritants-condition C co]
|
|
||||||
[make-lexical-violation C co]
|
|
||||||
[make-message-condition C co]
|
|
||||||
[make-non-continuable-violation C co]
|
|
||||||
[make-serious-condition C co]
|
|
||||||
[make-syntax-violation C co]
|
|
||||||
[make-undefined-violation C co]
|
|
||||||
[make-violation C co]
|
|
||||||
[make-warning C co]
|
|
||||||
[make-who-condition C co]
|
|
||||||
[&message C co]
|
|
||||||
[message-condition? C co]
|
|
||||||
[&non-continuable C co]
|
|
||||||
[non-continuable-violation? C co]
|
|
||||||
[&serious C co]
|
|
||||||
[serious-condition? C co]
|
|
||||||
[simple-conditions C co]
|
|
||||||
[&syntax C co]
|
|
||||||
[syntax-violation C co sc]
|
|
||||||
[syntax-violation-form C co]
|
|
||||||
[syntax-violation-subform C co]
|
|
||||||
[syntax-violation? C co]
|
|
||||||
[&undefined C co]
|
|
||||||
[undefined-violation? C co]
|
|
||||||
[&violation C co]
|
|
||||||
[violation? C co]
|
|
||||||
[&warning C co]
|
|
||||||
[warning? C co]
|
|
||||||
[&who C co]
|
|
||||||
[who-condition? C co]
|
|
||||||
;;;
|
|
||||||
[case-lambda C ct]
|
|
||||||
[do C ct se ne]
|
|
||||||
[unless C ct]
|
|
||||||
[when C ct]
|
|
||||||
;;;
|
|
||||||
[define-enumeration C en]
|
|
||||||
[enum-set->list C en]
|
|
||||||
[enum-set-complement C en]
|
|
||||||
[enum-set-constructor C en]
|
|
||||||
[enum-set-difference C en]
|
|
||||||
[enum-set-indexer C en]
|
|
||||||
[enum-set-intersection C en]
|
|
||||||
[enum-set-member? C en]
|
|
||||||
[enum-set-projection C en]
|
|
||||||
[enum-set-subset? C en]
|
|
||||||
[enum-set-union C en]
|
|
||||||
[enum-set-universe C en]
|
|
||||||
[enum-set=? C en]
|
|
||||||
[make-enumeration C en]
|
|
||||||
;;;
|
|
||||||
[environment C ev]
|
|
||||||
[eval C ev se]
|
|
||||||
;;;
|
|
||||||
[raise C ex]
|
|
||||||
[raise-continuable C ex]
|
|
||||||
[with-exception-handler C ex]
|
|
||||||
[guard C ex]
|
|
||||||
;;;
|
|
||||||
[binary-port? C ip]
|
|
||||||
[buffer-mode C ip]
|
|
||||||
[buffer-mode? C ip]
|
|
||||||
[bytevector->string S ip]
|
|
||||||
[string->bytevector S ip]
|
|
||||||
[call-with-bytevector-output-port C ip]
|
|
||||||
[call-with-port C ip]
|
|
||||||
[call-with-string-output-port C ip]
|
|
||||||
;;;
|
|
||||||
[assoc C ls se]
|
|
||||||
[assp C ls]
|
|
||||||
[assq C ls se]
|
|
||||||
[assv C ls se]
|
|
||||||
[cons* C ls]
|
|
||||||
[filter C ls]
|
|
||||||
[find C ls]
|
|
||||||
[fold-left C ls]
|
|
||||||
[fold-right C ls]
|
|
||||||
[for-all C ls]
|
|
||||||
[exists C ls]
|
|
||||||
[member C ls se]
|
|
||||||
[memp C ls]
|
|
||||||
[memq C ls se]
|
|
||||||
[memv C ls se]
|
|
||||||
[partition C ls]
|
|
||||||
[remq C ls]
|
|
||||||
[remp C ls]
|
|
||||||
[remv C ls]
|
|
||||||
[remove C ls]
|
|
||||||
;;;
|
|
||||||
[set-car! C mp se]
|
|
||||||
[set-cdr! C mp se]
|
|
||||||
;;;
|
|
||||||
[string-set! C ms se]
|
|
||||||
[string-fill! C ms se]
|
|
||||||
;;;
|
|
||||||
[command-line C pr]
|
|
||||||
[exit C pr]
|
|
||||||
;;;
|
|
||||||
[delay C r5 se ne]
|
|
||||||
[exact->inexact C r5 se]
|
|
||||||
[force C r5 se]
|
|
||||||
[inexact->exact C r5 se]
|
|
||||||
[modulo C r5 se]
|
|
||||||
[remainder C r5 se]
|
|
||||||
[null-environment C r5 se]
|
|
||||||
[quotient C r5 se]
|
|
||||||
[scheme-report-environment C r5 se]
|
|
||||||
;;;
|
|
||||||
[close-port C ip]
|
|
||||||
[eol-style C ip]
|
|
||||||
[error-handling-mode C ip]
|
|
||||||
[file-options C ip]
|
|
||||||
[flush-output-port C ip]
|
|
||||||
[get-bytevector-all C ip]
|
|
||||||
[get-bytevector-n C ip]
|
|
||||||
[get-bytevector-n! C ip]
|
|
||||||
[get-bytevector-some C ip]
|
|
||||||
[get-char C ip]
|
|
||||||
[get-datum C ip]
|
|
||||||
[get-line C ip]
|
|
||||||
[get-string-all C ip]
|
|
||||||
[get-string-n C ip]
|
|
||||||
[get-string-n! C ip]
|
|
||||||
[get-u8 C ip]
|
|
||||||
[&i/o C ip is fi]
|
|
||||||
[&i/o-decoding C ip]
|
|
||||||
[i/o-decoding-error? C ip]
|
|
||||||
[&i/o-encoding C ip]
|
|
||||||
[i/o-encoding-error-char C ip]
|
|
||||||
[i/o-encoding-error? C ip]
|
|
||||||
[i/o-error-filename C ip is fi]
|
|
||||||
[i/o-error-port C ip is fi]
|
|
||||||
[i/o-error? C ip is fi]
|
|
||||||
[&i/o-file-already-exists C ip is fi]
|
|
||||||
[i/o-file-already-exists-error? C ip is fi]
|
|
||||||
[&i/o-file-does-not-exist C ip is fi]
|
|
||||||
[i/o-file-does-not-exist-error? C ip is fi]
|
|
||||||
[&i/o-file-is-read-only C ip is fi]
|
|
||||||
[i/o-file-is-read-only-error? C ip is fi]
|
|
||||||
[&i/o-file-protection C ip is fi]
|
|
||||||
[i/o-file-protection-error? C ip is fi]
|
|
||||||
[&i/o-filename C ip is fi]
|
|
||||||
[i/o-filename-error? C ip is fi]
|
|
||||||
[&i/o-invalid-position C ip is fi]
|
|
||||||
[i/o-invalid-position-error? C ip is fi]
|
|
||||||
[&i/o-port C ip is fi]
|
|
||||||
[i/o-port-error? C ip is fi]
|
|
||||||
[&i/o-read C ip is fi]
|
|
||||||
[i/o-read-error? C ip is fi]
|
|
||||||
[&i/o-write C ip is fi]
|
|
||||||
[i/o-write-error? C ip is fi]
|
|
||||||
[lookahead-char C ip]
|
|
||||||
[lookahead-u8 C ip]
|
|
||||||
[make-bytevector C bv]
|
|
||||||
[make-custom-binary-input-port C ip]
|
|
||||||
[make-custom-binary-output-port C ip]
|
|
||||||
[make-custom-textual-input-port C ip]
|
|
||||||
[make-custom-textual-output-port C ip]
|
|
||||||
[make-custom-binary-input/output-port S ip]
|
|
||||||
[make-custom-textual-input/output-port S ip]
|
|
||||||
[make-i/o-decoding-error C ip]
|
|
||||||
[make-i/o-encoding-error C ip]
|
|
||||||
[make-i/o-error C ip is fi]
|
|
||||||
[make-i/o-file-already-exists-error C ip is fi]
|
|
||||||
[make-i/o-file-does-not-exist-error C ip is fi]
|
|
||||||
[make-i/o-file-is-read-only-error C ip is fi]
|
|
||||||
[make-i/o-file-protection-error C ip is fi]
|
|
||||||
[make-i/o-filename-error C ip is fi]
|
|
||||||
[make-i/o-invalid-position-error C ip is fi]
|
|
||||||
[make-i/o-port-error C ip is fi]
|
|
||||||
[make-i/o-read-error C ip is fi]
|
|
||||||
[make-i/o-write-error C ip is fi]
|
|
||||||
[latin-1-codec C ip]
|
|
||||||
[make-transcoder C ip]
|
|
||||||
[native-eol-style C ip]
|
|
||||||
[native-transcoder C ip]
|
|
||||||
[open-bytevector-input-port C ip]
|
|
||||||
[open-bytevector-output-port C ip]
|
|
||||||
[open-file-input-port C ip]
|
|
||||||
[open-file-input/output-port S ip]
|
|
||||||
[open-file-output-port C ip]
|
|
||||||
[open-string-input-port C ip]
|
|
||||||
[open-string-output-port C ip]
|
|
||||||
[output-port-buffer-mode S ip]
|
|
||||||
[port-eof? C ip]
|
|
||||||
[port-has-port-position? S ip]
|
|
||||||
[port-has-set-port-position!? S ip]
|
|
||||||
[port-position S ip]
|
|
||||||
[port-transcoder C ip]
|
|
||||||
[port? C ip]
|
|
||||||
[put-bytevector C ip]
|
|
||||||
[put-char C ip]
|
|
||||||
[put-datum C ip]
|
|
||||||
[put-string C ip]
|
|
||||||
[put-u8 C ip]
|
|
||||||
[set-port-position! S ip]
|
|
||||||
[standard-error-port C ip]
|
|
||||||
[standard-input-port C ip]
|
|
||||||
[standard-output-port C ip]
|
|
||||||
[textual-port? C ip]
|
|
||||||
[transcoded-port C ip]
|
|
||||||
[transcoder-codec C ip]
|
|
||||||
[transcoder-eol-style C ip]
|
|
||||||
[transcoder-error-handling-mode C ip]
|
|
||||||
[utf-16-codec C ip]
|
|
||||||
[utf-8-codec C ip]
|
|
||||||
;;;
|
|
||||||
[input-port? C is ip se]
|
|
||||||
[output-port? C is ip se]
|
|
||||||
[current-input-port C ip is se]
|
|
||||||
[current-output-port C ip is se]
|
|
||||||
[current-error-port C ip is]
|
|
||||||
[eof-object C ip is se]
|
|
||||||
[eof-object? C ip is]
|
|
||||||
[close-input-port C is se]
|
|
||||||
[close-output-port C is se]
|
|
||||||
[display C is se]
|
|
||||||
[newline C is se]
|
|
||||||
[open-input-file C is se]
|
|
||||||
[open-output-file C is se]
|
|
||||||
[peek-char C is se]
|
|
||||||
[read C is se]
|
|
||||||
[read-char C is se]
|
|
||||||
[with-input-from-file C is se]
|
|
||||||
[with-output-to-file C is se]
|
|
||||||
[write C is se]
|
|
||||||
[write-char C is se]
|
|
||||||
[call-with-input-file C is se]
|
|
||||||
[call-with-output-file C is se]
|
|
||||||
;;;
|
|
||||||
[hashtable-clear! C ht]
|
|
||||||
[hashtable-contains? C ht]
|
|
||||||
[hashtable-copy C ht]
|
|
||||||
[hashtable-delete! C ht]
|
|
||||||
[hashtable-entries C ht]
|
|
||||||
[hashtable-keys C ht]
|
|
||||||
[hashtable-mutable? C ht]
|
|
||||||
[hashtable-ref C ht]
|
|
||||||
[hashtable-set! C ht]
|
|
||||||
[hashtable-size C ht]
|
|
||||||
[hashtable-update! C ht]
|
|
||||||
[hashtable? C ht]
|
|
||||||
[make-eq-hashtable C ht]
|
|
||||||
[make-eqv-hashtable S ht]
|
|
||||||
[hashtable-hash-function S ht]
|
|
||||||
[make-hashtable S ht]
|
|
||||||
[hashtable-equivalence-function S ht]
|
|
||||||
[equal-hash S ht]
|
|
||||||
[string-hash C ht]
|
|
||||||
[string-ci-hash C ht]
|
|
||||||
[symbol-hash C ht]
|
|
||||||
;;;
|
|
||||||
[list-sort C sr]
|
|
||||||
[vector-sort C sr]
|
|
||||||
[vector-sort! C sr]
|
|
||||||
;;;
|
|
||||||
[file-exists? C fi]
|
|
||||||
[delete-file C fi]
|
|
||||||
;;;
|
|
||||||
[define-record-type C rs]
|
|
||||||
[fields C rs]
|
|
||||||
[immutable C rs]
|
|
||||||
[mutable C rs]
|
|
||||||
[opaque C rs]
|
|
||||||
[parent C rs]
|
|
||||||
[parent-rtd C rs]
|
|
||||||
[protocol C rs]
|
|
||||||
[record-constructor-descriptor C rs]
|
|
||||||
[record-type-descriptor C rs]
|
|
||||||
[sealed C rs]
|
|
||||||
[nongenerative C rs]
|
|
||||||
;;;
|
|
||||||
[record-field-mutable? C ri]
|
|
||||||
[record-rtd C ri]
|
|
||||||
[record-type-field-names C ri]
|
|
||||||
[record-type-generative? C ri]
|
|
||||||
[record-type-name C ri]
|
|
||||||
[record-type-opaque? C ri]
|
|
||||||
[record-type-parent C ri]
|
|
||||||
[record-type-sealed? C ri]
|
|
||||||
[record-type-uid C ri]
|
|
||||||
[record? C ri]
|
|
||||||
;;;
|
|
||||||
[make-record-constructor-descriptor C rp]
|
|
||||||
[make-record-type-descriptor C rp]
|
|
||||||
[record-accessor C rp]
|
|
||||||
[record-constructor C rp]
|
|
||||||
[record-mutator C rp]
|
|
||||||
[record-predicate C rp]
|
|
||||||
[record-type-descriptor? C rp]
|
|
||||||
;;;
|
|
||||||
[bound-identifier=? C sc]
|
|
||||||
[datum->syntax C sc]
|
|
||||||
[syntax C sc]
|
|
||||||
[syntax->datum C sc]
|
|
||||||
[syntax-case C sc]
|
|
||||||
[unsyntax C sc]
|
|
||||||
[unsyntax-splicing C sc]
|
|
||||||
[quasisyntax C sc]
|
|
||||||
[with-syntax C sc]
|
|
||||||
[free-identifier=? C sc]
|
|
||||||
[generate-temporaries C sc]
|
|
||||||
[identifier? C sc]
|
|
||||||
[make-variable-transformer C sc]
|
|
||||||
;;;
|
|
||||||
[char-alphabetic? C uc se]
|
|
||||||
[char-ci<=? C uc se]
|
|
||||||
[char-ci<? C uc se]
|
|
||||||
[char-ci=? C uc se]
|
|
||||||
[char-ci>=? C uc se]
|
|
||||||
[char-ci>? C uc se]
|
|
||||||
[char-downcase C uc se]
|
|
||||||
[char-foldcase C uc]
|
|
||||||
[char-titlecase C uc]
|
|
||||||
[char-upcase C uc se]
|
|
||||||
[char-general-category C uc]
|
|
||||||
[char-lower-case? C uc se]
|
|
||||||
[char-numeric? C uc se]
|
|
||||||
[char-title-case? C uc]
|
|
||||||
[char-upper-case? C uc se]
|
|
||||||
[char-whitespace? C uc se]
|
|
||||||
[string-ci<=? C uc se]
|
|
||||||
[string-ci<? C uc se]
|
|
||||||
[string-ci=? C uc se]
|
|
||||||
[string-ci>=? C uc se]
|
|
||||||
[string-ci>? C uc se]
|
|
||||||
[string-downcase S uc]
|
|
||||||
[string-foldcase C uc]
|
|
||||||
[string-normalize-nfc S uc]
|
|
||||||
[string-normalize-nfd S uc]
|
|
||||||
[string-normalize-nfkc S uc]
|
|
||||||
[string-normalize-nfkd S uc]
|
|
||||||
[string-titlecase S uc]
|
|
||||||
[string-upcase S uc]
|
|
||||||
;;;
|
|
||||||
[char-ready? S ]
|
|
||||||
[interaction-environment S ]
|
|
||||||
[load S ]
|
|
||||||
;;;
|
|
||||||
))
|
|
||||||
|
|
||||||
|
|
||||||
(define (no-dups ls)
|
|
||||||
(unless (null? ls)
|
|
||||||
(when (memq (car ls) (cdr ls))
|
|
||||||
(error #f "duplicate identifier" (car ls)))
|
|
||||||
(no-dups (cdr ls))))
|
|
||||||
|
|
||||||
(define (assert-id x)
|
|
||||||
(unless (and (>= (length x) 2)
|
|
||||||
(let ([name (car x)]
|
|
||||||
[status (cadr x)]
|
|
||||||
[libs (cddr x)])
|
|
||||||
(no-dups libs)
|
|
||||||
(and (assq status status-names)
|
|
||||||
(andmap (lambda (x)
|
|
||||||
(assq x library-names))
|
|
||||||
libs))))
|
|
||||||
(error #f "invalid identifier" x)))
|
|
||||||
|
|
||||||
|
|
||||||
(define (filter* ls)
|
|
||||||
(filter
|
|
||||||
(lambda (x)
|
|
||||||
(not (null? (filter
|
|
||||||
(lambda (x)
|
|
||||||
(memq x ls))
|
|
||||||
(cdr x)))))
|
|
||||||
identifier-names))
|
|
||||||
|
|
||||||
(define (count-status x)
|
|
||||||
(length (filter* (list x))))
|
|
||||||
|
|
||||||
(define (join s ls)
|
|
||||||
(cond
|
|
||||||
[(null? ls) ""]
|
|
||||||
[(null? (cdr ls)) (format "~a" (car ls))]
|
|
||||||
[else
|
|
||||||
(format "~a~a~a" (car ls) s (join s (cdr ls)))]))
|
|
||||||
|
|
||||||
(define (status-str x)
|
|
||||||
(cond
|
|
||||||
[(assq x identifier-names)
|
|
||||||
=>
|
|
||||||
(lambda (x)
|
|
||||||
(let ([st (cadr x)] [libs (cddr x)])
|
|
||||||
(format "(~a ~a)" st (join "," libs))))]
|
|
||||||
[else (error #f "invalid identifier" x)]))
|
|
||||||
|
|
||||||
(define (print-ids ls)
|
|
||||||
(define (split ls n)
|
|
||||||
(cond
|
|
||||||
[(null? ls) (values '() '())]
|
|
||||||
[(> (string-length (car ls)) n)
|
|
||||||
(values '() ls)]
|
|
||||||
[else
|
|
||||||
(let-values ([(fst rest)
|
|
||||||
(split (cdr ls)
|
|
||||||
(- n
|
|
||||||
(string-length (car ls))))])
|
|
||||||
(values (cons (car ls) fst) rest))]))
|
|
||||||
(define (print-ids ls)
|
|
||||||
(unless (null? ls)
|
|
||||||
(let-values ([(ls rest)
|
|
||||||
(split ls 72)])
|
|
||||||
(for-each display ls)
|
|
||||||
(newline)
|
|
||||||
(print-ids rest))))
|
|
||||||
(print-ids
|
|
||||||
(map (lambda (x) (format "~s ~a " x (status-str x))) ls)))
|
|
||||||
|
|
||||||
|
|
||||||
(define (split p ls)
|
|
||||||
(cond
|
|
||||||
[(null? ls) (values '() '())]
|
|
||||||
[else
|
|
||||||
(let-values ([(ls1 ls2)
|
|
||||||
(split p (cdr ls))])
|
|
||||||
(if (p (car ls))
|
|
||||||
(values (cons (car ls) ls1) ls2)
|
|
||||||
(values ls1 (cons (car ls) ls2))))]))
|
|
||||||
|
|
||||||
(define (null-intersection? ls1 ls2)
|
|
||||||
(cond
|
|
||||||
[(null? ls1) #t]
|
|
||||||
[(memq (car ls1) ls2) #f]
|
|
||||||
[else (null-intersection? (cdr ls1) ls2)]))
|
|
||||||
|
|
||||||
|
|
||||||
(define (library-info lib)
|
|
||||||
(let ([inf (map (lambda (x) (cons (car x) 0)) status-names)])
|
|
||||||
(for-each
|
|
||||||
(lambda (x)
|
|
||||||
(let ([s (cadr x)]
|
|
||||||
[l* (cddr x)])
|
|
||||||
(cond
|
|
||||||
[(and (memq lib l*) (assq s inf)) =>
|
|
||||||
(lambda (x)
|
|
||||||
(set-cdr! x (add1 (cdr x))))])))
|
|
||||||
identifier-names)
|
|
||||||
(join " "
|
|
||||||
(map (lambda (x)
|
|
||||||
(format "~a=~a" (car x) (cdr x)))
|
|
||||||
(filter
|
|
||||||
(lambda (x)
|
|
||||||
(not (zero? (cdr x))))
|
|
||||||
inf)))))
|
|
||||||
|
|
||||||
(no-dups (map car identifier-names))
|
|
||||||
(no-dups (map car library-names))
|
|
||||||
(no-dups (map car status-names))
|
|
||||||
(for-each assert-id identifier-names)
|
|
||||||
|
|
||||||
|
|
||||||
(let ([args (cdr (command-line-arguments))]
|
|
||||||
[exe (car (command-line-arguments))])
|
|
||||||
(cond
|
|
||||||
[(null? args)
|
|
||||||
(printf "usage: ~a (<status>|<libname>)*\n\n" exe)
|
|
||||||
(printf "Library Names:\n")
|
|
||||||
(for-each
|
|
||||||
(lambda (x)
|
|
||||||
(printf " ~a ~a ~a\n" (car x) (cadr x)
|
|
||||||
(library-info (car x))))
|
|
||||||
library-names)
|
|
||||||
(printf "Status Codes:\n")
|
|
||||||
(let* ([s* (map
|
|
||||||
(lambda (x)
|
|
||||||
(count-status (car x)))
|
|
||||||
status-names)]
|
|
||||||
[all (apply + s*)])
|
|
||||||
(for-each
|
|
||||||
(lambda (x s)
|
|
||||||
(printf " ~a ~a (~s ids == ~s%)\n"
|
|
||||||
(car x) (cadr x)
|
|
||||||
s
|
|
||||||
(/ (round (* (/ s all) 10000)) 100.0)))
|
|
||||||
status-names s*))]
|
|
||||||
[else
|
|
||||||
(let-values ([(s* l*)
|
|
||||||
(split
|
|
||||||
(lambda (x)
|
|
||||||
(cond
|
|
||||||
[(assq x status-names) #t]
|
|
||||||
[(assq x library-names) #f]
|
|
||||||
[else (error #f "invalid argument" x)]))
|
|
||||||
(map string->symbol args))])
|
|
||||||
(let ([ls (filter
|
|
||||||
(lambda (x)
|
|
||||||
(let ([s (cadr x)]
|
|
||||||
[libs (cddr x)])
|
|
||||||
(cond
|
|
||||||
[(null? l*) (memq s s*)]
|
|
||||||
[(null? s*)
|
|
||||||
(not (null-intersection? l* libs))]
|
|
||||||
[else
|
|
||||||
(and (memq s s*)
|
|
||||||
(not (null-intersection? l* libs)))])))
|
|
||||||
identifier-names)])
|
|
||||||
(printf "~s identifiers\n" (length ls))
|
|
||||||
(print-ids (map car ls))))]
|
|
||||||
))
|
|
||||||
|
|
||||||
|
|
@ -32,14 +32,18 @@ make_symbol_table(ikpcb* pcb){
|
||||||
return st;
|
return st;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
/* one-at-a-time from http://burtleburtle.net/bob/hash/doobs.html */
|
||||||
static long int
|
static long int
|
||||||
compute_hash(ikptr str){
|
compute_hash(ikptr str){
|
||||||
long int len = unfix(ref(str, off_string_length));
|
long int len = unfix(ref(str, off_string_length));
|
||||||
char* data = (char*)(long) str + off_string_data;
|
int* data = (int*)(str + off_string_data);
|
||||||
long int h = len;
|
int h = len;
|
||||||
char* last = data + len * string_char_size;
|
int* last = data + len;
|
||||||
|
|
||||||
|
/* one-at-a-time */
|
||||||
while(data < last){
|
while(data < last){
|
||||||
char c = *data;
|
int c = (*data >> 8);
|
||||||
h = h + c;
|
h = h + c;
|
||||||
h = h + (h << 10);
|
h = h + (h << 10);
|
||||||
h = h ^ (h >> 6);
|
h = h ^ (h >> 6);
|
||||||
|
|
@ -184,11 +188,25 @@ ikrt_unintern_gensym(ikptr sym, ikpcb* pcb){
|
||||||
return false_object;
|
return false_object;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
ikptr
|
||||||
|
ikrt_get_symbol_table(ikpcb* pcb){
|
||||||
|
ikptr st = pcb->symbol_table;
|
||||||
|
pcb->symbol_table = false_object;
|
||||||
|
if(st == false_object) {
|
||||||
|
fprintf(stderr, "bug in ikarus, attempt to access dead symbol table\n");
|
||||||
|
exit(-1);
|
||||||
|
}
|
||||||
|
return st;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
ikptr
|
ikptr
|
||||||
ikrt_string_to_symbol(ikptr str, ikpcb* pcb){
|
ikrt_string_to_symbol(ikptr str, ikpcb* pcb){
|
||||||
ikptr st = pcb->symbol_table;
|
ikptr st = pcb->symbol_table;
|
||||||
|
if(st == false_object) {
|
||||||
|
fprintf(stderr, "bug in ikarus, attempt to access dead symbol table\n");
|
||||||
|
exit(-1);
|
||||||
|
}
|
||||||
if(st == 0){
|
if(st == 0){
|
||||||
st = make_symbol_table(pcb);
|
st = make_symbol_table(pcb);
|
||||||
pcb->symbol_table = st;
|
pcb->symbol_table = st;
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue