From ac50fe875aa4621b54864a03cae06963303c0af5 Mon Sep 17 00:00:00 2001
From: Stephen Adams <edu/mit/csail/zurich/adams>
Date: Sat, 2 Sep 1995 20:57:24 +0000
Subject: [PATCH] Added expansions for %generic-index-check/ref and
 %generic-index-check/set!.

---
 v8/src/compiler/midend/laterew.scm | 63 +++++++++++++++++++++++++++++-
 1 file changed, 62 insertions(+), 1 deletion(-)

diff --git a/v8/src/compiler/midend/laterew.scm b/v8/src/compiler/midend/laterew.scm
index d9a6aeb9e..915ee3403 100644
--- a/v8/src/compiler/midend/laterew.scm
+++ b/v8/src/compiler/midend/laterew.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: laterew.scm,v 1.15 1995/08/31 15:25:13 adams Exp $
+$Id: laterew.scm,v 1.16 1995/09/02 20:57:24 adams Exp $
 
 Copyright (c) 1994-1995 Massachusetts Institute of Technology
 
@@ -439,3 +439,64 @@ MIT in each case. |#
       `(CALL (QUOTE ,%word-less-than-unsigned?) '#F
 	     ,index
 	     (CALL ',%vector-length '#F ,vec)))))
+
+(define-rewrite/late %generic-index-check/ref
+  ;; (CALL '%generic-index-check/ref '#F <collection> <index> '#(checks))
+  (lambda (form rands)
+    (let  ((cont (first rands))
+	   (collection (second rands))
+	   (index      (third rands))
+	   (checks     (quote/text (fourth rands))))
+      cont
+      (let ((collection* (laterew/new-name 'COLLECTION))
+	    (collection-tag  (vector-ref checks 0))
+	    (length-ref      (vector-ref checks 1)))
+	(let ((test1
+	       (if collection-tag
+		   `(CALL ',object-type? '#F
+			  ',collection-tag
+			  (LOOKUP ,collection*))
+		   `(QUOTE #T)))
+	      (test2
+	       (if length-ref
+		   `(CALL ',%word-less-than-unsigned? '#F
+			  ,index
+			  (CALL ',length-ref '#F (LOOKUP ,collection*)))
+		   `(QUOTE #T))))
+	  (bind collection* collection
+		(andify test1 test2)))))))
+
+
+(define-rewrite/late %generic-index-check/set!
+  ;; (CALL '%generic-index-check/set! '#F <collection> <index> <elt> '#(checks))
+  (lambda (form rands)
+    (let  ((cont (first rands))
+	   (collection (second rands))
+	   (index      (third rands))
+	   (element    (fourth rands))
+	   (checks     (quote/text (fifth rands))))
+      cont
+      (let ((collection* (laterew/new-name 'COLLECTION))
+	    (collection-tag  (vector-ref checks 0))
+	    (length-ref      (vector-ref checks 1))
+	    (element-tag     (vector-ref checks 2)))
+	(let ((test1
+	       (if collection-tag
+		   `(CALL ',object-type? '#F
+			  ',collection-tag
+			  (LOOKUP ,collection*))
+		   `(QUOTE #T)))
+	      (test2
+	       (if length-ref
+		   `(CALL ',%word-less-than-unsigned? '#F
+			  ,index
+			  (CALL ',length-ref '#F (LOOKUP ,collection*)))
+		   `(QUOTE #T)))
+	      (test3
+	       (if element-tag
+		   `(CALL ',object-type? '#F
+			  ',element-tag
+			  ,element)
+		   `(QUOTE #T))))
+	  (bind collection* collection
+		(andify (andify test1 test2) test3)))))))
\ No newline at end of file
-- 
2.25.1