]> gitweb.factorcode.org Git - factor.git/commitdiff
sequences: some minor performance improvements.
authorJohn Benediktsson <mrjbq7@gmail.com>
Thu, 30 Aug 2012 18:33:57 +0000 (11:33 -0700)
committerJohn Benediktsson <mrjbq7@gmail.com>
Thu, 30 Aug 2012 18:33:57 +0000 (11:33 -0700)
core/sequences/sequences.factor
extra/sequences/extras/extras.factor

index 78755a97a14a565c801f7cc6b313f95273a7aa9b..2d0a81b8e7e3d803bedd219eb5e379dfb72fc2cd 100644 (file)
@@ -24,7 +24,6 @@ GENERIC: lengthen ( n seq -- )
 GENERIC: shorten ( n seq -- )
 
 M: sequence lengthen 2dup length > [ set-length ] [ 2drop ] if ; inline
-
 M: sequence shorten 2dup length < [ set-length ] [ 2drop ] if ; inline
 
 : empty? ( seq -- ? ) length 0 = ; inline
@@ -663,9 +662,13 @@ M: slice equal? over slice? [ sequence= ] [ 2drop f ] if ;
 
 <PRIVATE
 
+: move-unsafe ( to from seq -- )
+    2over =
+    [ 3drop ] [ [ nth-unsafe swap ] [ set-nth-unsafe ] bi ] if ; inline
+
 : (filter!) ( ... quot: ( ... elt -- ... ? ) store scan seq -- ... )
     2dup length < [
-        [ move ] 3keep
+        [ move-unsafe ] 3keep
         [ nth-unsafe pick call [ 1 + ] when ] 2keep
         [ 1 + ] dip
         (filter!)
@@ -701,6 +704,12 @@ PRIVATE>
     [ length 1 - ] keep
     over 0 < [ bounds-error ] [ nth-unsafe ] if ; inline
 
+<PRIVATE
+
+: last-unsafe ( seq -- elt ) [ length 1 - ] [ nth-unsafe ] bi ;
+
+PRIVATE>
+
 : set-last ( elt seq -- )
     [ length 1 - ] keep
     over 0 < [ bounds-error ] [ set-nth-unsafe ] if ; inline
@@ -713,7 +722,7 @@ PRIVATE>
     2over = [
         2drop 2drop
     ] [
-        [ [ 2over + pick ] dip move [ 1 + ] dip ] keep
+        [ [ 2over + pick ] dip move-unsafe [ 1 + ] dip ] keep
         move-backward
     ] if ;
 
@@ -721,7 +730,7 @@ PRIVATE>
     2over = [
         2drop 2drop
     ] [
-        [ [ pick [ dup dup ] dip + swap ] dip move 1 - ] keep
+        [ [ pick [ dup dup ] dip + swap ] dip move-unsafe 1 - ] keep
         move-forward
     ] if ;
 
@@ -762,7 +771,9 @@ PRIVATE>
     [ [ { } ] dip dup 1 + ] dip replace-slice ;
 
 : pop ( seq -- elt )
-    [ length 1 - ] [ [ nth ] [ shorten ] 2bi ] bi ;
+    [ length 1 - ] keep over 0 >=
+    [ [ nth-unsafe ] [ shorten ] 2bi ]
+    [ bounds-error ] if ;
 
 : exchange ( m n seq -- )
     [ nip bounds-check 2drop ]
@@ -899,7 +910,7 @@ PRIVATE>
     [ rest ] [ first-unsafe ] bi ;
 
 : unclip-last ( seq -- butlast last )
-    [ but-last ] [ last ] bi ;
+    [ but-last ] [ last-unsafe ] bi ;
 
 : unclip-slice ( seq -- rest-slice first )
     [ rest-slice ] [ first-unsafe ] bi ; inline
@@ -927,7 +938,7 @@ PRIVATE>
     [ find-last ] (map-find) ; inline
 
 : unclip-last-slice ( seq -- butlast-slice last )
-    [ but-last-slice ] [ last ] bi ; inline
+    [ but-last-slice ] [ last-unsafe ] bi ; inline
 
 <PRIVATE
 
index 767ab95a7eb5bea896a4fb2d3af6442cc93f6990..ccbb706d61291156f968524e605746bb8d22ca59 100644 (file)
@@ -202,12 +202,6 @@ PRIVATE>
 : trim-as ( ... seq quot: ( ... elt -- ... ? ) exemplar -- ... newseq )
     [ trim-slice ] [ like ] bi* ; inline
 
-<PRIVATE
-
-: last-unsafe ( seq -- elt ) [ length 1 - ] [ nth-unsafe ] bi ;
-
-PRIVATE>
-
 : ?trim ( ... seq quot: ( ... elt -- ... ? ) -- ... seq/newseq )
     over empty? [ drop ] [
         over [ first-unsafe ] [ last-unsafe ] bi pick bi@ or