[Wisp-cvs] wisp/src/builtin filing.wisp,1.106,1.107 records.wisp,1.7,1.8

[<di...@us...>]

Update of /cvsroot/wisp/wisp/src/builtin
In directory usw-pr-cvs1:/tmp/cvs-serv32183/src/builtin

Modified Files:
	filing.wisp records.wisp 
Log Message:
Added the |read-char| and |write-char| dispatcher slots to record types.

Index: filing.wisp
===================================================================
RCS file: /cvsroot/wisp/wisp/src/builtin/filing.wisp,v
retrieving revision 1.106
retrieving revision 1.107
diff -u -d -r1.106 -r1.107
--- filing.wisp	7 Sep 2002 22:03:56 -0000	1.106
+++ filing.wisp	18 Sep 2002 21:10:02 -0000	1.107
@@ -115,8 +115,8 @@
                         '#f))
                     (else ; got some--analyse this
                       (loop len))))))))))
-  (friend (read-char port (block? #t))
-    (my ch (peek-char port block?)
+  (friend (%read-char port)
+    (my ch (peek-char port #t)
       (if (char? ch)
         (incr! start))
       ch))
@@ -219,6 +219,11 @@
   (friend (file-descriptor port)
     fd))
 
+(define (read-char (port *stdin*))
+  (if (instance? port)
+    (%read-char port)
+    (((asm NN_pr_record_type_read_char_slot) (type-of port)) port)))
+
 (define (construct-filename dir base)
   (cond
     ((not dir)            base)
@@ -432,8 +437,27 @@
   (write object port)
   (newline port))
 
-(define (write-char object (port *stdout*))
-  (write-string (string object) port))
+(define (read-char (port *stdin*))
+  (if (instance? port)
+    (%read-char port)
+    (((asm NN_pr_record_type_read_char_slot) (type-of port)) port)))
+
+; Note that Scheme's |write-char| takes the port argument *last*;
+; most likely because it's been historically easier to implement
+; optional arguments at the end of the argument list.  This does
+; not work well with the idea that the object argument (upon which
+; dispatching is decided) should be the first, so we're going to
+; change it.  During the conversion period, *both* orderings are
+; allowed.
+(define (write-char (port *stdout*) object)
+  (if (char? port)
+    (my x port
+      (set! port object)
+      (set! object x)))
+  (if (instance? port)
+    (write-string (string object) port)
+    (((asm NN_pr_record_type_write_char_slot) (type-of port))
+      port object)))
 
 (define (newline (port *stdout*))
   (write-char #\newline port)

Index: records.wisp
===================================================================
RCS file: /cvsroot/wisp/wisp/src/builtin/records.wisp,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -d -r1.7 -r1.8
--- records.wisp	18 Sep 2002 21:09:00 -0000	1.7
+++ records.wisp	18 Sep 2002 21:10:02 -0000	1.8
@@ -11,20 +11,28 @@
     (let ((record-type (car data))
           (ref-hook #f)
           (length-hook #f)
-          (new-hook #f))
+          (new-hook #f)
+          (read-char-hook #f)
+          (write-char-hook #f))
       (while (not (null? hooks))
         (my (hook-name hook-generator . rest-hooks) hooks
           (set! hooks rest-hooks)
           (case hook-name
-            ((ref)    (if ref-hook
-                        (raise 'duplicate-ref-hook hook-generator)
-                        (set! ref-hook (apply hook-generator data))))
-            ((length) (if length-hook
-                        (raise 'duplicate-length-hook hook-generator)
-                        (set! length-hook (apply hook-generator data))))
-            ((new)    (if new-hook
-                        (raise 'duplicate-new-hook hook-generator)
-                        (set! new-hook (apply hook-generator data))))
+            ((ref)        (if ref-hook
+                            (raise 'duplicate-ref-hook hook-generator)
+                            (set! ref-hook (apply hook-generator data))))
+            ((length)     (if length-hook
+                            (raise 'duplicate-length-hook hook-generator)
+                            (set! length-hook (apply hook-generator data))))
+            ((new)        (if new-hook
+                            (raise 'duplicate-new-hook hook-generator)
+                            (set! new-hook (apply hook-generator data))))
+            ((read-char)  (if read-char-hook
+                            (raise 'duplicate-read-char-hook hook-generator)
+                            (set! read-char-hook (apply hook-generator data))))
+            ((write-char) (if write-char-hook
+                            (raise 'duplicate-write-char-hook hook-generator)
+                            (set! write-char-hook (apply hook-generator data))))
             (else (raise 'record-hook-name? hook-name)))))
       (if ref-hook
         (set! ((asm NN_pr_record_type_ref_slot) record-type)
@@ -34,5 +42,11 @@
           length-hook))
       (if new-hook
         (set! ((asm NN_pr_record_type_new_slot) record-type)
-          new-hook)))
+          new-hook))
+      (if read-char-hook
+        (set! ((asm NN_pr_record_type_read_char_slot) record-type)
+          read-char-hook))
+      (if write-char-hook
+        (set! ((asm NN_pr_record_type_write_char_slot) record-type)
+          write-char-hook)))
     data))