~ chicken-core (chicken-5) 9adc6654a2b777037bb3cd7173f13d19495bd025
commit 9adc6654a2b777037bb3cd7173f13d19495bd025
Author: Peter Bex <peter@more-magic.net>
AuthorDate: Sat Aug 22 15:20:20 2015 +0200
Commit: Peter Bex <peter@more-magic.net>
CommitDate: Sat Aug 22 15:20:20 2015 +0200
dropped obsolete rest-vector rewrites in c-platform
Conflicts:
c-platform.scm
diff --git a/c-platform.scm b/c-platform.scm
index f8630358..cb86c090 100644
--- a/c-platform.scm
+++ b/c-platform.scm
@@ -342,11 +342,10 @@
(rewrite '##sys#apply 8 rewrite-apply) )
(let ()
- (define (rewrite-c..r op iop1 iop2 index)
+ (define (rewrite-c..r op iop1 iop2)
(rewrite
op 8
(lambda (db classargs cont callargs)
- ;; (<op> <rest-vector>) -> (##core#inline "C_i_vector_ref"/"C_slot" <rest-vector> (quote <index>))
;; (<op> <x>) -> (##core#inline <iop1> <x>) [safe]
;; (<op> <x>) -> (##core#inline <iop2> <x>) [unsafe]
(and (= (length callargs) 1)
@@ -357,24 +356,16 @@
'##core#call (list #t)
(list
cont
- (cond ((and (eq? '##core#variable (node-class arg))
- (eq? 'vector (db-get db (first (node-parameters arg)) 'rest-parameter)) )
- (make-node
- '##core#inline
- (if unsafe
- '("C_slot")
- '("C_i_vector_ref") )
- (list arg (qnode index)) ) )
- ((and unsafe iop2) (make-node '##core#inline (list iop2) callargs))
- (iop1 (make-node '##core#inline (list iop1) callargs))
- (else (return #f)) ) ) ) ) ) ) ) ) ) )
-
- (rewrite-c..r 'car "C_i_car" "C_u_i_car" 0)
- (rewrite-c..r '##sys#car "C_i_car" "C_u_i_car" 0)
- (rewrite-c..r '##sys#cdr "C_i_cdr" "C_u_i_cdr" 0)
- (rewrite-c..r 'cadr "C_i_cadr" "C_u_i_cadr" 1)
- (rewrite-c..r 'caddr "C_i_caddr" "C_u_i_caddr" 2)
- (rewrite-c..r 'cadddr "C_i_cadddr" "C_u_i_cadddr" 3))
+ (cond [(and unsafe iop2) (make-node '##core#inline (list iop2) callargs)]
+ [iop1 (make-node '##core#inline (list iop1) callargs)]
+ [else (return #f)] ) ) ) ) ) ) ) ) ) )
+
+ (rewrite-c..r 'car "C_i_car" "C_u_i_car")
+ (rewrite-c..r '##sys#car "C_i_car" "C_u_i_car")
+ (rewrite-c..r '##sys#cdr "C_i_cdr" "C_u_i_cdr")
+ (rewrite-c..r 'cadr "C_i_cadr" "C_u_i_cadr")
+ (rewrite-c..r 'caddr "C_i_caddr" "C_u_i_caddr")
+ (rewrite-c..r 'cadddr "C_i_cadddr" "C_u_i_cadddr") )
(let ([rvalues
(lambda (db classargs cont callargs)
Trap