conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

renamed: 

src/r6rs-todo.ss => src/todo-r6rs.ss
This commit is contained in:
Abdulaziz Ghuloum 2007-08-28 11:11:12 -04:00
parent d0eef4c3c4
commit 8e4adec147
1 changed files with 48 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

75
src/r6rs-todo.ss → src/todo-r6rs.ss
View File

@ -5,40 +5,40 @@
;;; library names: ;;; library names:
(define library-names (define library-names
'([ba (rnrs base (6))] '(
[bw (rnrs arithmetic bitwise (6))]
[fx (rnrs arithmetic fixnums (6))]
[fl (rnrs arithmetic flonums (6))]
[bv (rnrs bytevectors (6))]
[co (rnrs conditions (6))]
[ct (rnrs control (6))] [ct (rnrs control (6))]
[en (rnrs enums (6))]
[ev (rnrs eval (6))] [ev (rnrs eval (6))]
[ex (rnrs exceptions (6))]
[fi (rnrs files (6))] [fi (rnrs files (6))]
[ht (rnrs hashtables (6))] [pr (rnrs programs (6))]
[ip (rnrs io ports (6))]
[is (rnrs io simple (6))]
[ls (rnrs lists (6))]
[mp (rnrs mutable-pairs (6))] [mp (rnrs mutable-pairs (6))]
[ms (rnrs mutable-strings (6))] [ms (rnrs mutable-strings (6))]
[pr (rnrs programs (6))] [ba (rnrs base (6))]
[r5 (rnrs r5rs (6))] [ls (rnrs lists (6))]
[ri (rnrs records inspection (6))] [is (rnrs io simple (6))]
[rp (rnrs records procedural (6))] [bv (rnrs bytevectors (6))]
[rs (rnrs records syntactic (6))]
[sr (rnrs sorting (6))] [sr (rnrs sorting (6))]
[sc (rnrs syntax-case (6))] [sc (rnrs syntax-case (6))]
[uc (rnrs unicode (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 (define status-names
'( '(
[P progress]
[S scheduled] [S scheduled]
[C completed]
[D deferred] [D deferred]
[U unknown])) [C completed]
))
(define identifier-names (define identifier-names
'( '(
@ -138,9 +138,9 @@
[div0-and-mod0 S ba] [div0-and-mod0 S ba]
[dynamic-wind C ba] [dynamic-wind C ba]
[eq? C ba] [eq? C ba]
[equal? P ba] [equal? S ba]
[eqv? C ba] [eqv? C ba]
[error P ba] [error S ba]
[even? C ba] [even? C ba]
[exact S ba] [exact S ba]
[exact-integer-sqrt C ba] [exact-integer-sqrt C ba]
@ -484,10 +484,10 @@
[environment C ev] [environment C ev]
[eval C ev] [eval C ev]
[raise D ex] [raise S ex]
[raise-continuable D ex] [raise-continuable S ex]
[with-exception-handler D ex] [with-exception-handler S ex]
[guard D ex] [guard S ex]
[binary-port? D ip] [binary-port? D ip]
[buffer-mode D ip] [buffer-mode D ip]
@ -859,6 +859,26 @@
[(memq (car ls1) ls2) #f] [(memq (car ls1) ls2) #f]
[else (null-intersection? (cdr ls1) ls2)])) [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 identifier-names))
(no-dups (map car library-names)) (no-dups (map car library-names))
(no-dups (map car status-names)) (no-dups (map car status-names))
@ -873,7 +893,8 @@
(printf "Library Names:\n") (printf "Library Names:\n")
(for-each (for-each
(lambda (x) (lambda (x)
(printf " ~a ~a\n" (car x) (cadr x))) (printf " ~a ~a ~a\n" (car x) (cadr x)
(library-info (car x))))
library-names) library-names)
(printf "Status Codes:\n") (printf "Status Codes:\n")
(for-each (for-each