932 lines
43 KiB
Scheme
Executable File
932 lines
43 KiB
Scheme
Executable File
#!/usr/bin/env ikarus --r6rs-script
|
|
|
|
(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))]
|
|
[ba (rnrs base (6))]
|
|
[ls (rnrs lists (6))]
|
|
[is (rnrs io simple (6))]
|
|
[bv (rnrs bytevectors (6))]
|
|
[uc (rnrs unicode (6))]
|
|
[ex (rnrs exceptions (6))]
|
|
[bw (rnrs arithmetic bitwise (6))]
|
|
[fx (rnrs arithmetic fixnums (6))]
|
|
[fl (rnrs arithmetic flonums (6))]
|
|
[ht (rnrs hashtables (6))]
|
|
[ip (rnrs io ports (6))]
|
|
[en (rnrs enums (6))]
|
|
[co (rnrs conditions (6))]
|
|
[ri (rnrs records inspection (6))]
|
|
[rp (rnrs records procedural (6))]
|
|
[rs (rnrs records syntactic (6))]
|
|
))
|
|
|
|
(define status-names
|
|
'(
|
|
[S scheduled]
|
|
[D deferred]
|
|
[C completed]
|
|
[X killed]
|
|
))
|
|
|
|
(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 D ba se]
|
|
[append C ba se]
|
|
[apply C ba se]
|
|
[asin C ba se]
|
|
[assert C ba]
|
|
[assertion-violation S 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? D 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 S 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 D 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 D ba se]
|
|
[make-polar D ba se]
|
|
[make-rectangular D 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 D 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 D bw]
|
|
[bitwise-and D bw]
|
|
[bitwise-ior D bw]
|
|
[bitwise-xor D bw]
|
|
[bitwise-bit-count D bw]
|
|
[bitwise-bit-field D bw]
|
|
[bitwise-bit-set? D bw]
|
|
[bitwise-copy-bit D bw]
|
|
[bitwise-copy-bit-field D bw]
|
|
[bitwise-first-bit-set D bw]
|
|
[bitwise-if D bw]
|
|
[bitwise-length D bw]
|
|
[bitwise-reverse-bit-field D bw]
|
|
[bitwise-rotate-bit-field D bw]
|
|
;;;
|
|
[fixnum? C fx]
|
|
[fx* C fx]
|
|
[fx*/carry D fx]
|
|
[fx+ C fx]
|
|
[fx+/carry D fx]
|
|
[fx- C fx]
|
|
[fx-/carry D 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 D fx]
|
|
[fxbit-field D fx]
|
|
[fxbit-set? D fx]
|
|
[fxcopy-bit D fx]
|
|
[fxcopy-bit-field D fx]
|
|
[fxdiv D fx]
|
|
[fxdiv-and-mod D fx]
|
|
[fxdiv0 D fx]
|
|
[fxdiv0-and-mod0 D fx]
|
|
[fxeven? C fx]
|
|
[fxfirst-bit-set D fx]
|
|
[fxif D fx]
|
|
[fxior C fx]
|
|
[fxlength D fx]
|
|
[fxmax C fx]
|
|
[fxmin C fx]
|
|
[fxmod D fx]
|
|
[fxmod0 D fx]
|
|
[fxnegative? C fx]
|
|
[fxnot C fx]
|
|
[fxodd? C fx]
|
|
[fxpositive? C fx]
|
|
[fxreverse-bit-field D fx]
|
|
[fxrotate-bit-field D 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 D fl]
|
|
[fldiv-and-mod D fl]
|
|
[fldiv0 D fl]
|
|
[fldiv0-and-mod0 D 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 D fl]
|
|
[flmod0 D 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 D fl]
|
|
[make-no-infinities-violation X fl]
|
|
[make-no-nans-violation X fl]
|
|
[&no-infinities X fl]
|
|
[no-infinities-violation? X fl]
|
|
[&no-nans X fl]
|
|
[no-nans-violation? X 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 S bv]
|
|
[bytevector-ieee-double-native-set! S bv]
|
|
[bytevector-ieee-double-ref S bv]
|
|
[bytevector-ieee-single-native-ref S bv]
|
|
[bytevector-ieee-single-native-set! S bv]
|
|
[bytevector-ieee-single-ref S 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 S bv]
|
|
[bytevector-s64-native-set! S bv]
|
|
[bytevector-s64-ref S bv]
|
|
[bytevector-s64-set! S 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 S bv]
|
|
[bytevector-u64-native-set! S bv]
|
|
[bytevector-u64-ref S bv]
|
|
[bytevector-u64-set! S 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 S bv]
|
|
[u8-list->bytevector C bv]
|
|
[uint-list->bytevector C bv]
|
|
[utf8->string S bv]
|
|
[utf16->string S bv]
|
|
[utf32->string S bv]
|
|
;;;
|
|
[condition? X co]
|
|
[&assertion X co]
|
|
[assertion-violation? X co]
|
|
[&condition X co]
|
|
[condition X co]
|
|
[condition-accessor X co]
|
|
[condition-irritants X co]
|
|
[condition-message X co]
|
|
[condition-predicate X co]
|
|
[condition-who X co]
|
|
[define-condition-type X co]
|
|
[&error X co]
|
|
[error? X co]
|
|
[&implementation-restriction X co]
|
|
[implementation-restriction-violation? X co]
|
|
[&irritants X co]
|
|
[irritants-condition? X co]
|
|
[&lexical X co]
|
|
[lexical-violation? X co]
|
|
[make-assertion-violation X co]
|
|
[make-error X co]
|
|
[make-implementation-restriction-violation X co]
|
|
[make-irritants-condition X co]
|
|
[make-lexical-violation X co]
|
|
[make-message-condition X co]
|
|
[make-non-continuable-violation X co]
|
|
[make-serious-condition X co]
|
|
[make-syntax-violation X co]
|
|
[make-undefined-violation X co]
|
|
[make-violation X co]
|
|
[make-warning X co]
|
|
[make-who-condition X co]
|
|
[&message X co]
|
|
[message-condition? X co]
|
|
[&non-continuable X co]
|
|
[non-continuable-violation? X co]
|
|
[&serious X co]
|
|
[serious-condition? X co]
|
|
[simple-conditions X co]
|
|
[&syntax X co]
|
|
[syntax-violation X co sc]
|
|
[syntax-violation-form X co]
|
|
[syntax-violation-subform X co]
|
|
[syntax-violation? X co]
|
|
[&undefined X co]
|
|
[undefined-violation? X co]
|
|
[&violation X co]
|
|
[violation? X co]
|
|
[&warning X co]
|
|
[warning? X co]
|
|
[&who X co]
|
|
[who-condition? X co]
|
|
;;;
|
|
[case-lambda C ct]
|
|
[do C ct se ne]
|
|
[unless C ct]
|
|
[when C ct]
|
|
;;;
|
|
[define-enumeration D en]
|
|
[enum-set->list D en]
|
|
[enum-set-complement D en]
|
|
[enum-set-constructor D en]
|
|
[enum-set-difference D en]
|
|
[enum-set-indexer D en]
|
|
[enum-set-intersection D en]
|
|
[enum-set-member? D en]
|
|
[enum-set-projection D en]
|
|
[enum-set-subset? D en]
|
|
[enum-set-union D en]
|
|
[enum-set-universe D en]
|
|
[enum-set=? D en]
|
|
[make-enumeration D en]
|
|
;;;
|
|
[environment C ev]
|
|
[eval C ev se]
|
|
;;;
|
|
[raise X ex]
|
|
[raise-continuable X ex]
|
|
[with-exception-handler X ex]
|
|
[guard X ex]
|
|
;;;
|
|
[binary-port? D ip]
|
|
[buffer-mode D ip]
|
|
[buffer-mode? D ip]
|
|
[bytevector->string D ip]
|
|
[call-with-bytevector-output-port D ip]
|
|
[call-with-port D ip]
|
|
[call-with-string-output-port D 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 S ls]
|
|
[fold-right S ls]
|
|
[for-all S ls]
|
|
[exists S 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 D ip]
|
|
[eol-style D ip]
|
|
[error-handling-mode D ip]
|
|
[file-options D ip]
|
|
[flush-output-port D ip]
|
|
[get-bytevector-all D ip]
|
|
[get-bytevector-n D ip]
|
|
[get-bytevector-n! D ip]
|
|
[get-bytevector-some D ip]
|
|
[get-char D ip]
|
|
[get-datum D ip]
|
|
[get-line D ip]
|
|
[get-string-all D ip]
|
|
[get-string-n D ip]
|
|
[get-string-n! D ip]
|
|
[get-u8 D ip]
|
|
[&i/o X ip is fi]
|
|
[&i/o-decoding X ip]
|
|
[i/o-decoding-error? X ip]
|
|
[&i/o-encoding X ip]
|
|
[i/o-encoding-error-char X ip]
|
|
[i/o-encoding-error? X ip]
|
|
[i/o-error-filename X ip is fi]
|
|
[i/o-error-port X ip is fi]
|
|
[i/o-error? X ip is fi]
|
|
[&i/o-file-already-exists X ip is fi]
|
|
[i/o-file-already-exists-error? X ip is fi]
|
|
[&i/o-file-does-not-exist X ip is fi]
|
|
[i/o-file-does-not-exist-error? X ip is fi]
|
|
[&i/o-file-is-read-only X ip is fi]
|
|
[i/o-file-is-read-only-error? X ip is fi]
|
|
[&i/o-file-protection X ip is fi]
|
|
[i/o-file-protection-error? X ip is fi]
|
|
[&i/o-filename X ip is fi]
|
|
[i/o-filename-error? X ip is fi]
|
|
[&i/o-invalid-position X ip is fi]
|
|
[i/o-invalid-position-error? X ip is fi]
|
|
[&i/o-port X ip is fi]
|
|
[i/o-port-error? X ip is fi]
|
|
[&i/o-read X ip is fi]
|
|
[i/o-read-error? X ip is fi]
|
|
[&i/o-write X ip is fi]
|
|
[i/o-write-error? X ip is fi]
|
|
[lookahead-char D ip]
|
|
[lookahead-u8 D ip]
|
|
[make-bytevector C bv]
|
|
[make-custom-binary-input-port D ip]
|
|
[make-custom-binary-input/output-port D ip]
|
|
[make-custom-binary-output-port D ip]
|
|
[make-custom-textual-input-port D ip]
|
|
[make-custom-textual-input/output-port D ip]
|
|
[make-custom-textual-output-port D ip]
|
|
[make-i/o-decoding-error X ip]
|
|
[make-i/o-encoding-error X ip]
|
|
[make-i/o-error X ip is fi]
|
|
[make-i/o-file-already-exists-error X ip is fi]
|
|
[make-i/o-file-does-not-exist-error X ip is fi]
|
|
[make-i/o-file-is-read-only-error X ip is fi]
|
|
[make-i/o-file-protection-error X ip is fi]
|
|
[make-i/o-filename-error X ip is fi]
|
|
[make-i/o-invalid-position-error X ip is fi]
|
|
[make-i/o-port-error X ip is fi]
|
|
[make-i/o-read-error X ip is fi]
|
|
[make-i/o-write-error X ip is fi]
|
|
[latin-1-codec D ip]
|
|
[make-transcoder D ip]
|
|
[native-eol-style D ip]
|
|
[native-transcoder D ip]
|
|
[open-bytevector-input-port D ip]
|
|
[open-bytevector-output-port D ip]
|
|
[open-file-input-port D ip]
|
|
[open-file-input/output-port D ip]
|
|
[open-file-output-port D ip]
|
|
[open-string-input-port D ip]
|
|
[open-string-output-port D ip]
|
|
[output-port-buffer-mode D ip]
|
|
[port-eof? D ip]
|
|
[port-has-port-position? D ip]
|
|
[port-has-set-port-position!? D ip]
|
|
[port-position D ip]
|
|
[port-transcoder D ip]
|
|
[port? D ip]
|
|
[put-bytevector D ip]
|
|
[put-char D ip]
|
|
[put-datum D ip]
|
|
[put-string D ip]
|
|
[put-u8 D ip]
|
|
[set-port-position! D ip]
|
|
[standard-error-port D ip]
|
|
[standard-input-port D ip]
|
|
[standard-output-port D ip]
|
|
[string->bytevector D ip]
|
|
[textual-port? D ip]
|
|
[transcoded-port D ip]
|
|
[transcoder-codec D ip]
|
|
[transcoder-eol-style D ip]
|
|
[transcoder-error-handling-mode D ip]
|
|
[utf-16-codec D ip]
|
|
[utf-8-codec D 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! S ht]
|
|
[hashtable-contains? S ht]
|
|
[hashtable-copy S ht]
|
|
[hashtable-delete! S ht]
|
|
[hashtable-entries S ht]
|
|
[hashtable-keys S ht]
|
|
[hashtable-mutable? S ht]
|
|
[hashtable-ref S ht]
|
|
[hashtable-set! S ht]
|
|
[hashtable-size S ht]
|
|
[hashtable-update! S ht]
|
|
[hashtable? S ht]
|
|
[make-eq-hashtable S ht]
|
|
[make-eqv-hashtable S ht]
|
|
[hashtable-hash-function D ht]
|
|
[make-hashtable D ht]
|
|
[hashtable-equivalence-function D ht]
|
|
[equal-hash D ht]
|
|
[string-hash D ht]
|
|
[string-ci-hash D ht]
|
|
[symbol-hash D ht]
|
|
;;;
|
|
[list-sort C sr]
|
|
[vector-sort C sr]
|
|
[vector-sort! C sr]
|
|
;;;
|
|
[file-exists? C fi]
|
|
[delete-file C fi]
|
|
;;;
|
|
[define-record-type X rs]
|
|
[fields X rs]
|
|
[immutable X rs]
|
|
[mutable X rs]
|
|
[opaque X rs]
|
|
[parent X rs]
|
|
[parent-rtd X rs]
|
|
[protocol X rs]
|
|
[record-constructor-descriptor X rs]
|
|
[record-type-descriptor X rs]
|
|
[sealed X rs]
|
|
[nongenerative X rs]
|
|
;;;
|
|
[record-field-mutable? X ri]
|
|
[record-rtd X ri]
|
|
[record-type-field-names X ri]
|
|
[record-type-generative? X ri]
|
|
[record-type-name X ri]
|
|
[record-type-opaque? X ri]
|
|
[record-type-parent X ri]
|
|
[record-type-sealed? X ri]
|
|
[record-type-uid X ri]
|
|
[record? X ri]
|
|
;;;
|
|
[make-record-constructor-descriptor X rp]
|
|
[make-record-type-descriptor X rp]
|
|
[record-accessor X rp]
|
|
[record-constructor X rp]
|
|
[record-mutator X rp]
|
|
[record-predicate X rp]
|
|
[record-type-descriptor? X 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 S 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? D ]
|
|
[interaction-environment D ]
|
|
[load D ]
|
|
;;;
|
|
))
|
|
|
|
|
|
(define (no-dups ls)
|
|
(unless (null? ls)
|
|
(when (memq (car ls) (cdr ls))
|
|
(error #f "duplicate ~s" (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 id ~s" 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)]))
|
|
|
|
(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 80)])
|
|
(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")
|
|
(for-each
|
|
(lambda (x)
|
|
(printf " ~a ~a (~s ids)\n" (car x) (cadr x)
|
|
(count-status (car x))))
|
|
status-names)]
|
|
[else
|
|
(let-values ([(s* l*)
|
|
(split
|
|
(lambda (x)
|
|
(cond
|
|
[(assq x status-names) #t]
|
|
[(assq x library-names) #f]
|
|
[else (error #f "invalid argument ~a" 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))))]
|
|
))
|
|
|