DEFAULT-OBJECT? is no longer a special form.

diff --git a/v7/src/edwin/evlcom.scm b/v7/src/edwin/evlcom.scm
index 05c026be238720c87e324d55d67932d0e64cfec7..321ff2106e74333b178be8566eb14abc867f7cf5 100644 (file)
--- a/v7/src/edwin/evlcom.scm
+++ b/v7/src/edwin/evlcom.scm
@@ -1,10 +1,10 @@
 #| -*-Scheme-*-
 
-$Id: evlcom.scm,v 1.68 2003/02/14 18:28:12 cph Exp $
+$Id: evlcom.scm,v 1.69 2004/11/19 17:35:08 cph Exp $
 
 Copyright 1986,1989,1991,1992,1993,1994 Massachusetts Institute of Technology
 Copyright 1995,1997,1998,1999,2000,2001 Massachusetts Institute of Technology
-Copyright 2003 Massachusetts Institute of Technology
+Copyright 2003,2004 Massachusetts Institute of Technology
 
 This file is part of MIT/GNU Scheme.
 
@@ -253,23 +253,21 @@ Has no effect if evaluate-in-inferior-repl is false."
   (let ((buffer (current-buffer)))
     (eval-with-history (apply prompt-for-expression
                              prompt
-                             (cond ((default-object? default)
-                                    default-object-kludge)
-                                   ((or (symbol? default)
-                                        (pair? default)
-                                        (vector? default))
-                                    `',default)
-                                   (else default))
+                             (if (or (symbol? default)
+                                     (pair? default)
+                                     (vector? default))
+                                 `',default
+                                 default)
                              options)
                       (evaluation-environment buffer))))
 
