X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fseqtran.lisp;h=05066faadf01d1235c8604babc05135a1e16bf31;hb=5251267b300cb967cbf547e838037a616064bd58;hp=aa6fc0d0675fb69b9655b4088c9efc00cf3a547b;hpb=77360ee4a1f94c41b807be7ad0e8687199fceef1;p=sbcl.git diff --git a/src/compiler/seqtran.lisp b/src/compiler/seqtran.lisp index aa6fc0d..05066fa 100644 --- a/src/compiler/seqtran.lisp +++ b/src/compiler/seqtran.lisp @@ -249,7 +249,7 @@ `(if (funcall test e ',(car els)) ',els ,(frob (cdr els))) - 'nil))) + nil))) (frob val))))) ;;; FIXME: Rewrite this so that these definitions of DELETE, ASSOC, and MEMBER @@ -279,8 +279,8 @@ (cond (test (unless (continuation-function-is test '(eq)) (give-up-ir1-transform))) - ((types-intersect (continuation-type item) - (specifier-type 'number)) + ((types-equal-or-intersect (continuation-type item) + (specifier-type 'number)) (give-up-ir1-transform "Item might be a number."))) `(,eq-fun item list)))) @@ -324,27 +324,6 @@ ;;; applied to characters (defparameter *char=-functions* '(eql equal char=)) -(deftransform search ((string1 string2 &key (start1 0) end1 (start2 0) end2 - test) - (simple-string simple-string &rest t)) - (unless (or (not test) - (continuation-function-is test *char=-functions*)) - (give-up-ir1-transform)) - '(sb!impl::%sp-string-search string1 start1 (or end1 (length string1)) - string2 start2 (or end2 (length string2)))) - -(deftransform position ((item sequence &key from-end test (start 0) end) - (t simple-string &rest t)) - (unless (or (not test) - (continuation-function-is test *char=-functions*)) - (give-up-ir1-transform)) - `(and (typep item 'character) - (,(if (constant-value-or-lose from-end) - 'sb!impl::%sp-reverse-find-character - 'sb!impl::%sp-find-character) - sequence start (or end (length sequence)) - item))) - (deftransform find ((item sequence &key from-end (test #'eql) (start 0) end) (t simple-string &rest t)) `(if (position item sequence @@ -366,8 +345,10 @@ (eq (global-var-kind leaf) :global-function) (not (null (member (leaf-name leaf) names :test #'equal)))))))) -;;; If Cont is a constant continuation, the return the constant value. If -;;; it is null, then return default, otherwise quietly GIVE-UP. +;;; If CONT is a constant continuation, the return the constant value. +;;; If it is null, then return default, otherwise quietly give up the +;;; IR1 transform. +;;; ;;; ### Probably should take an ARG and flame using the NAME. (defun constant-value-or-lose (cont &optional default) (declare (type (or continuation null) cont)) @@ -378,11 +359,12 @@ (give-up-ir1-transform)))) #| -;;; This is a frob whose job it is to make it easier to pass around the -;;; arguments to IR1 transforms. It bundles together the name of the argument -;;; (which should be referenced in any expansion), and the continuation for -;;; that argument (or NIL if unsupplied.) -(defstruct (arg (:constructor %make-arg (name cont))) +;;; This is a frob whose job it is to make it easier to pass around +;;; the arguments to IR1 transforms. It bundles together the name of +;;; the argument (which should be referenced in any expansion), and +;;; the continuation for that argument (or NIL if unsupplied.) +(defstruct (arg (:constructor %make-arg (name cont)) + (:copier nil)) (name nil :type symbol) (cont nil :type (or continuation null))) (defmacro make-arg (name) @@ -419,7 +401,7 @@ (eql (continuation-value cont) x))) (eql default x))) -(defstruct iterator +(defstruct (iterator (:copier nil)) ;; The kind of iterator. (kind nil (member :normal :result)) ;; A list of LET* bindings to create the initial state. @@ -539,7 +521,8 @@ ,body)) ((not (csubtypep (continuation-type fun-cont) (specifier-type 'function))) - (when (policy *compiler-error-context* (> speed brevity)) + (when (policy *compiler-error-context* + (> speed inhibit-warnings)) (compiler-note "~S may not be a function, so must coerce at run-time." n-fun)) @@ -616,7 +599,7 @@ (- start2 start1)))))) index) (t nil)) - ,(if equalp 'end1 'nil)))))) + ,(if equalp 'end1 nil)))))) (dolist (stuff '((string=* not) (string/=* identity)))