From: Nikodemus Siivola Date: Sat, 22 Sep 2012 22:48:06 +0000 (+0300) Subject: more funky &REST smartness X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=373df66df093e8c1771069dcc30c2ec32598af6a;p=sbcl.git more funky &REST smartness Extend the earlier VALUES-LIST optimization for &REST arguments into other operations as well. For starters: CAR ELT ENDP FIRST IF LENGTH LIST-LENGTH NTH All of these can now access the hidden &MORE context when given a &REST argument that is not used by other operations, making it possible for the compiler to elide the entire rest-list allocation in those cases. --- diff --git a/src/compiler/fndb.lisp b/src/compiler/fndb.lisp index f289015..a83a568 100644 --- a/src/compiler/fndb.lisp +++ b/src/compiler/fndb.lisp @@ -1404,7 +1404,11 @@ ;;;; magical compiler frobs -(defknown %values-list-or-context (t t t) * (always-translatable)) +(defknown %rest-values (t t t) * (always-translatable)) +(defknown %rest-ref (t t t t) * (always-translatable)) +(defknown %rest-length (t t t) * (always-translatable)) +(defknown %rest-null (t t t t) * (always-translatable)) +(defknown %rest-true (t t t) * (always-translatable)) (defknown %unary-truncate/single-float (single-float) integer (movable foldable flushable)) (defknown %unary-truncate/double-float (double-float) integer (movable foldable flushable)) diff --git a/src/compiler/ir1-translators.lisp b/src/compiler/ir1-translators.lisp index cd10e15..dc47dae 100644 --- a/src/compiler/ir1-translators.lisp +++ b/src/compiler/ir1-translators.lisp @@ -42,7 +42,10 @@ otherwise evaluate ELSE and return its values. ELSE defaults to NIL." ;; IR1-CONVERT-MAYBE-PREDICATE requires DEST to be CIF, so the ;; order of the following two forms is important (setf (lvar-dest pred-lvar) node) - (ir1-convert start pred-ctran pred-lvar test) + (multiple-value-bind (context count) (possible-rest-arg-context test) + (if context + (ir1-convert start pred-ctran pred-lvar `(%rest-true ,test ,context ,count)) + (ir1-convert start pred-ctran pred-lvar test))) (link-node-to-previous-ctran node pred-ctran) (let ((start-block (ctran-block pred-ctran))) diff --git a/src/compiler/locall.lisp b/src/compiler/locall.lisp index 4e18af7..2df985b 100644 --- a/src/compiler/locall.lisp +++ b/src/compiler/locall.lisp @@ -681,7 +681,7 @@ (call-args `(list ,@more-temps)) ;; &REST arguments may be accompanied by extra ;; context and count arguments. We know this by - ;; the ARG-INFO-DEFAULT. Supply NIL and 0 or + ;; the ARG-INFO-DEFAULT. Supply 0 and 0 or ;; don't convert at all depending. (let ((more (arg-info-default info))) (when more @@ -692,7 +692,7 @@ ;; We've already converted to use the more context ;; instead of the rest list. (return-from convert-more-call)))) - (call-args nil) + (call-args 0) (call-args 0) (setf (arg-info-default info) t))) (return)) diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp index c2f1aec..3278e7b 100644 --- a/src/compiler/srctran.lisp +++ b/src/compiler/srctran.lisp @@ -13,23 +13,12 @@ (in-package "SB!C") -;;; Convert into an IF so that IF optimizations will eliminate redundant -;;; negations. -(define-source-transform not (x) `(if ,x nil t)) -(define-source-transform null (x) `(if ,x nil t)) - -;;; ENDP is just NULL with a LIST assertion. The assertion will be -;;; optimized away when SAFETY optimization is low; hopefully that -;;; is consistent with ANSI's "should return an error". -(define-source-transform endp (x) `(null (the list ,x))) - ;;; We turn IDENTITY into PROG1 so that it is obvious that it just ;;; returns the first value of its argument. Ditto for VALUES with one ;;; arg. (define-source-transform identity (x) `(prog1 ,x)) (define-source-transform values (x) `(prog1 ,x)) - ;;; CONSTANTLY is pretty much never worth transforming, but it's good to get the type. (defoptimizer (constantly derive-type) ((value)) (specifier-type @@ -120,7 +109,6 @@ ;;; whatever is right for them is right for us. FIFTH..TENTH turn into ;;; Nth, which can be expanded into a CAR/CDR later on if policy ;;; favors it. -(define-source-transform first (x) `(car ,x)) (define-source-transform rest (x) `(cdr ,x)) (define-source-transform second (x) `(cadr ,x)) (define-source-transform third (x) `(caddr ,x)) @@ -163,8 +151,6 @@ (setf (cdr ,n-x) ,y) ,n-x))) -(define-source-transform nth (n l) `(car (nthcdr ,n ,l))) - (deftransform last ((list &optional n) (t &optional t)) (let ((c (constant-lvar-p n))) (cond ((or (not n) @@ -4084,57 +4070,149 @@ ,@(mapcar (lambda (x) `(values ,x)) (butlast args)) (values-list ,(car (last args)))))) -;;; When &REST argument are at play, we also have extra context and count -;;; arguments -- convert to %VALUES-LIST-OR-CONTEXT when possible, so that the -;;; deftransform can decide what to do after everything has been converted. -(define-source-transform values-list (list) - (if (symbolp list) - (let* ((var (lexenv-find list vars)) - (info (when (lambda-var-p var) - (lambda-var-arg-info var)))) - (if (and info +;;;; transforming references to &REST argument + +;;; We add magical &MORE arguments to all functions with &REST. If ARG names +;;; the &REST argument, this returns the lambda-vars for the context and +;;; count. +(defun possible-rest-arg-context (arg) + (when (symbolp arg) + (let* ((var (lexenv-find arg vars)) + (info (when (lambda-var-p var) + (lambda-var-arg-info var)))) + (when (and info (eq :rest (arg-info-kind info)) (consp (arg-info-default info))) - (destructuring-bind (context count &optional used) (arg-info-default info) - (declare (ignore used)) - `(%values-list-or-context ,list ,context ,count)) - (values nil t))) - (values nil t))) - -(deftransform %values-list-or-context ((list context count) * * :node node) - (let* ((use (lvar-use list)) + (values-list (arg-info-default info)))))) + +(defun mark-more-context-used (rest-var) + (let ((info (lambda-var-arg-info rest-var))) + (aver (eq :rest (arg-info-kind info))) + (destructuring-bind (context count &optional used) (arg-info-default info) + (unless used + (setf (arg-info-default info) (list context count t)))))) + +(defun mark-more-context-invalid (rest-var) + (let ((info (lambda-var-arg-info rest-var))) + (aver (eq :rest (arg-info-kind info))) + (setf (arg-info-default info) t))) + +;;; This determines of we the REF to a &REST variable is headed towards +;;; parts unknown, or if we can really use the context. +(defun rest-var-more-context-ok (lvar) + (let* ((use (lvar-use lvar)) (var (when (ref-p use) (ref-leaf use))) (home (when (lambda-var-p var) (lambda-var-home var))) - (info (when (lambda-var-p var) (lambda-var-arg-info var)))) + (info (when (lambda-var-p var) (lambda-var-arg-info var))) + (restp (when info (eq :rest (arg-info-kind info))))) (flet ((ref-good-for-more-context-p (ref) (let ((dest (principal-lvar-end (node-lvar ref)))) (and (combination-p dest) - ;; Uses outside VALUES-LIST will require a &REST list anyways, - ;; to it's no use saving effort here -- plus they might modify - ;; the list destructively. - (eq '%values-list-or-context (lvar-fun-name (combination-fun dest))) + ;; If the destination is to anything but these, we're going to + ;; actually need the rest list -- and since other operations + ;; might modify the list destructively, the using the context + ;; isn't good anywhere else either. + (lvar-fun-is (combination-fun dest) + '(%rest-values %rest-ref %rest-length + %rest-null %rest-true)) ;; If the home lambda is different and isn't DX, it might ;; escape -- in which case using the more context isn't safe. (let ((clambda (node-home-lambda dest))) (or (eq home clambda) (leaf-dynamic-extent clambda))))))) - (let ((context-ok - (and info - (consp (arg-info-default info)) - (not (lambda-var-specvar var)) - (not (lambda-var-sets var)) - (every #'ref-good-for-more-context-p (lambda-var-refs var)) - (policy node (= 3 rest-conversion))))) - (cond (context-ok - (destructuring-bind (context count &optional used) (arg-info-default info) - (declare (ignore used)) - (setf (arg-info-default info) (list context count t))) - `(%more-arg-values context 0 count)) - (t - (when info - (setf (arg-info-default info) t)) - `(values-list list))))))) - + (let ((ok (and restp + (consp (arg-info-default info)) + (not (lambda-var-specvar var)) + (not (lambda-var-sets var)) + (every #'ref-good-for-more-context-p (lambda-var-refs var))))) + (if ok + (mark-more-context-used var) + (when restp + (mark-more-context-invalid var))) + ok)))) + +;;; VALUES-LIST -> %REST-VALUES +(define-source-transform values-list (list) + (multiple-value-bind (context count) (possible-rest-arg-context list) + (if context + `(%rest-values ,list ,context ,count) + (values nil t)))) + +;;; NTH -> %REST-REF +(define-source-transform nth (n list) + (multiple-value-bind (context count) (possible-rest-arg-context list) + (if context + `(%rest-ref ,n ,list ,context ,count) + `(car (nthcdr ,n ,list))))) + +(define-source-transform elt (seq n) + (multiple-value-bind (context count) (possible-rest-arg-context seq) + (if context + `(%rest-ref ,n ,seq ,context ,count) + (values nil t)))) + +;;; CAR -> %REST-REF +(defun source-transform-car (list) + (multiple-value-bind (context count) (possible-rest-arg-context list) + (if context + `(%rest-ref 0 ,list ,context ,count) + (values nil t)))) +(define-source-transform car (list) (source-transform-car list)) +(define-source-transform first (list) (source-transform-car list)) + +;;; LENGTH -> %REST-LENGTH +(defun source-transform-length (list) + (multiple-value-bind (context count) (possible-rest-arg-context list) + (if context + `(%rest-length ,list ,context ,count) + (values nil t)))) +(define-source-transform length (list) (source-transform-length list)) +(define-source-transform list-length (list) (source-transform-length list)) + +;;; ENDP, NULL and NOT -> %REST-NULL +;;; +;;; Outside &REST convert into an IF so that IF optimizations will eliminate +;;; redundant negations. +(defun source-transform-null (x op) + (multiple-value-bind (context count) (possible-rest-arg-context x) + (cond (context + `(%rest-null ',op ,x ,context ,count)) + ((eq 'endp op) + `(if (the list ,x) nil t)) + (t + `(if ,x nil t))))) +(define-source-transform not (x) (source-transform-null x 'not)) +(define-source-transform null (x) (source-transform-null x 'null)) +(define-source-transform endp (x) (source-transform-null x 'endp)) + +(deftransform %rest-values ((list context count)) + (if (rest-var-more-context-ok list) + `(%more-arg-values context 0 count) + `(values-list list))) + +(deftransform %rest-ref ((n list context count)) + (cond ((rest-var-more-context-ok list) + `(%more-arg context n)) + ((and (constant-lvar-p n) (zerop (lvar-value n))) + `(car list)) + (t + `(nth n list)))) + +(deftransform %rest-length ((list context count)) + (if (rest-var-more-context-ok list) + 'count + `(length list))) + +(deftransform %rest-null ((op list context count)) + (aver (constant-lvar-p op)) + (if (rest-var-more-context-ok list) + `(eql 0 count) + `(,(lvar-value op) list))) + +(deftransform %rest-true ((list context count)) + (if (rest-var-more-context-ok list) + `(not (eql 0 count)) + `list)) ;;;; transforming FORMAT ;;;;