From 0c7f22e651aaf421710e985c39e19566bf9d6e24 Mon Sep 17 00:00:00 2001
From: Stephen Adams <edu/mit/csail/zurich/adams>
Date: Fri, 8 Sep 1995 03:09:09 +0000
Subject: [PATCH] Added expansion for global LIST-REF.
---
v8/src/compiler/midend/earlyrew.scm | 52 +++++++++++++++++++----------
1 file changed, 35 insertions(+), 17 deletions(-)
diff --git a/v8/src/compiler/midend/earlyrew.scm b/v8/src/compiler/midend/earlyrew.scm
index b414efbad..40a94cd85 100644
--- a/v8/src/compiler/midend/earlyrew.scm
+++ b/v8/src/compiler/midend/earlyrew.scm
@@ -1,6 +1,6 @@
#| -*-Scheme-*-
-$Id: earlyrew.scm,v 1.15 1995/09/05 18:56:00 adams Exp $
+$Id: earlyrew.scm,v 1.16 1995/09/08 03:09:09 adams Exp $
Copyright (c) 1994-1995 Massachusetts Institute of Technology
@@ -496,28 +496,32 @@ MIT in each case. |#
(else
(default))))))
-(define-rewrite/early 'GENERAL-CAR-CDR
- (let ((prim-general-car-cdr (make-primitive-procedure 'GENERAL-CAR-CDR))
- (prim-car (make-primitive-procedure 'CAR))
+
+(define earlyrew/general-car-cdr
+ (let ((prim-car (make-primitive-procedure 'CAR))
(prim-cdr (make-primitive-procedure 'CDR)))
+ (lambda (term pattern equivalent)
+ (let walk-bits ((num pattern) (text term))
+ (if (= num 1)
+ text
+ (walk-bits (quotient num 2)
+ (equivalent
+ `(CALL (QUOTE ,(if (odd? num)
+ prim-car
+ prim-cdr))
+ (QUOTE #f)
+ ,text))))))))
+
+(define-rewrite/early 'GENERAL-CAR-CDR
+ (let ((prim-general-car-cdr (make-primitive-procedure 'GENERAL-CAR-CDR)))
(lambda (form term pattern)
(define (equivalent form*) (earlyrew/remember* form* form))
(define (default)
`(CALL (QUOTE ,prim-general-car-cdr) (QUOTE #f) ,term ,pattern))
- (cond ((form/number? pattern)
+ (cond ((form/exact-integer? pattern)
=> (lambda (pattern)
- (if (and (integer? pattern) (> pattern 0))
- (let walk-bits ((num pattern)
- (text term))
- (if (= num 1)
- text
- (walk-bits (quotient num 2)
- (equivalent
- `(CALL (QUOTE ,(if (odd? num)
- prim-car
- prim-cdr))
- (QUOTE #f)
- ,text)))))
+ (if (> pattern 0)
+ (earlyrew/general-car-cdr term pattern equivalent)
(default))))
(else (default))))))
@@ -549,6 +553,20 @@ MIT in each case. |#
(default values))))))
+(define-rewrite/early/global 'LIST-REF 2
+ (lambda (form default* term index)
+ (define (default) (default* (list term index)))
+ (define (equivalent form*) (earlyrew/remember* form* form))
+ (cond ((form/exact-integer? index)
+ => (lambda (index)
+ (if (and (<= 0 index)
+ (<= index (if compiler:generate-type-checks? 2 6)))
+ (earlyrew/general-car-cdr term (* 3 (expt 2 index))
+ equivalent)
+ (default))))
+ (else (default)))))
+
+
(define-rewrite/early/global 'SQRT 1
(lambda (form default arg)
form ; ignored
--
2.25.1