fix typo in scrolling code

library/collections/sequences-epilogue.factor

@@ -89,10 +89,15 @@ M: object find ( seq quot -- i elt )
 : subset-with ( obj seq quot -- seq | quot: obj elt -- ? )
     swap [ with rot ] subset 2nip ; inline
 
-: every? ( seq quot -- ? | quot: elt elt -- ? )
+: (monotonic) ( quot seq i -- ? )
-    #! Tests if all elements are equivalent under the relation.
+    2dup 1 + swap nth >r swap nth r> rot call ; inline
-    over empty?
+
-    [ 2drop t ] [ >r [ first ] keep r> all-with? ] ifte ; inline
+: monotonic? ( seq quot -- ? | quot: elt elt -- ? )
+    #! Eg, { 1 2 3 4 } [ < ] monotonic? ==> t
+    #!     { 1 3 2 4 } [ < ] monotonic? ==> f
+    swap dup length 1 - [
+        pick pick >r >r (monotonic) r> r> rot
+    ] all? 2nip ; inline
 
 ! Operations
 M: object like drop ;

library/compiler/intrinsics.factor

@@ -63,7 +63,7 @@ sequences vectors words ;
 : value-tag ( value node -- n/f )
     #! If the tag is known, output it, otherwise f.
     node-classes hash dup [
-        types [ type-tag ] map dup [ = ] every?
+        types [ type-tag ] map dup [ = ] monotonic?
         [ first ] [ drop f ] ifte
     ] [
         drop f

library/inference/branches.factor

@@ -16,7 +16,7 @@ namespaces parser prettyprint sequences strings vectors words ;
 : unify-values ( seq -- value )
     #! If all values in list are equal, return the value.
     #! Otherwise, unify.
-    dup [ eq? ] every? [ first ] [ <meet> ] ifte ;
+    dup [ eq? ] monotonic? [ first ] [ <meet> ] ifte ;
 
 : unify-stacks ( seq -- stack )
     #! Replace differing literals in stacks with unknown
@@ -24,7 +24,7 @@ namespaces parser prettyprint sequences strings vectors words ;
     unify-lengths flip [ unify-values ] map ;
 
 : balanced? ( in out -- ? )
-    [ swap length swap length - ] 2map [ = ] every? ;
+    [ swap length swap length - ] 2map [ = ] monotonic? ;
 
 : unify-effect ( in out -- in out )
     2dup balanced?

library/inference/call-optimizers.factor

@@ -65,7 +65,7 @@ SYMBOL: @
     ] 2map conjunction ;
 
 : values-match? ( values template -- ? )
-    [ @ = [ drop f ] unless ] 2map [ ] subset [ eq? ] every? ;
+    [ @ = [ drop f ] unless ] 2map [ ] subset [ eq? ] monotonic? ;
 
 : apply-identity? ( values identity -- ? )
     first 2dup literals-match? >r values-match? r> and ;

library/inference/inline-methods.factor

@@ -34,7 +34,7 @@ M: 2generic dispatching-values drop node-in-d 2 swap tail* ;
         dup dispatching-classes dup empty? [
             2drop f
         ] [
-            dup [ = ] every? [
+            dup [ = ] monotonic? [
                 first swap node-param order min-class
             ] [
                 2drop f

library/test/kernel.factor

@@ -2,4 +2,4 @@ IN: scratchpad
 USING: kernel memory sequences test ;
 
 [ 0 ] [ f size ] unit-test
-[ t ] [ [ \ = \ = ] [ = ] every? ] unit-test
+[ t ] [ [ \ = \ = ] [ = ] monotonic? ] unit-test

library/test/sequences.factor

@@ -72,12 +72,13 @@ unit-test
 
 [ [ "a" 43 [ ] ] ] [ [ "a" 43 43 43 [ ] 43 "a" [ ] ] prune ] unit-test
 
-[ f ] [ [ { } { } "Hello" ] [ = ] every? ] unit-test
+[ f ] [ [ { } { } "Hello" ] [ = ] monotonic? ] unit-test
-[ f ] [ [ { 2 } { } { } ] [ = ] every? ] unit-test
+[ f ] [ [ { 2 } { } { } ] [ = ] monotonic? ] unit-test
-[ t ] [ [ ] [ = ] every? ] unit-test
+[ t ] [ [ ] [ = ] monotonic? ] unit-test
-[ t ] [ [ 1/2 ] [ = ] every? ] unit-test
+[ t ] [ [ 1/2 ] [ = ] monotonic? ] unit-test
-[ t ] [ [ 1.0 10/10 1 ] [ = ] every? ] unit-test
+[ t ] [ [ 1.0 10/10 1 ] [ = ] monotonic? ] unit-test
-
+[ t ] [ { 1 2 3 4 } [ < ] monotonic? ] unit-test
+[ f ] [ { 1 2 3 4 } [ > ] monotonic? ] unit-test
 [ [ 2 3 4 ] ] [ 1 [ 1 2 3 ] [ + ] map-with ] unit-test
 
 [ 1 ] [ 0 [ 1 2 ] nth ] unit-test
@@ -148,23 +149,9 @@ unit-test
 
 [ [ ] ] [ [ ] number-sort ] unit-test
 
-: pairs ( seq quot -- )
-    swap dup length 1 - [
-        [ 2dup 1 + swap nth >r swap nth r> rot call ] 3keep
-    ] repeat 2drop ;
-
-: map-pairs ( seq quot -- seq | quot: elt -- elt )
-    over [
-        length 1 - <vector> rot
-        [ 2swap [ slip push ] 2keep ] pairs nip
-    ] keep like ; inline
-    
-: sorted? ( seq quot -- ? )
-    map-pairs [ 0 <= ] all? ;
-
 [ t ] [
     100 [
         drop
-        1000 [ drop 0 1000 random-int ] map number-sort [ - ] sorted?
+        1000 [ drop 0 1000 random-int ] map number-sort [ <= ] monotonic?
     ] all?
 ] unit-test

library/ui/scrolling.factor

@@ -43,18 +43,21 @@ M: viewport pref-dim gadget-child pref-dim ;
     2dup over scroller-x update-slider
     over scroller-y update-slider ;
 
+: (scroll>bottom) ( viewport scroller -- )
+    over viewport-bottom? [
+        f pick set-viewport-bottom?
+        2dup swap viewport-dim scroll
+    ] when 2drop ;
+
 : update-scroller ( scroller -- ) dup scroller-origin scroll ;
 
 : update-viewport ( viewport scroller -- )
-    over viewport-bottom? [
+    scroller-origin vneg
-        f pick set-viewport-bottom?
+    swap gadget-child dup prefer set-rect-loc ;
-        over viewport-dim
-    ] [
-        dup scroller-origin
-    ] ifte vneg nip swap gadget-child dup prefer set-rect-loc ;
 
 M: viewport layout* ( viewport -- )
-    dup find-scroller dup update-scroller update-viewport ;
+    dup find-scroller dup update-scroller
+    2dup (scroll>bottom) update-viewport ;
 
 M: viewport focusable-child* ( viewport -- gadget )
     gadget-child ;