Expand procedure DEFAULT-OBJECT?.

diff --git a/v7/src/sf/usiexp.scm b/v7/src/sf/usiexp.scm
index e2a5cbe8b6877bcb2d0fd295cfa466dbe7872637..dfa2596b1d3546e3cb56a2e0646642de461c7b0a 100644 (file)
--- a/v7/src/sf/usiexp.scm
+++ b/v7/src/sf/usiexp.scm
@@ -1,8 +1,10 @@
 #| -*-Scheme-*-
 
-$Id: usiexp.scm,v 4.43 2003/02/14 18:28:35 cph Exp $
+$Id: usiexp.scm,v 4.44 2004/11/18 18:17:59 cph Exp $
 
-Copyright (c) 1988-2001 Massachusetts Institute of Technology
+Copyright 1987,1988,1989,1990,1991,1992 Massachusetts Institute of Technology
+Copyright 1993,1994,1995,1997,2000,2001 Massachusetts Institute of Technology
+Copyright 2004 Massachusetts Institute of Technology
 
 This file is part of MIT/GNU Scheme.
 
@@ -505,7 +507,7 @@ USA.
            (make-type-test #f block (ucode-type big-flonum) operand)
            (make-type-test #f block (ucode-type recnum) operand)))))
       (if-not-expanded)))
-
+\f
 (define (symbol?-expansion expr operands if-expanded if-not-expanded block)
   (if (and (pair? operands)
           (null? (cdr operands)))
@@ -518,7 +520,17 @@ USA.
            (make-type-test #f block (ucode-type uninterned-symbol)
                            operand)))))
       (if-not-expanded)))
-\f
+
+(define (default-object?-expansion expr operands if-expanded if-not-expanded
+         block)
+  (if (and (pair? operands)
+          (null? (cdr operands)))
+      (if-expanded
+       (make-combination expr block (ucode-primitive eq?)
+                        (list (car operands)
+                              (constant/make #f (default-object)))))
+      (if-not-expanded)))
+
 (define (make-disjunction expr . clauses)
   (let loop ((clauses clauses))
     (if (null? (cdr clauses))
@@ -542,7 +554,7 @@ USA.
        (constant/make (and expr (object/scode expr))
                      (string->symbol (constant/value (car operands)))))
       (if-not-expanded)))
-
+\f
 (define (intern-expansion expr operands if-expanded if-not-expanded block)
   block
   (if (and (pair? operands)
@@ -643,6 +655,7 @@ USA.
     char=?
     complex?
     cons*
+    default-object?
     eighth
     exact-integer?
     exact-rational?
@@ -724,6 +737,7 @@ USA.
    char=?-expansion
    complex?-expansion
    cons*-expansion
+   default-object?-expansion
    eighth-expansion
    exact-integer?-expansion
    exact-rational?-expansion