From d2d7892e69dbe97a6036cedfc842f4c5f9c9867a Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Sat, 16 Apr 2005 02:23:26 +0000
Subject: [PATCH] Add finer discrimination for built-in constant types.
---
v7/src/runtime/generic.scm | 20 ++++++++++++++------
1 file changed, 14 insertions(+), 6 deletions(-)
diff --git a/v7/src/runtime/generic.scm b/v7/src/runtime/generic.scm
index 7133926b3..d97a2d10b 100644
--- a/v7/src/runtime/generic.scm
+++ b/v7/src/runtime/generic.scm
@@ -1,6 +1,6 @@
#| -*-Scheme-*-
-$Id: generic.scm,v 1.9 2005/04/14 04:42:31 cph Exp $
+$Id: generic.scm,v 1.10 2005/04/16 02:23:26 cph Exp $
Copyright 1996,2003,2005 Massachusetts Institute of Technology
@@ -418,11 +418,19 @@ USA.
boolean-tag
default-tag))))
(assign-type 'CONSTANT
- (lambda (default-tag)
- (lambda (object)
- (if (eq? #t object)
- boolean-tag
- default-tag)))))
+ (let ((null-tag (make-built-in-tag '(NULL)))
+ (eof-tag (make-built-in-tag '(EOF)))
+ (default-object-tag (make-built-in-tag '(DEFAULT)))
+ (keyword-tag (make-built-in-tag '(LAMBDA-KEYWORD))))
+ (lambda (default-tag)
+ (lambda (object)
+ (case object
+ ((#T) boolean-tag)
+ ((()) null-tag)
+ ((#!eof) eof-tag)
+ ((#!default) default-object-tag)
+ ((#!optional #!rest #!key #!aux) keyword-tag)
+ (else default-tag)))))))
(assign-type 'FLONUM
(let ((flonum-vector-tag
(make-built-in-tag '(FLONUM-VECTOR))))
--
2.25.1