]> gitweb.factorcode.org Git - factor.git/commitdiff
sorting.quick: only allow sorting array-capacity things.
authorJohn Benediktsson <mrjbq7@gmail.com>
Sun, 16 Aug 2015 00:10:27 +0000 (17:10 -0700)
committerJohn Benediktsson <mrjbq7@gmail.com>
Sun, 16 Aug 2015 00:10:27 +0000 (17:10 -0700)
extra/sorting/quick/quick.factor

index be2a5309a86cf6d2c5933b7cff14e96999c04ac2..406bb2e39140830e636273ea1db7206a3c55f756 100644 (file)
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license
 
 USING: arrays combinators kernel locals math math.order
-sequences sequences.private strings vectors ;
+math.private sequences sequences.private strings vectors ;
 
 IN: sorting.quick
 
@@ -10,22 +10,22 @@ IN: sorting.quick
 
 :: quicksort ( seq from to quot: ( obj1 obj2 -- <=> ) -- )
     from to < [
-        from to + 2/ seq nth-unsafe :> pivot
+        from to fixnum+fast 2/ seq nth-unsafe :> pivot
 
         from to [ 2dup <= ] [
             [
                 over seq nth-unsafe pivot quot call
                 +lt+ eq?
-            ] [ [ 1 + ] dip ] while
+            ] [ [ 1 fixnum+fast ] dip ] while
 
             [
                 dup seq nth-unsafe pivot quot call
                 +gt+ eq?
-            ] [ 1 - ] while
+            ] [ 1 fixnum-fast ] while
 
             2dup <= [
                 [ seq exchange-unsafe ]
-                [ [ 1 + ] [ 1 - ] bi* ] 2bi
+                [ [ 1 fixnum+fast ] [ 1 fixnum-fast ] bi* ] 2bi
             ] when
         ] while
 
@@ -33,10 +33,14 @@ IN: sorting.quick
         [ seq ] dip to quot quicksort
     ] when ; inline recursive
 
+: check-array-capacity ( n -- n )
+    integer>fixnum-strict dup array-capacity?
+    [ "too large" throw ] unless ; inline
+
 PRIVATE>
 
 : sort! ( seq quot: ( obj1 obj2 -- <=> ) -- )
-    [ 0 over length 1 - ] dip quicksort ; inline
+    [ 0 over length check-array-capacity 1 - ] dip quicksort ; inline
 
 : sort-with! ( seq quot: ( elt -- key ) -- )
     [ compare ] curry sort! ; inline