fix bug in pick-up

diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index e3ce6935422cd0e1e28be86209bb55a668a8203c..c0779f410493bc11ce8f2f101f5ed8bd5f02ff48 100644 (file)
--- a/TODO.FACTOR.txt
+++ b/TODO.FACTOR.txt
@@ -33,7 +33,6 @@
 - faster layout\r
 - faster repaint\r
 - ui browser\r
-- auto-updating inspector, mirrors abstraction\r
 - mouse enter onto overlapping with interior, but not child, gadget\r
 - rollovers broken in inspector\r
 - menu dragging\r
@@ -74,17 +73,12 @@
 \r
 + sequences\r
 \r
-- generic skip\r
 - dipping 2nmap, 2each\r
 - array sort\r
-- 2map slow with lists\r
 - nappend: instead of using push, enlarge the sequence with set-length\r
   then add set the elements with set-nth\r
 - faster sequence operations\r
-- generic some? all? memq? fiber?\r
-- index and index* are very slow with lists\r
 - specialized arrays\r
-- list map, subset: not tail recursive\r
 - phase out sbuf-append\r
 \r
 + kernel:\r

diff --git a/library/bootstrap/boot-stage3.factor b/library/bootstrap/boot-stage3.factor
index 73ed9667217481d525a7177826e5c5cb79bd4d79..c508fda0c67591b739f97a254fec77fdf22b9279 100644 (file)
--- a/library/bootstrap/boot-stage3.factor
+++ b/library/bootstrap/boot-stage3.factor
@@ -30,6 +30,8 @@ init-assembler
 
 : compile? "compile" get supported-cpu? and ;
 
