projects
/
sbcl.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
sb-posix: make SYSCALL-ERROR's argument optional
[sbcl.git]
/
src
/
compiler
/
seqtran.lisp
diff --git
a/src/compiler/seqtran.lisp
b/src/compiler/seqtran.lisp
index
7775528
..
67ecb5a
100644
(file)
--- a/
src/compiler/seqtran.lisp
+++ b/
src/compiler/seqtran.lisp
@@
-316,6
+316,8
@@
(bug "Unknown list item seek transform: name=~S, key-functions=~S variant=~S"
function-name key-functions variant)))
(bug "Unknown list item seek transform: name=~S, key-functions=~S variant=~S"
function-name key-functions variant)))
+(defparameter *list-open-code-limit* 128)
+
(defun transform-list-item-seek (name item list key test test-not node)
(when (and test test-not)
(abort-ir1-transform "Both ~S and ~S supplied to ~S." :test :test-not name))
(defun transform-list-item-seek (name item list key test test-not node)
(when (and test test-not)
(abort-ir1-transform "Both ~S and ~S supplied to ~S." :test :test-not name))
@@
-376,7
+378,8
@@
(let* ((cp (constant-lvar-p list))
(c-list (when cp (lvar-value list))))
(cond ((and cp c-list (member name '(assoc rassoc member))
(let* ((cp (constant-lvar-p list))
(c-list (when cp (lvar-value list))))
(cond ((and cp c-list (member name '(assoc rassoc member))
- (policy node (>= speed space)))
+ (policy node (>= speed space))
+ (not (nthcdr *list-open-code-limit* c-list)))
`(let ,(mapcar (lambda (fun) `(,(second fun) ,(ensure-fun fun))) funs)
,(open-code c-list)))
((and cp (not c-list))
`(let ,(mapcar (lambda (fun) `(,(second fun) ,(ensure-fun fun))) funs)
,(open-code c-list)))
((and cp (not c-list))
@@
-431,7
+434,8
@@
,(open-code (cdr tail))))))
(let* ((cp (constant-lvar-p list))
(c-list (when cp (lvar-value list))))
,(open-code (cdr tail))))))
(let* ((cp (constant-lvar-p list))
(c-list (when cp (lvar-value list))))
- (cond ((and cp c-list (policy node (>= speed space)))
+ (cond ((and cp c-list (policy node (>= speed space))
+ (not (nthcdr *list-open-code-limit* c-list)))
`(let ((pred ,pred-expr)
,@(when key `((key ,key-form))))
,(open-code c-list)))
`(let ((pred ,pred-expr)
,@(when key `((key ,key-form))))
,(open-code c-list)))