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