trim fixes

contrib/math/load.factor

@@ -1,3 +1,4 @@
+REQUIRES: contrib/sequences ;
 PROVIDE: contrib/math { 
     "utils.factor"
     "combinatorics.factor"

contrib/math/polynomials.factor

@@ -1,5 +1,6 @@
 IN: polynomials-internals
-USING: arrays kernel sequences vectors math math-internals namespaces arrays ;
+USING: arrays kernel sequences vectors math math-internals namespaces arrays
+    sequences-contrib ;
 
 ! Polynomials are vectors with the highest powers on the right:
 ! { 1 1 0 1 } -> 1 + x + x^3
@@ -15,10 +16,7 @@ USING: arrays kernel sequences vectors math math-internals namespaces arrays ;
 IN: math-contrib
 : p= ( p p -- ? ) pextend = ;
 
-: ptrim ( p -- p )
-    dup length 1 > [
-        0 over count-end >r dup length r> - dup zero? [ drop ] [ head ] if
-    ] when ;
+: ptrim ( p -- p ) [ zero? ] rtrim* ;
 
 : 2ptrim ( p p -- p p ) [ ptrim ] 2apply ;
 : p+ ( p p -- p ) pextend v+ ;
@@ -41,7 +39,7 @@ IN: math-contrib
 IN: polynomials-internals
 
 : pop-front ( seq -- seq )
-    1 tail ;
+    1 tail-slice ;
 
 : /-last ( seq seq -- a )
     #! divide the last two numbers in the sequences

contrib/math/utils.factor

@@ -4,15 +4,6 @@ USING: errors kernel sequences math sequences-internals namespaces arrays ;
 : deg>rad pi * 180 / ; inline
 : rad>deg 180 * pi / ; inline
 
-: (count-end) ( elt count seq -- elt count seq )
-    2dup length < [
-        3dup [ length swap - 1- ] keep nth = [ >r 1+ r> (count-end) ] when
-    ] when ;
-
-: count-end ( elt seq -- n )
-    #! count the number of elem at the end of the seq
-    0 swap (count-end) drop nip ;
-
 : lcm ( a b -- c )
     #! Smallest integer such that c/a and c/b are both integers.
     2dup gcd nip >r * r> /i ; foldable

contrib/sequences.factor

@@ -17,15 +17,26 @@ IN: sequences-contrib
 
 : last ( seq -- elt ) [ length 1- ] keep nth ;
 
-: rtrim* ( seq quot -- newseq )
-    2dup >r last r> call [ >r dup length 1- head-slice r> rtrim* ] [ drop ] if ;
+: (rtrim*) ( seq quot -- newseq )
+    over length 0 > [
+        2dup >r last r> call
+        [ >r dup length 1- head-slice r> (rtrim*) ] [ drop ] if
+    ] [
+        drop
+    ] if ;
+: rtrim* ( seq quot -- newseq ) [ (rtrim*) ] 2keep drop like ;
 : rtrim ( seq -- newseq ) [ blank? ] rtrim* ;
 
-: ltrim* ( seq quot -- newseq )
-    2dup >r first r> call [ >r 1 tail-slice r> ltrim* ] [ drop ] if ;
+: (ltrim*) ( seq quot -- newseq )
+    over length 0 > [
+        2dup >r first r> call [ >r 1 tail-slice r> (ltrim*) ] [ drop ] if
+    ] [
+        drop
+    ] if ;
+: ltrim* ( seq quot -- newseq ) [ (ltrim*) ] 2keep drop like ;
 : ltrim ( seq -- newseq ) [ blank? ] ltrim* ;
 
-: trim* ( seq quot -- newseq ) [ ltrim* ] keep rtrim* ;
+: trim* ( seq quot -- newseq ) [ (ltrim*) ] keep rtrim* ;
 : trim ( seq -- newseq ) [ blank? ] trim* ;
 
 PROVIDE: contrib/sequences ;