[Wisp-cvs] wisp/src/builtin ewisp.wisp,1.18,1.19 filing.wisp,1.107,1.108 fluids.wisp,1.2,1.3 init.wisp,1.60,1.61 parser.wisp,1.120,1.121 stdenv.wisp,1.367,1.368

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

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

Modified Files:
	ewisp.wisp filing.wisp fluids.wisp init.wisp parser.wisp 
	stdenv.wisp 
Log Message:
Replaced |*stdin*|, |*stdout*|, and |*stderr*| with |current-input-port|, |current-output-port|, and |current-errors-port|.

Index: ewisp.wisp
===================================================================
RCS file: /cvsroot/wisp/wisp/src/builtin/ewisp.wisp,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -d -r1.18 -r1.19
--- ewisp.wisp	28 Aug 2002 20:05:43 -0000	1.18
+++ ewisp.wisp	18 Sep 2002 21:11:14 -0000	1.19
@@ -6,7 +6,8 @@
 ;;
 ;;;; @(#) $Id$
 
-(define (run-ewisp-file (port *stdin*) (sink *stdout*))
+(define (run-ewisp-file (port (current-input-port))
+                        (sink (current-output-port)))
   (if (string? port)
     (call-with-input-file port (cut run-ewisp-file <> sink))
     (begin

Index: filing.wisp
===================================================================
RCS file: /cvsroot/wisp/wisp/src/builtin/filing.wisp,v
retrieving revision 1.107
retrieving revision 1.108
diff -u -d -r1.107 -r1.108
--- filing.wisp	18 Sep 2002 21:10:02 -0000	1.107
+++ filing.wisp	18 Sep 2002 21:11:14 -0000	1.108
@@ -17,8 +17,6 @@
 (define (raise-unseekable-port port . rest)
   (raise 'unseekable-port port))
 
-(define portio-debugging (list #f))
-
 ;; Some ports communicate with data strings and can seek along them.
 ;; Others communicate with serial sinks and sources that are unseekable.
 ;; Since input buffering is unavoidable, you better assume that reading
@@ -83,8 +81,6 @@
                       (loop)
                       (- stop start)))))))))))
   (friend (ensure-line-in-buffer port newline block?)
-    (if (car portio-debugging)
-      (print *stderr* "ensure-line-in-buffer: $[port] $[newline] $[block?]\n"))
     (my delta 0
       (let (loop (len (my l (- stop start)
                         (if (> 64 l) 64 l))))
@@ -219,7 +215,7 @@
   (friend (file-descriptor port)
     fd))
 
-(define (read-char (port *stdin*))
+(define (read-char (port (current-input-port)))
   (if (instance? port)
     (%read-char port)
     (((asm NN_pr_record_type_read_char_slot) (type-of port)) port)))
@@ -356,16 +352,33 @@
 (define *stdout* (make-instance <file>)) (init-output-file *stdout* #f 1)
 (define *stderr* (make-instance <file>)) (init-output-file *stderr* #f 2)
 
+(define stdin$ (make-fluid *stdin*))
+(define stdout$ (make-fluid *stdout*))
+(define stderr$ (make-fluid *stderr*))
+
+(define (current-input-port)  (ref stdin$))
+(define (current-output-port) (ref stdout$))
+(define (current-errors-port) (ref stderr$))
+
+(define (with-input-from port thunk)
+  (with-fluid stdin$ port thunk))
+
+(define (with-output-to port thunk)
+  (with-fluid stdout$ port thunk))
+
+(define (with-errors-to port thunk)
+  (with-fluid stderr$ port thunk))
+
 ;; General file operations
 
 (define port? (class-discriminator <port>))
 
 (define file? (class-discriminator <file>))
 
-(define (read-string length (port *stdin*) (block? #t))
+(define (read-string length (port (current-input-port)) (block? #t))
  (port-read-string port length block?))
 
-(define (peek-string length (port *stdin*) (block? #t))
+(define (peek-string length (port (current-input-port)) (block? #t))
  (port-peek-string port length block?))
 
 (define (read-char-sequence port pred (limit 0))
@@ -382,10 +395,10 @@
               (if (not (zero? limit))
                 (loop)))))))))
 
-(define (write-string string (port *stdout*))
+(define (write-string string (port (current-output-port)))
  (port-write-string port string))
 
-(define (char-ready? (port *stdin*))
+(define (char-ready? (port (current-input-port)))
  (port-ready? port))
 
 (defmacro (my-port var opener . body)
@@ -430,14 +443,14 @@
          (collect (cut read-all=> <> port
                        (cut read-string 16384 <>)))))
 
-(define (write object (port *stdout*))
+(define (write object (port (current-output-port)))
   (write-string (structure->string object) port))
 
-(define (writeln object (port *stdout*))
+(define (writeln object (port (current-output-port)))
   (write object port)
   (newline port))
 
-(define (read-char (port *stdin*))
+(define (read-char (port (current-input-port)))
   (if (instance? port)
     (%read-char port)
     (((asm NN_pr_record_type_read_char_slot) (type-of port)) port)))
@@ -449,7 +462,7 @@
 ; 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)
+(define (write-char (port (current-output-port)) object)
   (if (char? port)
     (my x port
       (set! port object)
@@ -459,11 +472,11 @@
     (((asm NN_pr_record_type_write_char_slot) (type-of port))
       port object)))
 
-(define (newline (port *stdout*))
+(define (newline (port (current-output-port)))
   (write-char #\newline port)
   (begin))
 
-(define (print (port *stdout*) datum)
+(define (print (port (current-output-port)) datum)
   (write-string (dwim-stringify datum) port)
   (begin))
 

Index: fluids.wisp
===================================================================
RCS file: /cvsroot/wisp/wisp/src/builtin/fluids.wisp,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- fluids.wisp	7 Sep 2002 21:52:32 -0000	1.2
+++ fluids.wisp	18 Sep 2002 21:11:14 -0000	1.3
@@ -11,6 +11,11 @@
 
 (my (%<fluid> %make-fluid)
   (make-record-type 0
+    'new (lambda (%<fluid> %make-fluid)
+           (lambda (datum)
+             (my f (%make-fluid)
+               (acons! fluid-list[] f (list datum))
+               f)))
     'ref (lambda (%<fluid> %make-fluid)
            (lambda (f (:= x))
              (my c (assq f fluid-list[])
@@ -22,9 +27,7 @@
   (define <fluid> %<fluid>)
 
   (define (make-fluid datum)
-    (my f (%make-fluid)
-      (acons! fluid-list[] f (list datum))
-      f))
+    (new <fluid> datum))
 
   (define (with-fluid f datum thunk)
     (my c (assq f fluid-list[])

Index: init.wisp
===================================================================
RCS file: /cvsroot/wisp/wisp/src/builtin/init.wisp,v
retrieving revision 1.60
retrieving revision 1.61
diff -u -d -r1.60 -r1.61
--- init.wisp	26 Aug 2002 16:18:23 -0000	1.60
+++ init.wisp	18 Sep 2002 21:11:14 -0000	1.61
@@ -7,7 +7,7 @@
 ;;;; @(#) $Id$
 
 (define (fatal-handler sig dat)
-  (print *stderr* "wisp: exception $[sig] about $[dat] occurred\n")
+  (print (current-errors-port) "wisp: exception $[sig] about $[dat] occurred\n")
   (exit 255))
 
 (define (state-version)
@@ -25,13 +25,13 @@
         (curdir? (or (memq #\C opkeys)
                      (memq #\c opkeys)))
         (interactive? (or (memq #\i opkeys)
-                          (tty? *stdin*))))
+                          (tty? (current-input-port)))))
     (my opki opkeys
       (while (not (null? opki))
         (if (not (memq (car opki) '(#\e #\A #\C #\c #\i)))
           (begin
-            (print *stderr* "Fatal error: unknown key \
-                            -$,(car opki) used.\n")
+            (print (current-errors-port)
+                   "Fatal error: unknown key -$,(car opki) used.\n")
             (exit 255)))
         (cdr! opki)))
     (set! *arglist* args) ; skip arguments already parsed
@@ -64,7 +64,7 @@
                (interactive? ((call-with-input-file "shell.wisp"
                                 'system-path
                                 (cut load <> *user-dictionary*))))
-               (else         (load *stdin* *user-dictionary*)))))
+               (else         (load (current-input-port) *user-dictionary*)))))
     (exit 0))) ; report success
 
 (define *system-path*

Index: parser.wisp
===================================================================
RCS file: /cvsroot/wisp/wisp/src/builtin/parser.wisp,v
retrieving revision 1.120
retrieving revision 1.121
diff -u -d -r1.120 -r1.121
--- parser.wisp	7 Sep 2002 22:00:41 -0000	1.120
+++ parser.wisp	18 Sep 2002 21:11:14 -0000	1.121
@@ -320,7 +320,7 @@
                     (loop #t)))))
        i)))
 
-  (define (read (port *stdin*))
+  (define (read (port (current-input-port)))
     (read-complex-structure port))
 
   (define (read-until-dollar port is-regex?)

Index: stdenv.wisp
===================================================================
RCS file: /cvsroot/wisp/wisp/src/builtin/stdenv.wisp,v
retrieving revision 1.367
retrieving revision 1.368
diff -u -d -r1.367 -r1.368
--- stdenv.wisp	18 Sep 2002 21:09:00 -0000	1.367
+++ stdenv.wisp	18 Sep 2002 21:11:14 -0000	1.368
@@ -11,15 +11,15 @@
      (metacode
        (cons 'list
          (map (lambda (x) `(cons ',x ,x))
-           '(* *stderr* *stdin* *stdout* + - / /= < << <= <box>
-             <c16string> <class> <file> <macro> <port> <record-type> =
-             > >= >> abs acons! address-of alist->dict alist-copy
-             analyse and append append-reverse apply assert
-             assert-object-type assoc assq assv atom? big-integer? bind
-             bit? boolean? box-empty! box-empty? box-ref box? broketed?
-             builtin-modules c16string? c8string? caaaar caaadr caaar
-             caadar caaddr caadr caar cadaar cadadr cadar caddar cadddr
-             caddr cadr call-with-in/out-files call-with-input-file
+           '(* + - / /= < << <= <box> <c16string> <class> <file>
+             <macro> <port> <record-type> = > >= >> abs acons!
+             address-of alist->dict alist-copy analyse and append
+             append-reverse apply assert assert-object-type assoc assq
+             assv atom? big-integer? bind bit? boolean? box-empty!
+             box-empty? box-ref box? broketed? builtin-modules
+             c16string? c8string? caaaar caaadr caaar caadar caaddr
+             caadr caar cadaar cadadr cadar caddar cadddr caddr cadr
+             call-with-in/out-files call-with-input-file
              call-with-output-file car car! car* cardinal? case catch
              cdaaar cdaadr cdaar cdadar cdaddr cdadr cdar cddaar cddadr
              cddar cdddar cddddr cdddr cddr cdr cdr! cdr* ceiling
@@ -43,7 +43,8 @@
              class-slots class? close-input-port close-output-port
              close-port collect collect-string compile concatenate cond
              cons cons! cons-copy cons? construct-filename
-             current-globals cut cute decr! define define-class
+             current-errors-port current-globals current-input-port
+             current-output-port cut cute decr! define define-class
              defmacro denominator desv desv+r dict->alist dict-bind!
              dict-copy dict-defined? dict-drop! dict-fetch dict-ref
              dict? dis do drop duplicate-dict-item! dwim-stringify
@@ -66,34 +67,35 @@
              open-input-file open-output-file opt or order->dict
              output-port? pack-be-integer pack-le-integer
              parse-character-body parse-lambda-list peek-char
-             peek-string pick-dict-items port? portio-debugging
-             positive? prep preprocess print procedure->macro
-             procedure? quasiquote quotient raise rassoc rassq rassv
-             rational->cons rational? read read-all=> read-char
-             read-char-sequence read-character-body read-directory
-             read-line read-string read-whole-file real? rec
-             record-type-discriminator record-type? reduce-index ref
-             remainder reverse round run-ewisp-file sbyte? second seek
-             semideque semideque->list semideque-bottom
-             semideque-insert! semideque-pop! semideque-push!
-             semideque-top serial seventh signal sixth slice
-             split-by-char string string->c16string string->c8string
-             string->integer string->list string->number string->symbol
-             string-append string-concatenate string-copy
-             string-downcase string-downcase! string-fill! string-join
-             string-move! string-null? string-template string-upcase
-             string-upcase! string<=? string<? string=? string>=?
-             string>? string? structure->string sub subclass? substring
-             superclass swap! swyde? symbol->string symbol-length
-             symbol-ref symbol<=? symbol<? symbol>=? symbol>? symbol?
-             system-constant tcchangeattr tcgetattr tcgetattr-raw
-             tcsetattr-raw tenth third toposplit translate tree-copy
-             truncate try tty? type type-of ubyte? unix-time
-             unpack-be-integer unpack-le-integer unsure-collect use
-             utf-8->c16string utf-8-first-byte->length uwyde? vector
-             vector->list vector-append vector-copy vector-fill!
-             vector-move! vector? void? wisp-string-hash write
-             write-char write-string writeln zero?)))))
+             peek-string pick-dict-items port? positive? prep
+             preprocess print procedure->macro procedure? quasiquote
+             quotient raise rassoc rassq rassv rational->cons rational?
+             read read-all=> read-char read-char-sequence
+             read-character-body read-directory read-line read-string
+             read-whole-file real? rec record-type-discriminator
+             record-type? reduce-index ref remainder reverse round
+             run-ewisp-file sbyte? second seek semideque
+             semideque->list semideque-bottom semideque-insert!
+             semideque-pop! semideque-push! semideque-top serial
+             seventh signal sixth slice split-by-char string
+             string->c16string string->c8string string->integer
+             string->list string->number string->symbol string-append
+             string-concatenate string-copy string-downcase
+             string-downcase! string-fill! string-join string-move!
+             string-null? string-template string-upcase string-upcase!
+             string<=? string<? string=? string>=? string>? string?
+             structure->string sub subclass? substring superclass swap!
+             swyde? symbol->string symbol-length symbol-ref symbol<=?
+             symbol<? symbol>=? symbol>? symbol? system-constant
+             tcchangeattr tcgetattr tcgetattr-raw tcsetattr-raw tenth
+             third toposplit translate tree-copy truncate try tty? type
+             type-of ubyte? unix-time unpack-be-integer
+             unpack-le-integer unsure-collect use utf-8->c16string
+             utf-8-first-byte->length uwyde? vector vector->list
+             vector-append vector-copy vector-fill! vector-move!
+             vector? void? wisp-string-hash with-errors-to
+             with-input-from with-output-to write write-char
+             write-string writeln zero?)))))
    ((*origin obj) ; => (original-name source-data ...) | #f
      (cond
        ; check for the regular environment