fix typo in scrolling code

diff --git a/library/collections/sequences-epilogue.factor b/library/collections/sequences-epilogue.factor
index 83ef63fdb4f9233c99f84db04a28972cef5e39ae..1c19ad098d915643ca5ab510cea0367995bc525b 100644 (file)
--- a/library/collections/sequences-epilogue.factor
+++ b/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 -- ? )
-    #! Tests if all elements are equivalent under the relation.
-    over empty?
-    [ 2drop t ] [ >r [ first ] keep r> all-with? ] ifte ; inline
+: (monotonic) ( quot seq i -- ? )
+    2dup 1 + swap nth >r swap nth r> rot call ; 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 ;

diff --git a/library/compiler/intrinsics.factor b/library/compiler/intrinsics.factor
index 1330b3a2801dd655611b64934095fa82567d0877..cfeb6f8f925d19355e14b4620774e30f29103860 100644 (file)
--- a/library/compiler/intrinsics.factor
+++ b/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

diff --git a/library/inference/branches.factor b/library/inference/branches.factor
index 52394eb2edaa4e2b34f1d305563843104dd8e22e..2543350a003eef52000f90d2b78ae45fe289be92 100644 (file)
--- a/library/inference/branches.factor
+++ b/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?

diff --git a/library/inference/call-optimizers.factor b/library/inference/call-optimizers.factor
index 6d981787f157e114000a26b7af69036ef4b0920f..f4768b2e9f11c4756bada509663ba8dfac9da6bc 100644 (file)
--- a/library/inference/call-optimizers.factor
+++ b/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 ;

diff --git a/library/inference/inline-methods.factor b/library/inference/inline-methods.factor
index d8e67ab1d80a50254b219d26919c0e9ec116b245..81486d7778c63dd6f249fa1e633defc912c7198b 100644 (file)
--- a/library/inference/inline-methods.factor
+++ b/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

diff --git a/library/test/kernel.factor b/library/test/kernel.factor
index 7fbf2dc8b19594772581e0589875992820bddea0..1b5c4fe7687d28b2a75d5c83febf0a141ec71d07 100644 (file)
--- a/library/test/kernel.factor
+++ b/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

diff --git a/library/test/sequences.factor b/library/test/sequences.factor
index 2fbdfbf5d01f8dbb0a70043de734ca99ac4291bc..c66801e9877f6c6fb41afbc69f0826b109d25c1e 100644 (file)
--- a/library/test/sequences.factor
+++ b/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 ] [ [ { 2 } { } { } ] [ = ] every? ] unit-test
-[ t ] [ [ ] [ = ] every? ] unit-test
-[ t ] [ [ 1/2 ] [ = ] every? ] unit-test
-[ t ] [ [ 1.0 10/10 1 ] [ = ] every? ] unit-test
-
+[ f ] [ [ { } { } "Hello" ] [ = ] monotonic? ] unit-test
+[ f ] [ [ { 2 } { } { } ] [ = ] monotonic? ] unit-test
+[ t ] [ [ ] [ = ] monotonic? ] unit-test
+[ t ] [ [ 1/2 ] [ = ] monotonic? ] 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

diff --git a/library/ui/scrolling.factor b/library/ui/scrolling.factor
index 2ef1abe698b3b4db4bfa08a8b49c0d9fb5443f57..9444a96cfc57e2ea0e18f8488af97aa7e5692869 100644 (file)
--- a/library/ui/scrolling.factor
+++ b/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? [
-        f pick set-viewport-bottom?
-        over viewport-dim
-    ] [
-        dup scroller-origin
-    ] ifte vneg nip swap gadget-child dup prefer set-rect-loc ;
+    scroller-origin vneg
+    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 ;