From dfb9f1960ef23c47bc159557488bc52173a09616 Mon Sep 17 00:00:00 2001
From: ram <ram>
Date: Sat, 12 May 1990 21:10:30 +0000
Subject: [PATCH] Added some hacks to support the STRUCTURE-VECTOR type, so
 that implementing structures as simple-vectors doesn't confuse the type
 system too much.

---
 compiler/old-rt/vm-tran.lisp | 23 ++++++++++++++++++++++-
 1 file changed, 22 insertions(+), 1 deletion(-)

diff --git a/compiler/old-rt/vm-tran.lisp b/compiler/old-rt/vm-tran.lisp
index 1e0ce1e31..99007587a 100644
--- a/compiler/old-rt/vm-tran.lisp
+++ b/compiler/old-rt/vm-tran.lisp
@@ -21,12 +21,33 @@
 (def-source-transform single-float-p (x) `(short-float-p ,x))
 (def-source-transform double-float-p (x) `(long-float-p ,x))
 
+
+;;; Some hacks to let us implement structures as simple-vectors without
+;;; confusing type inference too much.
+;;;
+(def-builtin-type 'structure-vector
+  (make-named-type :name 'structure-vector
+		   :supertypes '(structure-vector t)
+		   :subclasses '(structure)))
+
+(defknown structure-vector-p (t) boolean)
+
+(define-type-predicate structure-vector-p structure-vector)
+
 (def-source-transform structurep (x)
   (once-only ((n-x x))
-    `(and (simple-vector-p ,n-x)
+    `(and (structure-vector-p ,n-x)
 	  (eql (%primitive get-vector-subtype ,n-x)
 	       system:%g-vector-structure-subtype))))
 
+(define-vop (structure-vector-p simple-vector-p)
+  (:translate structure-vector-p))
+
+(set 'lisp::type-pred-alist
+     (adjoin (cons 'structure-vector 'simple-vector-p)
+	     (symbol-value 'lisp::type-pred-alist)
+	     :key #'car))
+
 (def-source-transform compiled-function-p (x)
   `(functionp ,x))
 
-- 
GitLab