From da47ca24210b68381ab1f27ed6bc7a55c6d69bd1 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Wed, 10 Jan 2018 19:19:58 -0800 Subject: [PATCH] Tweak dispatch-tag slightly. --- src/runtime/gentag.scm | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/src/runtime/gentag.scm b/src/runtime/gentag.scm index 41a83e065..e60f9e098 100644 --- a/src/runtime/gentag.scm +++ b/src/runtime/gentag.scm @@ -90,22 +90,22 @@ USA. ;;;; Object Tags -;;; We assume that most new data types will be constructed from tagged -;;; vectors, and therefore we should optimize the path for such -;;; structures as much as possible. +;;; We assume that most new data types will be constructed from records, and +;;; therefore we should optimize the path for such structures as much as +;;; possible. (define (dispatch-tag object) (declare (integrate object)) (declare (ignore-reference-traps (set microcode-type-tag-table microcode-type-method-table))) - (if (and (%record? object) - (%record? (%record-ref object 0)) - (eq? dispatch-tag-marker (%record-ref (%record-ref object 0) 0))) - (%record-ref object 0) - (if (vector-ref microcode-type-tag-table (object-type object)) - (vector-ref microcode-type-tag-table (object-type object)) - ((vector-ref microcode-type-method-table (object-type object)) - object)))) + (cond ((and (%record? object) + (dispatch-tag? (%record-ref object 0))) + (%record-ref object 0)) + ((vector-ref microcode-type-tag-table (object-type object)) + (vector-ref microcode-type-tag-table (object-type object))) + (else + ((vector-ref microcode-type-method-table (object-type object)) + object)))) (define (make-built-in-tag names) (let ((tags (map built-in-dispatch-tag names))) -- 2.25.1