ikarus/src/todo-r6rs.ss

930 lines
42 KiB
Scheme
Executable File

#!/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]
[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]
[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 S 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]
[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]
[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-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-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 (<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))))]
))