From: Stephen Adams <edu/mit/csail/zurich/adams>
Date: Sat, 29 Apr 1995 13:08:29 +0000 (+0000)
Subject: Added expansion for SYMBOL? (similar to those for numeric predicates).
X-Git-Tag: 20090517-FFI~6374
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=fd04a00ee6bbb4ad373b175ea45e2d5ed0d0dcda;p=mit-scheme.git

Added expansion for SYMBOL? (similar to those for numeric predicates).
---

diff --git a/v7/src/sf/usiexp.scm b/v7/src/sf/usiexp.scm
index ca3852f72..5e5a785b8 100644
--- a/v7/src/sf/usiexp.scm
+++ b/v7/src/sf/usiexp.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: usiexp.scm,v 4.33 1995/03/20 23:29:00 cph Exp $
+$Id: usiexp.scm,v 4.34 1995/04/29 13:08:29 adams Exp $
 
 Copyright (c) 1988-95 Massachusetts Institute of Technology
 
@@ -511,6 +511,18 @@ MIT in each case. |#
 	(make-type-test false block (ucode-type big-flonum) (car operands))
 	(make-type-test false block (ucode-type recnum) (car operands))))
       (if-not-expanded)))
+
+(define (symbol?-expansion expr operands if-expanded if-not-expanded block)
+  (if (and (pair? operands)
+	   (null? (cdr operands)))
+      (if-expanded
+       (make-disjunction
+	expr
+	(make-type-test false block (ucode-type interned-symbol)
+			(car operands))
+	(make-type-test false block (ucode-type uninterned-symbol)
+			(car operands))))
+      (if-not-expanded)))
 
 (define (make-disjunction expr . clauses)
   (let loop ((clauses clauses))
@@ -635,6 +647,7 @@ MIT in each case. |#
     seventh
     sixth
     string->symbol
+    symbol?
     third
     values
     vector?
@@ -720,6 +733,7 @@ MIT in each case. |#
    seventh-expansion
    sixth-expansion
    string->symbol-expansion
+   symbol?-expansion
    third-expansion
    values-expansion
    vector?-expansion