+"library/inference/branches.factor" run-file
+
 compile? [
     \ car compile
     \ * compile

diff --git a/library/collections/lists.factor b/library/collections/lists.factor
index 3e2d1b51f3430c0b3d32ebf55893d357722d8e87..807c9081736efe8c13d9fc10b88bb2c09fac646c 100644 (file)
--- a/library/collections/lists.factor
+++ b/library/collections/lists.factor
@@ -71,13 +71,10 @@ M: general-list find* ( start list quot -- i elt )
     #! list.
     2dup member? [ nip ] [ cons ] ifte ;
 
-M: general-list reverse ( list -- list )
+M: general-list reversed ( list -- list )
     [ ] [ swons ] reduce ;
 
-M: f map ( list quot -- list ) drop ;
-
-M: cons map ( list quot -- list | quot: elt -- elt )
-    (each) rot >r map r> swons ;
+M: general-list reverse reversed ;
 
 IN: sequences
 DEFER: <range>

diff --git a/library/collections/sequences-epilogue.factor b/library/collections/sequences-epilogue.factor
index c8724359bcd4c379f526a8b9c16426f95727c150..4b616ee90c816bd321f3fada96f6d225c455dc71 100644 (file)
--- a/library/collections/sequences-epilogue.factor
+++ b/library/collections/sequences-epilogue.factor
@@ -37,8 +37,14 @@ M: object each ( seq quot -- )
     #! Destructive on seq.
     0 swap (nmap) ; inline
 
-M: object map ( seq quot -- seq | quot: elt -- elt )
-    swap [ swap nmap ] immutable ;
+: map ( seq quot -- seq | quot: elt -- elt )
+    swap [ swap nmap ] immutable ; inline
+
+: map-with ( obj list quot -- list | quot: obj elt -- elt )
+    swap [ with rot ] map 2nip ; inline
+
+: accumulate ( list identity quot -- values | quot: x y -- z )
+    rot [ pick >r swap call r> ] map-with nip ; inline
 
 : (2nmap) ( seq1 seq2 i quot -- elt3 )
     pick pick >r >r >r 2nth r> call r> r> swap set-nth ; inline
@@ -183,25 +189,25 @@ M: object peek ( sequence -- element )
 
 : >pop> ( stack -- stack ) dup pop drop ;
 
+M: object reversed ( seq -- seq ) <reversed> ;
+
 M: object reverse ( seq -- seq ) [ <reversed> ] keep like ;
 
 ! Set theoretic operations
-: seq-intersect ( seq seq -- seq )
-    #! Make a list of elements that occur in both lists.
+: seq-intersect ( seq1 seq2 -- seq1/\seq2 )
     [ swap member? ] subset-with ;
 
-: seq-diff ( list1 list2 -- list )
-    #! Make a list of elements that occur in list2 but not
-    #! list1.
+: seq-diff ( seq1 seq2 -- seq2-seq1 )
     [ swap member? not ] subset-with ;
 
-: seq-diffq ( list1 list2 -- list )
-    #! Make a list of elements that occur in list2 but not
-    #! list1.
+: seq-diffq ( seq1 seq2 -- seq2-seq1 )
     [ swap memq? not ] subset-with ;
 
-: contained? ( list1 list2 -- ? )
-    #! Is every element of list1 in list2?
+: seq-union ( seq1 seq2 -- seq1\/seq2 )
+    append prune ;
+
+: contained? ( seq1 seq2 -- ? )
+    #! Is every element of seq1 in seq2
     swap [ swap member? ] all-with? ;
 
 IN: kernel

diff --git a/library/collections/sequences.factor b/library/collections/sequences.factor
index 68dfa13bcbc9e67f54c164f77b7e30bb86ee0d39..fa3b1173d532ab5bc31acb98627651144b746975 100644 (file)
--- a/library/collections/sequences.factor
+++ b/library/collections/sequences.factor
@@ -19,12 +19,16 @@ GENERIC: set-nth ( value n sequence -- obj )
 GENERIC: thaw ( seq -- mutable-seq )
 GENERIC: like ( seq seq -- seq )
 GENERIC: reverse ( seq -- seq )
+GENERIC: reversed ( seq -- seq )
 GENERIC: peek ( seq -- elt )
 GENERIC: head ( n seq -- seq )
 GENERIC: tail ( n seq -- seq )
 GENERIC: concat ( seq -- seq )
 GENERIC: resize ( n seq -- seq )
 
+: immutable ( seq quot -- seq | quot: seq -- )
+    swap [ thaw ] keep >r dup >r swap call r> r> like ; inline
+
 G: each ( seq quot -- | quot: elt -- )
     [ over ] [ type ] ; inline
 
@@ -34,15 +38,6 @@ G: each ( seq quot -- | quot: elt -- )
 : reduce ( list identity quot -- value | quot: x y -- z )
     swapd each ; inline
 
-G: map ( seq quot -- seq | quot: elt -- elt )
-    [ over ] [ type ] ; inline
-
-: map-with ( obj list quot -- list | quot: obj elt -- elt )
-    swap [ with rot ] map 2nip ; inline
-
-: accumulate ( list identity quot -- values | quot: x y -- z )
-    rot [ pick >r swap call r> ] map-with nip ; inline
-
 G: 2map ( seq seq quot -- seq | quot: elt elt -- elt )
     [ over ] [ type ] ; inline
 
@@ -56,9 +51,6 @@ G: find* [ over ] [ type ] ; inline
 : find-with* ( obj i seq quot -- i elt )
     -rot [ with rot ] find* 2swap 2drop ; inline
 
-: immutable ( seq quot -- seq | quot: seq -- )
-    swap [ thaw ] keep >r dup >r swap call r> r> like ; inline
-
 : first 0 swap nth ; inline
 : second 1 swap nth ; inline
 : third 2 swap nth ; inline

diff --git a/library/generic/generic.factor b/library/generic/generic.factor
index b3bc571fb91ece6d670d9a562c7a3058bc9575f2..8583d246baf94010727aa590dc18ed042d08091c 100644 (file)
--- a/library/generic/generic.factor
+++ b/library/generic/generic.factor
@@ -161,9 +161,6 @@ SYMBOL: typemap
 
 SYMBOL: object
 
-: type-union ( list list -- list )
-    append prune ;
-
 : lookup-union ( typelist -- class )
     [ > ] sort typemap get hash [ object ] unless* ;
 
@@ -171,7 +168,7 @@ SYMBOL: object
     #! Return a class that both classes are subclasses of.
     swap builtin-supertypes
     swap builtin-supertypes
-    type-union lookup-union ;
+    seq-union lookup-union ;
 
 : class-or-list ( list -- class )
     #! Return a class that every class in the list is a

diff --git a/library/inference/branches.factor b/library/inference/branches.factor
index a35f86bc53a6c370987ee01cad60904073907a82..e607ced65497353bc906bc3a790ac4a1a825f8bd 100644 (file)
--- a/library/inference/branches.factor
+++ b/library/inference/branches.factor
@@ -8,7 +8,7 @@ sequences strings vectors words hashtables prettyprint ;
     [ length ] map 0 [ max ] reduce ;
 
 : computed-value-vector ( n -- vector )
-    empty-vector [ object <computed> ] map ;
+    empty-vector [ drop object <computed> ] map ;
 
 : add-inputs ( count stack -- stack )
     #! Add this many inputs to the given stack.

diff --git a/library/ui/hand.factor b/library/ui/hand.factor
index 96d63efe612dbfeab3b35385cde95c8db9aac428..1ef3d5d083ec536341ff732a8e6711171556f035 100644 (file)
--- a/library/ui/hand.factor
+++ b/library/ui/hand.factor
@@ -4,10 +4,8 @@ IN: gadgets
 USING: alien generic io kernel lists math matrices namespaces
 prettyprint sdl sequences vectors ;
 
-DEFER: pick-up
-
 : (pick-up) ( point gadget -- gadget )
-    gadget-children <reversed> [ pick-up ] find nip ;
+    gadget-children reversed [ inside? ] find-with nip ;
 
 : pick-up ( point gadget -- gadget )
     #! The logic is thus. If the point is definately outside the
@@ -15,7 +13,8 @@ DEFER: pick-up
     #! in any subgadget. If not, see if it is contained in the
     #! box delegate.
     2dup inside? [
-        [ [ translate ] keep (pick-up) dup ] keep ?
+        [ translate ] keep 2dup
+        (pick-up) [ pick-up ] [ nip ] ?ifte
     ] [
         2drop f
     ] ifte ;

diff --git a/library/ui/hierarchy.factor b/library/ui/hierarchy.factor
index 3f9502474070779fa38310601474360d7f6a01cb..36c013ba02033bf74cb4d1ac17a14464ed21d52a 100644 (file)
--- a/library/ui/hierarchy.factor
+++ b/library/ui/hierarchy.factor
@@ -2,7 +2,7 @@
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets
 USING: generic hashtables kernel lists math matrices namespaces
-sequences ;
+sequences vectors ;
 
 : remove-gadget ( gadget parent -- )
     [ 2dup gadget-children remq swap set-gadget-children ] keep
@@ -20,7 +20,7 @@ sequences ;
     0 over gadget-children set-length relayout ;
 
 : ?push ( elt seq/f -- seq )
-    [ push ] [ 1vector ] ifte* ;
+    [ [ push ] keep ] [ 1vector ] ifte* ;
 
 : (add-gadget) ( gadget box -- )
     over unparent

diff --git a/library/ui/layouts.factor b/library/ui/layouts.factor
index f8b7fbc55ee4e07f40a3fd4b8deb788255c75b04..fbf0c7c20a3bce15883a1abe276975293627be6d 100644 (file)
--- a/library/ui/layouts.factor
+++ b/library/ui/layouts.factor
@@ -20,7 +20,7 @@ namespaces sdl sequences ;
 TUPLE: pack align fill vector ;
 
 : pref-dims ( gadget -- list )
-    gadget-children [ pref-dim ] map ;
+    gadget-children [ pref-dim ] map >list ;
 
 : orient ( gadget list1 list2 -- list )
     zip >r pack-vector r> [ uncons rot set-axis ] map-with ;