#!/usr/bin/env ikarus --r6rs-script (import (ikarus)) ;;; library names: (define library-names '( [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))] [r5 (rnrs r5rs (6))] [se (scheme-report-environment)] )) (define status-names '( [S scheduled] [D deferred] [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 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] [complex? D ba se] [cons C ba se] [cos C ba se] [denominator C ba se] [div S ba] [div-and-mod S ba] [div0 S ba] [div0-and-mod0 S ba] [dynamic-wind C ba se] [eq? C ba se] [equal? S 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 S ba se] [expt C ba se] [finite? S 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? S ba] [integer->char C ba se] [integer-valued? S 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] [mod S ba] [mod0 S ba] [nan? S 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? S ba] [rational? C ba se] [rationalize S ba se] [real-part D ba se] [real-valued? S ba] [real? S 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] [substring C ba se] [symbol->string C ba se] [symbol=? C ba] [symbol? C ba se] [tan C ba se] [truncate S 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-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 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 S fl] [flcos C 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 C fl] [flsqrt S fl] [fltan C 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 C bv] [bytevector-s16-native-set! C bv] [bytevector-s16-ref C bv] [bytevector-s16-set! C 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 C bv] [bytevector-u16-native-set! C bv] [bytevector-u16-ref C bv] [bytevector-u16-set! C 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 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? 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 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 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 se] [assp C ls] [assq C ls se] [assv C ls se] [cons* C 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 se] [memp C ls] [memq C ls se] [memv C ls se] [partition S ls] [remove S ls] [remp S ls] [remq S ls] [remv S 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 S 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 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 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 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 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 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 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? S 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? S uc se] [char-numeric? S uc se] [char-title-case? S uc] [char-upper-case? S uc se] [char-whitespace? 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 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))))] ))