sequences: fix supremum-by and infimum-by to be row polymorphic.

core/sequences/sequences-tests.factor

@@ -1,7 +1,7 @@
 USING: arrays byte-arrays kernel math math.order math.parser
 namespaces sequences kernel.private sequences.private strings
 sbufs tools.test vectors assocs generic vocabs.loader
-generic.single math.vectors ;
+generic.single math.vectors math.functions ;
 IN: sequences.tests
 
 [ "empty" ] [ { } [ "empty" ] [ "not empty" ] if-empty ] unit-test
@@ -359,6 +359,8 @@ USE: make
 { "bar" } [ { "bar" "baz" "qux" } [ length ] infimum-by ] unit-test
 [ { "foo" } ] [ { { "foo" } { "bar" } } [ first ] supremum-by ] unit-test
 [ { "bar" } ] [ { { "foo" } { "bar" } } [ first ] infimum-by ] unit-test
+{ -2 1 } [ -2 { 1 2 3 } [ over ^ ] supremum-by ] unit-test
+{ -2 3 } [ -2 { 1 2 3 } [ over ^ ] infimum-by ] unit-test
 
 [ { 0 0 255 } ] [
     {

core/sequences/sequences.factor

@@ -1031,16 +1031,16 @@ M: object sum 0 [ + ] binary-reduce ; inline
 : each-from ( ... seq quot: ( ... x -- ... ) i -- ... )
     -rot (each) (each-integer) ; inline
 
-: supremum-by ( seq quot: ( ... elt -- ... x ) -- elt )
-    [ [ first dup ] dip call ] 2keep [
-        dupd call pick dupd after?
-        [ [ 2drop ] 2dip ] [ 2drop ] if
+: supremum-by ( ... seq quot: ( ... elt -- ... x ) -- ... elt )
+    [ keep swap ] curry [ [ first ] dip call ] 2keep [
+        curry 2dip pick over after?
+        [ 2drop ] [ [ 2drop ] 2dip ] if
     ] curry 1 each-from drop ; inline
 
-: infimum-by ( seq quot: ( ... elt -- ... x ) -- elt )
-    [ [ first dup ] dip call ] 2keep [
-        dupd call pick dupd before?
-        [ [ 2drop ] 2dip ] [ 2drop ] if
+: infimum-by ( ... seq quot: ( ... elt -- ... x ) -- ... elt )
+    [ keep swap ] curry [ [ first ] dip call ] 2keep [
+        curry 2dip pick over before?
+        [ 2drop ] [ [ 2drop ] 2dip ] if
     ] curry 1 each-from drop ; inline
 
 : shortest ( seqs -- elt ) [ length ] infimum-by ;