-(define (prompt-for-expression prompt #!optional default-object . options)
+(define (prompt-for-expression prompt #!optional default . options)
   (read-from-string
    (apply prompt-for-string
          prompt
-         (and (not (or (default-object? default-object)
-                       (eq? default-object-kludge default-object)))
-              (write-to-string default-object))
+         (if (default-object? default)
+             #f
+             (write-to-string default))
          'MODE
          (let ((environment (ref-variable scheme-environment)))
            (lambda (buffer)
@@ -280,9 +278,6 @@ Has no effect if evaluate-in-inferior-repl is false."
              (local-set-variable! scheme-environment environment buffer)))
          options)))
 
-(define default-object-kludge
-  (list 'DEFAULT-OBJECT-KLUDGE))
-
 (define (read-from-string string)
   (bind-condition-handler (list condition-type:error) evaluation-error-handler
     (lambda ()

diff --git a/v7/src/runtime/input.scm b/v7/src/runtime/input.scm
index 5c4e88fcd2d18580f218c7a9f3cadb82b92107c1..0ef389beb2cb57d7872dc04317a6cfd445c81936 100644 (file)
--- a/v7/src/runtime/input.scm
+++ b/v7/src/runtime/input.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: input.scm,v 14.29 2004/11/19 06:59:41 cph Exp $
+$Id: input.scm,v 14.30 2004/11/19 17:40:30 cph Exp $
 
 Copyright 1986,1987,1988,1989,1990,1991 Massachusetts Institute of Technology
 Copyright 1992,1993,1997,1999,2002,2003 Massachusetts Institute of Technology
@@ -142,17 +142,6 @@ USA.
 \f
 ;;;; High level
 
-(define-syntax optional-input-port
-  (sc-macro-transformer
-   (lambda (form environment)
-     (if (syntax-match? '(EXPRESSION EXPRESSION) (cdr form))
-        (let ((port (close-syntax (cadr form) environment))
-              (caller (close-syntax (caddr form) environment)))
-          `(IF (DEFAULT-OBJECT? ,port)
-               (CURRENT-INPUT-PORT)
-               (GUARANTEE-INPUT-PORT ,port ,caller)))
-        (ill-formed-syntax form)))))
-
 (define (char-ready? #!optional port interval)
   (let ((port (optional-input-port port 'CHAR-READY?))
        (interval
@@ -231,4 +220,9 @@ USA.
          ((external-string? string)
           (input-port/read-external-substring! port string start end))
          (else
-          (error:wrong-type-argument string "string" 'READ-SUBSTRING!)))))
\ No newline at end of file
+          (error:wrong-type-argument string "string" 'READ-SUBSTRING!)))))
+
+(define (optional-input-port port caller)
+  (if (default-object? port)
+      (current-input-port)
+      (guarantee-input-port port caller)))
\ No newline at end of file

diff --git a/v7/src/runtime/output.scm b/v7/src/runtime/output.scm
index 27466298e25c8b8a809cf95535cfdf1576d6e3e5..ce383aca3e4a6a44c18dce03564b9d5e7c8c3dcd 100644 (file)
--- a/v7/src/runtime/output.scm
+++ b/v7/src/runtime/output.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: output.scm,v 14.34 2004/05/26 17:03:14 cph Exp $
+$Id: output.scm,v 14.35 2004/11/19 17:37:48 cph Exp $
 
 Copyright 1986,1987,1988,1989,1990,1991 Massachusetts Institute of Technology
 Copyright 1992,1993,1999,2001,2002,2003 Massachusetts Institute of Technology
@@ -84,17 +84,6 @@ USA.
 \f
 ;;;; High level
 
-(define-syntax optional-output-port
-  (sc-macro-transformer
-   (lambda (form environment)
-     (if (syntax-match? '(EXPRESSION EXPRESSION) (cdr form))
-        (let ((port (close-syntax (cadr form) environment))
-              (caller (close-syntax (caddr form) environment)))
-          `(IF (DEFAULT-OBJECT? ,port)
-               (CURRENT-OUTPUT-PORT)
-               (GUARANTEE-OUTPUT-PORT ,port ,caller)))
-        (ill-formed-syntax form)))))
-
 (define (write-char char #!optional port)
   (let ((port (optional-output-port port 'WRITE-CHAR)))
     (if (let ((n (output-port/write-char port char)))
@@ -149,17 +138,6 @@ USA.
               (fix:> n 0)))
        (output-port/discretionary-flush port))))
 \f
-(define-syntax optional-unparser-table
-  (sc-macro-transformer
-   (lambda (form environment)
-     (if (syntax-match? '(EXPRESSION EXPRESSION) (cdr form))
-        (let ((unparser-table (close-syntax (cadr form) environment))
-              (caller (close-syntax (caddr form) environment)))
-          `(IF (DEFAULT-OBJECT? ,unparser-table)
-               (CURRENT-UNPARSER-TABLE)
-               (GUARANTEE-UNPARSER-TABLE ,unparser-table ,caller)))
-        (ill-formed-syntax form)))))
-
 (define (display object #!optional port unparser-table)
   (let ((port (optional-output-port port 'DISPLAY)))
     (unparse-object/top-level object port #f
@@ -195,6 +173,16 @@ USA.
 
 (define beep (wrap-custom-operation-0 'BEEP))
 (define clear (wrap-custom-operation-0 'CLEAR))
+
+(define (optional-output-port port caller)
+  (if (default-object? port)
+      (current-output-port)
+      (guarantee-output-port port caller)))
+
+(define (optional-unparser-table unparser-table caller)
+  (if (default-object? unparser-table)
+      (current-unparser-table)
+      (guarantee-unparser-table unparser-table caller)))
 \f
 ;;;; Tabular output
 

diff --git a/v7/src/runtime/random.scm b/v7/src/runtime/random.scm
index 0f594c87c7208fc2493fc417c207bec812285139..65bc228405d28acd1049f5a54f3a69e49039de44 100644 (file)
--- a/v7/src/runtime/random.scm
+++ b/v7/src/runtime/random.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: random.scm,v 14.35 2004/01/09 20:22:22 cph Exp $
+$Id: random.scm,v 14.36 2004/11/19 17:34:27 cph Exp $
 
 Copyright 1988,1989,1993,1994,1995,1996 Massachusetts Institute of Technology
 Copyright 1998,1999,2000,2001,2003,2004 Massachusetts Institute of Technology
@@ -131,9 +131,7 @@ USA.
 ;;;; Operations producing random values
 
 (define (random modulus #!optional state)
-  (let ((state
-        (guarantee-random-state (if (default-object? state) #f state)
-                                'RANDOM)))
+  (let ((state (guarantee-random-state state 'RANDOM)))
     ;; Kludge: an exact integer modulus means that result is an exact
     ;; integer.  Otherwise, the result is a real number.
     (cond ((int:integer? modulus)
@@ -159,9 +157,7 @@ USA.
   (flo:/ (int:->flonum (%random-integer flimit state)) flimit.))
 
 (define (random-byte-vector n #!optional state)
-  (let ((state
-        (guarantee-random-state (if (default-object? state) #f state)
-                                'RANDOM-BYTE-VECTOR))
+  (let ((state (guarantee-random-state state 'RANDOM-BYTE-VECTOR))
        (s (make-string n)))
     (do ((i 0 (fix:+ i 1)))
        ((fix:= i n))
@@ -200,27 +196,26 @@ USA.
 ;;;; Operations on state
 
 (define (make-random-state #!optional state)
-  (let ((state (if (default-object? state) #f state)))
-    (if (or (eq? #t state) (int:integer? state))
-       ;; Use good random source if available
-       (if (file-readable? "/dev/urandom")
-           (call-with-input-file "/dev/urandom"
-             (lambda (port)
-               (initial-random-state
-                (lambda (b)
-                  (let outer ()
-                    (let inner
-                        ((m #x100)
-                         (n (char->integer (read-char port))))
-                      (cond ((< m b)
-                             (inner (* m #x100)
-                                    (+ (* n #x100)
-                                       (char->integer (read-char port)))))
-                            ((< n b) n)
-                            (else (outer)))))))))
-           (simple-random-state))
-       (copy-random-state
-        (guarantee-random-state state 'MAKE-RANDOM-STATE)))))
+  (if (or (eq? #t state) (int:integer? state))
+      ;; Use good random source if available
+      (if (file-readable? "/dev/urandom")
+         (call-with-input-file "/dev/urandom"
+           (lambda (port)
+             (initial-random-state
+              (lambda (b)
+                (let outer ()
+                  (let inner
+                      ((m #x100)
+                       (n (char->integer (read-char port))))
+                    (cond ((< m b)
+                           (inner (* m #x100)
+                                  (+ (* n #x100)
+                                     (char->integer (read-char port)))))
+                          ((< n b) n)
+                          (else (outer)))))))))
+         (simple-random-state))
+      (copy-random-state
+       (guarantee-random-state state 'MAKE-RANDOM-STATE))))
 
 (define (simple-random-state)
   (initial-random-state
@@ -373,7 +368,7 @@ USA.
         (flo:vector-set! v1 i (flo:vector-ref v2 i)))))))
 
 (define (guarantee-random-state state procedure)
-  (if state
+  (if (if (default-object? state) #f state)
       (begin
        (if (not (random-state? state))
            (error:wrong-type-argument state "random state" procedure))

diff --git a/v7/src/runtime/unsyn.scm b/v7/src/runtime/unsyn.scm
index 0e744708e85ea8cbc7ed77ad3dd69fb633d6d770..3fb220baf6516fd88f241c41ec5b7f849f79eb28 100644 (file)
--- a/v7/src/runtime/unsyn.scm
+++ b/v7/src/runtime/unsyn.scm
@@ -1,9 +1,10 @@
 #| -*-Scheme-*-
 
-$Id: unsyn.scm,v 14.31 2004/11/19 06:56:37 cph Exp $
+$Id: unsyn.scm,v 14.32 2004/11/19 17:38:51 cph Exp $
 
 Copyright 1986,1987,1988,1989,1990,1991 Massachusetts Institute of Technology
 Copyright 1992,1994,1995,1996,2001,2002 Massachusetts Institute of Technology
+Copyright 2004 Massachusetts Institute of Technology
 
 This file is part of MIT/GNU Scheme.
 
@@ -46,7 +47,6 @@ USA.
                             (QUOTATION ,unsyntax-QUOTATION)
                             (SEQUENCE ,unsyntax-SEQUENCE-object)
                             (THE-ENVIRONMENT ,unsyntax-THE-ENVIRONMENT-object)
-                            (UNASSIGNED? ,unsyntax-UNASSIGNED?-object)
                             (VARIABLE ,unsyntax-VARIABLE-object))))
   unspecific)
 
@@ -189,9 +189,6 @@ USA.
       '()
       `(,(unsyntax-object value))))
 \f
-(define (unsyntax-UNASSIGNED?-object object)
-  `(DEFAULT-OBJECT? ,(unassigned?-name object)))
-
 (define (unsyntax-COMMENT-object comment)
   (let ((expression (unsyntax-object (comment-expression comment))))
     (if unsyntaxer:show-comments?