From d2d7892e69dbe97a6036cedfc842f4c5f9c9867a Mon Sep 17 00:00:00 2001 From: Chris Hanson 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