* Added delete-file.

src/ikarus.io-ports.ss

@@ -1,6 +1,6 @@
 
 (library (ikarus io-ports)
-  (export make-input-port make-output-port ;make-input/output-port
+  (export make-input-port make-output-port 
           port-handler
           port-input-buffer  port-output-buffer 
           port-input-index   set-port-input-index!
@@ -14,7 +14,6 @@
     (ikarus system $fx)
     (except (ikarus)  
          make-input-port make-output-port 
-         ;make-input/output-port 
          port-handler
          port-input-buffer  port-output-buffer
          port-input-index   set-port-input-index!
@@ -27,7 +26,6 @@
   ;;; * Constructors:
   ;;;   (make-input-port handler input-buffer)
   ;;;   (make-output-port handler output-buffer)
-  ;;;   (make-input/output-port handler input-buffer output-buffer)
   ;;;
   ;;; * Predicates:
   ;;;   (port? x)
@@ -36,22 +34,13 @@
   ;;;
   ;;; * Accessors:
   ;;;   (port-handler port)
-  ;;;   (port-input-buffer port)
+  ;;;   (port-buffer port)
-  ;;;   (port-input-index port)
+  ;;;   (port-index port)
-  ;;;   (port-input-size port)
+  ;;;   (port-size port)
-  ;;;   (port-output-buffer port)
-  ;;;   (port-output-index port)
-  ;;;   (port-output-size port)
   ;;;
   ;;; * Mutators:
-  ;;;   (set-port-handler! port proc)
+  ;;;   (set-port-index! port fixnum)
-  ;;;   (set-port-input-buffer! port string)
+  ;;;   (set-port-size! port fixnum)
-  ;;;   (set-port-input-index! port fixnum)
-  ;;;   (set-port-input-size! port fixnum)
-  ;;;   (set-port-output-buffer! port string)
-  ;;;   (set-port-output-index! port fixnum)
-  ;;;   (set-port-output-size! port fixnum)
-  ;;;
   ;;;
   (define $make-input-port
     (lambda (handler buffer)
@@ -170,3 +159,6 @@
                   (error 'set-port-output-size! "size ~s is negative" i))
               (error 'set-port-output-size! "~s is not a valid size" i))
           (error 'set-port-output-size! "~s is not an output-port" p)))))
+
+
+

src/makefile.ss

@@ -467,7 +467,6 @@
     [make-guardian           i]
     [make-input-port         i]
     [make-output-port        i]
-    [make-input/output-port  i]
     [port-output-index       i]
     [port-output-size        i]
     [port-output-buffer      i]
@@ -507,6 +506,7 @@
     [flush-output-port       i]
     [reset-input-port!       i]
     [file-exists?            i]
+    [delete-file             i]
     [display                 i r]
     [write                   i r]
     [write-char              i r]

src/r6rs-todo.ss

@@ -33,21 +33,13 @@
     ))
 
 (define status-names
-  '([D deferred]
+  '(
     [P progress]
     [S scheduled]
     [C completed]
+    [D deferred]
     [U unknown]))
 
-
-
-
-
-
-
-
-
-
 (define identifier-names
   '(
 
@@ -426,7 +418,6 @@
     [condition-message                          D co]
     [condition-predicate                        D co]
     [condition-who                              D co]
-    [condition?                                 D co]
     [define-condition-type                      D co]
     [&error                                     D co]
     [error?                                     D co]
@@ -496,10 +487,7 @@
     [raise                                      D ex]
     [raise-continuable                          D ex]
     [with-exception-handler                     D ex]
-    [with-exception-handler                     D ex]
     [guard                                      D ex]
-    [raise                                      D ex]
-    [raise-continuable                          D ex]
 
     [binary-port?                               D ip]
     [buffer-mode                                D ip]
@@ -509,7 +497,6 @@
     [call-with-port                             D ip]
     [call-with-string-output-port               D ip]
 
-
     [assoc                                      C ls]
     [assp                                       S ls]
     [assq                                       C ls]
@@ -678,8 +665,6 @@
     [hashtable-copy                             S ht]
     [hashtable-delete!                          S ht]
     [hashtable-entries                          S ht]
-    [hashtable-equivalence-function             S ht]
-    [hashtable-hash-function                    S ht]
     [hashtable-keys                             S ht]
     [hashtable-mutable?                         S ht]
     [hashtable-ref                              S ht]
@@ -689,7 +674,9 @@
     [hashtable?                                 S ht]
     [make-eq-hashtable                          S ht]
     [make-eqv-hashtable                         S ht]
-    [make-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]
@@ -700,7 +687,7 @@
     [vector-sort!                               S sr]
 
     [file-exists?                               C fi]
-    [delete-file                                S fi]
+    [delete-file                                C fi]
 
     [define-record-type                         D rs]
     [fields                                     D rs]
@@ -779,3 +766,93 @@
     [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 (print-ids ls) 
+  (define (split ls n) 
+    (cond
+      [(null? ls) (values '() '())]
+      [(> (string-length (symbol->string (car ls))) n) 
+       (values '() ls)]
+      [else
+       (let-values ([(fst rest) 
+                     (split (cdr ls) 
+                        (- n 
+                           (string-length (symbol->string (car ls)))
+                           1))])
+         (values (cons (car ls) fst) rest))]))
+  (unless (null? ls) 
+    (let-values ([(ls rest) 
+                  (split ls 80)])
+      (for-each
+        (lambda (x)
+          (printf "~s " x))
+        ls)
+      (newline) 
+      (print-ids rest))))
+
+(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\n" (car x) (cadr 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 ([ls (filter* (map string->symbol args))])
+       (printf "~s identifiers\n" (length ls))
+       (print-ids (map car ls)))]
+    ))
+