From: stassats <sta...@us...> - 2014-02-22 15:43:41
|
The branch "master" has been updated in SBCL: via ee98f831a2c77d7e61bf85e33c759457226971e4 (commit) from 3124acb8fd30f7c6a030668f20ad20d84e8c8d43 (commit) - Log ----------------------------------------------------------------- commit ee98f831a2c77d7e61bf85e33c759457226971e4 Author: Stas Boukarev <sta...@gm...> Date: Sat Feb 22 00:17:51 2014 +0400 Add transforms for SORT and STABLE-SORT. Transform SORT and STABLE-SORT into more specialized functions when possible, --- src/compiler/fndb.lisp | 14 +++++++++++++- src/compiler/srctran.lisp | 22 ++++++++++++++++++++++ 2 files changed, 35 insertions(+), 1 deletions(-) diff --git a/src/compiler/fndb.lisp b/src/compiler/fndb.lisp index ade186d..b1be6be 100644 --- a/src/compiler/fndb.lisp +++ b/src/compiler/fndb.lisp @@ -665,13 +665,25 @@ :derive-type (sequence-result-nth-arg 1) :destroyed-constant-args (nth-constant-nonempty-sequence-args 1)) (defknown sb!impl::stable-sort-list (list function function) list - (call important-result) + (call important-result explicit-check) :destroyed-constant-args (nth-constant-nonempty-sequence-args 1)) (defknown sb!impl::sort-vector (vector index index function (or function null)) * ; SORT-VECTOR works through side-effect (call) :destroyed-constant-args (nth-constant-nonempty-sequence-args 1)) +(defknown sb!impl::stable-sort-vector + (vector function (or function null)) + vector + (call explicit-check) + :destroyed-constant-args (nth-constant-nonempty-sequence-args 1)) + +(defknown sb!impl::stable-sort-simple-vector + (simple-vector function (or function null)) + simple-vector + (call explicit-check) + :destroyed-constant-args (nth-constant-nonempty-sequence-args 1)) + (defknown merge (type-specifier sequence sequence callable &key (:key callable)) sequence diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp index 76e5be0..abeb4e7 100644 --- a/src/compiler/srctran.lisp +++ b/src/compiler/srctran.lisp @@ -4821,6 +4821,28 @@ (locally (declare (optimize (speed 2) (space 2) (inhibit-warnings 3))) (%sort-vector (or ,key #'identity)))))) + +(deftransform sort ((list predicate &key key) + (list * &rest t) *) + `(sb!impl::stable-sort-list list + (%coerce-callable-to-fun predicate) + (if key (%coerce-callable-to-fun key) #'identity))) + +(deftransform stable-sort ((sequence predicate &key key) + ((or vector list) *)) + (let ((sequence-type (lvar-type sequence))) + (cond ((csubtypep sequence-type (specifier-type 'list)) + `(sb!impl::stable-sort-list sequence + (%coerce-callable-to-fun predicate) + (if key (%coerce-callable-to-fun key) #'identity))) + ((csubtypep sequence-type (specifier-type 'simple-vector)) + `(sb!impl::stable-sort-simple-vector sequence + (%coerce-callable-to-fun predicate) + (and key (%coerce-callable-to-fun key)))) + (t + `(sb!impl::stable-sort-vector sequence + (%coerce-callable-to-fun predicate) + (and key (%coerce-callable-to-fun key))))))) ;;;; debuggers' little helpers ----------------------------------------------------------------------- hooks/post-receive -- SBCL |