#!/usr/bin/env ikarus --r6rs-script (import (ikarus)) ;;; library names: (define library-names '( [ct (rnrs control (6))] [ev (rnrs eval (6))] [fi (rnrs files (6))] [pr (rnrs programs (6))] [mp (rnrs mutable-pairs (6))] [ms (rnrs mutable-strings (6))] [ba (rnrs base (6))] [ls (rnrs lists (6))] [is (rnrs io simple (6))] [bv (rnrs bytevectors (6))] [sr (rnrs sorting (6))] [sc (rnrs syntax-case (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))] [r5 (rnrs r5rs (6))] )) (define status-names '( [S scheduled] [D deferred] [C completed] )) (define identifier-names '( [lambda C ba] [and C ba] [begin C ba] [case C ba] [cond C ba] [define C ba] [define-syntax C ba] [identifier-syntax C ba] [if C ba] [let C ba] [let* C ba] [let*-values C ba] [let-syntax C ba] [let-values C ba] [letrec C ba] [letrec* C ba] [letrec-syntax C ba] [or C ba] [quasiquote C ba] [quote C ba] [set! C ba] [syntax-rules C ba] [unquote C ba] [unquote-splicing C ba] [< C ba] [<= C ba] [= C ba] [> C ba] [>= C ba] [+ C ba] [- C ba] [* C ba] [/ C ba] [abs C ba] [acos S ba] [angle D ba] [append C ba] [apply C ba] [asin S ba] [assert S ba] [assertion-violation S ba] [atan S ba] [boolean=? C ba] [boolean? C ba] [car C ba] [cdr C ba] [caar C ba] [cadr C ba] [cdar C ba] [cddr C ba] [caaar C ba] [caadr C ba] [cadar C ba] [caddr C ba] [cdaar C ba] [cdadr C ba] [cddar C ba] [cdddr C ba] [caaaar C ba] [caaadr C ba] [caadar C ba] [caaddr C ba] [cadaar C ba] [cadadr C ba] [caddar C ba] [cadddr C ba] [cdaaar C ba] [cdaadr C ba] [cdadar C ba] [cdaddr C ba] [cddaar C ba] [cddadr C ba] [cdddar C ba] [cddddr C ba] [call-with-current-continuation C ba] [call/cc C ba] [call-with-values C ba] [ceiling C ba] [char->integer C ba] [char<=? C ba] [char=? C ba] [char>? C ba] [char? C ba] [complex? D ba] [cons C ba] [cos C ba] [denominator C ba] [div S ba] [div-and-mod S ba] [div0 S ba] [div0-and-mod0 S ba] [dynamic-wind C ba] [eq? C ba] [equal? S ba] [eqv? C ba] [error S ba] [even? C ba] [exact S ba] [exact-integer-sqrt C ba] [exact? C ba] [exp S ba] [expt C ba] [finite? S ba] [floor S ba] [for-each S ba] [gcd C ba] [imag-part D ba] [inexact S ba] [inexact? S ba] [infinite? S ba] [integer->char C ba] [integer-valued? S ba] [integer? C ba] [lcm C ba] [length C ba] [list C ba] [list->string C ba] [list->vector C ba] [list-ref C ba] [list-tail C ba] [list? C ba] [log C ba] [magnitude D ba] [make-polar D ba] [make-rectangular D ba] [make-string C ba] [make-vector C ba] [map C ba] [max C ba] [min C ba] [mod S ba] [mod0 S ba] [nan? S ba] [negative? S ba] [not C ba] [null? C ba] [number->string C ba] [number? C ba] [numerator C ba] [odd? C ba] [pair? C ba] [positive? C ba] [procedure? C ba] [rational-valued? S ba] [rational? C ba] [rationalize S ba] [real-part D ba] [real-valued? S ba] [real? S ba] [reverse C ba] [round C ba] [sin C ba] [sqrt C ba] [string C ba] [string->list C ba] [string->number C ba] [string->symbol C ba] [string-append C ba] [string-copy C ba] [string-for-each S ba] [string-length C ba] [string-ref C ba] [string<=? C ba] [string=? C ba] [string>? C ba] [string? C ba] [substring C ba] [symbol->string C ba] [symbol=? C ba] [symbol? C ba] [tan S ba] [truncate S ba] [values C ba] [vector C ba] [vector->list C ba] [vector-fill! S ba] [vector-for-each C ba] [vector-length C ba] [vector-map C ba] [vector-ref C ba] [vector-set! C ba] [vector? C ba] [zero? C ba] [... C ba sc] [=> C ba ex] [_ C ba sc] [else C ba ex] [bitwise-and D bw] [bitwise-arithmetic-shift D bw] [bitwise-arithmetic-shift-left D bw] [bitwise-arithmetic-shift-right 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-ior D bw] [bitwise-length D bw] [bitwise-not D bw] [bitwise-reverse-bit-field D bw] [bitwise-rotate-bit-field D bw] [bitwise-xor D bw] [fixnum? C fx] [fx* D fx] [fx*/carry D fx] [fx+ D fx] [fx+/carry D fx] [fx- D fx] [fx-/carry D fx] [fx<=? D fx] [fx=? D fx] [fx>? D fx] [fxand D fx] [fxarithmetic-shift D fx] [fxarithmetic-shift-left D fx] [fxarithmetic-shift-right D 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? D fx] [fxfirst-bit-set D fx] [fxif D fx] [fxior D fx] [fxlength D fx] [fxmax D fx] [fxmin D fx] [fxmod D fx] [fxmod0 D fx] [fxnegative? D fx] [fxnot D fx] [fxodd? D fx] [fxpositive? D fx] [fxreverse-bit-field D fx] [fxrotate-bit-field D fx] [fxxor D fx] [fxzero? D fx] [fixnum->flonum S 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 S fl] [flasin S fl] [flatan S fl] [flceiling S fl] [flcos S fl] [fldenominator S fl] [fldiv S fl] [fldiv-and-mod S fl] [fldiv0 S fl] [fldiv0-and-mod0 S fl] [fleven? S fl] [flexp S fl] [flexpt S fl] [flfinite? S fl] [flfloor S fl] [flinfinite? S fl] [flinteger? S fl] [fllog S fl] [flmax C fl] [flmin C fl] [flmod S fl] [flmod0 S fl] [flnan? S fl] [flnegative? S fl] [flnumerator S fl] [flodd? S fl] [flonum? S fl] [flpositive? S fl] [flround C fl] [flsin S fl] [flsqrt S fl] [fltan S fl] [fltruncate S fl] [flzero? C fl] [real->flonum D fl] [make-no-infinities-violation D fl] [make-no-nans-violation D fl] [&no-infinities D fl] [no-infinities-violation? D fl] [&no-nans D fl] [no-nans-violation? D 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 S bv] [bytevector-s16-native-set! S bv] [bytevector-s16-ref S bv] [bytevector-s16-set! S bv] [bytevector-s32-native-ref S bv] [bytevector-s32-native-set! S bv] [bytevector-s32-ref S bv] [bytevector-s32-set! S 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 S bv] [bytevector-u16-native-set! S bv] [bytevector-u16-ref S bv] [bytevector-u16-set! S bv] [bytevector-u32-native-ref S bv] [bytevector-u32-native-set! S bv] [bytevector-u32-ref S bv] [bytevector-u32-set! S 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 S bv] [native-endianness S 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? D co] [&assertion D co] [assertion-violation? D co] [&condition D co] [condition D co] [condition-accessor D co] [condition-irritants D co] [condition-message D co] [condition-predicate D co] [condition-who D co] [define-condition-type D co] [&error D co] [error? D co] [&implementation-restriction D co] [implementation-restriction-violation? D co] [&irritants D co] [irritants-condition? D co] [&lexical D co] [lexical-violation? D co] [make-assertion-violation D co] [make-error D co] [make-implementation-restriction-violation D co] [make-irritants-condition D co] [make-lexical-violation D co] [make-message-condition D co] [make-non-continuable-violation D co] [make-serious-condition D co] [make-syntax-violation D co] [make-undefined-violation D co] [make-violation D co] [make-warning D co] [make-who-condition D co] [&message D co] [message-condition? D co] [&non-continuable D co] [non-continuable-violation? D co] [&serious D co] [serious-condition? D co] [simple-conditions D co] [&syntax D co] [syntax-violation D co sc] [syntax-violation-form D co] [syntax-violation-subform D co] [syntax-violation? D co] [&undefined D co] [undefined-violation? D co] [&violation D co] [violation? D co] [&warning D co] [warning? D co] [&who D co] [who-condition? D co] [case-lambda C ct] [do C ct] [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] [raise S ex] [raise-continuable S ex] [with-exception-handler S ex] [guard S 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] [assp S ls] [assq C ls] [assv C ls] [cons* S ls] [filter S ls] [find S ls] [fold-left S ls] [fold-right S ls] [for-all S ls] [exists S ls] [member C ls] [memp S ls] [memq C ls] [memv C ls] [partition S ls] [remove C ls] [remp S ls] [remq C ls] [remv C ls] [set-car! C mp] [set-cdr! C mp] [string-set! C ms] [string-fill! S ms] [command-line C pr] [exit C pr] [delay D r5] [exact->inexact D r5] [force D r5] [inexact->exact D r5] [modulo D r5] [remainder D r5] [null-environment D r5] [quotient D r5] [scheme-report-environment D r5] [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 D ip is fi] [&i/o-decoding D ip] [i/o-decoding-error? D ip] [&i/o-encoding D ip] [i/o-encoding-error-char D ip] [i/o-encoding-error? D ip] [i/o-error-filename D ip is fi] [i/o-error-port D ip is fi] [i/o-error? D ip is fi] [&i/o-file-already-exists D ip is fi] [i/o-file-already-exists-error? D ip is fi] [&i/o-file-does-not-exist D ip is fi] [i/o-file-does-not-exist-error? D ip is fi] [&i/o-file-is-read-only D ip is fi] [i/o-file-is-read-only-error? D ip is fi] [&i/o-file-protection D ip is fi] [i/o-file-protection-error? D ip is fi] [&i/o-filename D ip is fi] [i/o-filename-error? D ip is fi] [&i/o-invalid-position D ip is fi] [i/o-invalid-position-error? D ip is fi] [&i/o-port D ip is fi] [i/o-port-error? D ip is fi] [&i/o-read D ip is fi] [i/o-read-error? D ip is fi] [&i/o-write D ip is fi] [i/o-write-error? D ip is fi] [lookahead-char D ip] [lookahead-u8 D ip] [make-bytevector D 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 D ip] [make-i/o-encoding-error D ip] [make-i/o-error D ip is fi] [make-i/o-file-already-exists-error D ip is fi] [make-i/o-file-does-not-exist-error D ip is fi] [make-i/o-file-is-read-only-error D ip is fi] [make-i/o-file-protection-error D ip is fi] [make-i/o-filename-error D ip is fi] [make-i/o-invalid-position-error D ip is fi] [make-i/o-port-error D ip is fi] [make-i/o-read-error D ip is fi] [make-i/o-write-error D 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] [output-port? C is ip] [current-input-port C ip is] [current-output-port C ip is] [current-error-port C ip is] [eof-object C ip is] [eof-object? C ip is] [close-input-port C is] [close-output-port C is] [display C is] [newline C is] [open-input-file C is] [open-output-file C is] [peek-char C is] [read C is] [read-char C is] [with-input-from-file C is] [with-output-to-file C is] [write C is] [write-char C is] [call-with-input-file C is] [call-with-output-file C is] [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 S sr] [vector-sort S sr] [vector-sort! S sr] [file-exists? C fi] [delete-file C fi] [define-record-type D rs] [fields D rs] [immutable D rs] [mutable D rs] [opaque D rs] [parent D rs] [parent-rtd D rs] [protocol D rs] [record-constructor-descriptor D rs] [record-type-descriptor D rs] [sealed D rs] [nongenerative D rs] [record-field-mutable? D ri] [record-rtd D ri] [record-type-field-names D ri] [record-type-generative? D ri] [record-type-name D ri] [record-type-opaque? D ri] [record-type-parent D ri] [record-type-sealed? D ri] [record-type-uid D ri] [record? D ri] [make-record-constructor-descriptor D rp] [make-record-type-descriptor D rp] [record-accessor D rp] [record-constructor D rp] [record-mutator D rp] [record-predicate D rp] [record-type-descriptor? D rp] [bound-identifier=? C sc] [datum->syntax C sc] [syntax C sc] [syntax->datum C sc] [syntax-case C sc] [unsyntax S sc] [unsyntax-splicing S sc] [quasisyntax S sc] [with-syntax C sc] [free-identifier=? C sc] [generate-temporaries C sc] [identifier? C sc] [make-variable-transformer S sc] [char-alphabetic? S uc] [char-ci<=? C uc] [char-ci=? C uc] [char-ci>? C uc] [char-downcase C uc] [char-foldcase C uc] [char-titlecase C uc] [char-upcase C uc] [char-general-category S uc] [char-lower-case? S uc] [char-numeric? S uc] [char-title-case? S uc] [char-upper-case? S uc] [char-whitespace? C uc] [string-ci<=? S uc] [string-ci=? S uc] [string-ci>? S uc] [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] )) (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) 3) (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 p? ls) (cond [(null? ls) '()] [(p? (car ls)) (cons (car ls) (filter p? (cdr ls)))] [else (filter p? (cdr ls))])) (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 (|)*\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))))] ))