Column virtual sequence improvements

TODO.FACTOR.txt

@@ -15,6 +15,7 @@
 - growable data heap
 - more compact relocation info
 - update module system docs
+- flip may fail with >64kb string
 
 + ui:
 

library/collections/sequences-epilogue.factor

@@ -106,7 +106,7 @@ M: object like drop ;
 : flip ( matrix -- newmatrix )
     dup empty? [
         dup first [ length ] keep like
-        [ swap [ nth ] map-with ] map-with
+        [ <column> dup like ] map-with
     ] unless ;
 
 : unpair ( assoc -- keys values )

library/collections/virtual-sequences.factor

@@ -1,5 +1,5 @@
-! Copyright (C) 2005 Slava Pestov.
+! Copyright (C) 2005, 2006 Slava Pestov.
-! See http://factor.sf.net/license.txt for BSD license.
+! See http://factorcode.org/license.txt for BSD license.
 IN: sequences
 USING: errors generic kernel math sequences-internals vectors ;
 
@@ -66,21 +66,17 @@ M: slice like slice-seq like ;
 
 M: slice thaw slice-seq thaw ;
 
-TUPLE: column col seq ;
+TUPLE: column seq col ;
 
-: column@ ( m section -- n seq )
+: column@ ( m column -- n seq )
     dup column-col -rot column-seq nth ;
 
 M: column length column-seq length ;
 
 M: column nth column@ nth ;
 
-M: column nth-unsafe column@ nth-unsafe ;
-
 M: column set-nth column@ set-nth ;
 
-M: column set-nth-unsafe column@ set-nth-unsafe ;
-
 M: column like column-seq like ;
 
 M: column thaw column-seq thaw ;

library/compiler/generator/templates.factor

@@ -111,7 +111,7 @@ SYMBOL: phantom-r
 : (live-locs) ( seq -- seq )
     dup phantom-locs* [ 2array ] 2map
     [ first2 over loc? >r = not r> and ] subset
-    [ first ] map ;
+    0 <column> ;
 
 : stack>new-vreg ( loc spec -- vreg )
     spec>vreg [ swap %peek ] keep ;
@@ -254,7 +254,7 @@ SYMBOL: +clobber
 
 : guess-vregs ( -- int# float# )
     +input get { } additional-vregs ?fp-scratch +
-    +scratch get [ first ] map requested-vregs >r + r> ;
+    +scratch get 0 <column> requested-vregs >r + r> ;
 
 : alloc-scratch ( -- )
     +scratch get [ first2 >r spec>vreg r> set ] each ;

library/compiler/inference/errors.factor

@@ -1,8 +1,11 @@
+! Copyright (C) 2006 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
 IN: inference
-USING: kernel generic errors sequences prettyprint io words ;
+USING: kernel generic errors sequences prettyprint io words
+arrays ;
 
 M: inference-error error.
-    dup inference-error-rstate [ first ] map
+    dup inference-error-rstate 0 <column> >array
     dup empty? [ "Word: " write dup peek . ] unless
     swap delegate error. "Nesting: " write . ;
 

library/help/markup.factor

@@ -242,7 +242,7 @@ M: f print-element drop ;
     drop
     "Throws an error if the I/O operation fails." $errors ;
 
-: sort-articles ( seq -- assoc )
+: sort-articles ( seq -- newseq )
     [ [ article-title ] keep 2array ] map
     [ [ first ] 2apply <=> ] sort
-    [ second ] map ;
+    1 <column> ;

library/help/search.factor

@@ -48,7 +48,7 @@ SYMBOL: term-index
     count-occurrences hash>alist rank-completions ;
 
 : search-help. ( phrase -- ) 
-    search-help [ first ] map help-outliner ;
+    search-help 0 <column> help-outliner ;
 
 : index-help ( -- )
     term-index get [

library/modules.factor

@@ -39,7 +39,7 @@ C: module ( name files tests help -- module )
 : process-files ( seq -- newseq )
     [ dup string? [ [ t ] 2array ] when ] map
     [ second call ] subset
-    [ first ] map ;
+    0 <column> >array ;
 
 : add-module ( module -- )
     dup module-name swap 2array modules get push ;
@@ -59,9 +59,9 @@ C: module ( name files tests help -- module )
 
 : test-module ( name -- ) module module-tests run-tests ;
 
-: all-modules ( -- seq ) modules get [ second ] map ;
+: all-modules ( -- seq ) modules get 1 <column> ;
 
-: all-module-names ( -- seq ) modules get [ first ] map ;
+: all-module-names ( -- seq ) modules get 0 <column> ;
 
 : test-modules ( -- )
     all-modules [ module-tests ] map concat run-tests ;
@@ -91,4 +91,4 @@ C: module ( name files tests help -- module )
     ] ?if ;
 
 : modules-help ( -- seq )
-    modules get [ second module-help ] map [ ] subset ;
+    all-modules [ module-help ] map [ ] subset ;

library/test/collections/sequences.factor

@@ -220,6 +220,6 @@ unit-test
 ! Columns
 { { 1 2 3 } { 4 5 6 } { 7 8 9 } } [ clone ] map "seq" set
 
-[ { 1 4 7 } ] [ 0 "seq" get <column> >array ] unit-test
+[ { 1 4 7 } ] [ "seq" get 0 <column> >array ] unit-test
-[ ] [ 1 "seq" get <column> [ sq ] inject ] unit-test
+[ ] [ "seq" get 1 <column> [ sq ] inject ] unit-test
-[ { 4 25 64 } ] [ 1 "seq" get <column> >array ] unit-test
+[ { 4 25 64 } ] [ "seq" get 1 <column> >array ] unit-test

library/tools/word-tools.factor

@@ -14,7 +14,7 @@ generic completion ;
 : method-usage ( word generic -- methods )
     tuck methods
     [ second flatten memq? ] subset-with
-    [ first ] map
+    0 <column>
     [ swap 2array ] map-with ;
 
 : usage. ( word -- )

library/ui/gadgets/tracks.factor

@@ -42,7 +42,7 @@ M: track layout*
 M: track pref-dim*
     [
         dup gadget-children
-        2 group [ first ] map pref-dims
+        2 group 0 <column> pref-dims
         dup rot track-sizes track-pref-dims >r max-dim r>
     ] keep gadget-orientation set-axis ;
 

library/ui/gestures.factor

@@ -142,7 +142,7 @@ SYMBOL: double-click-timeout
 
 : modifier ( mod modifiers -- seq )
     [ second swap bitand 0 > ] subset-with
-    [ first ] map prune f like ;
+    0 <column> prune f like ;
 
 : drag-loc ( -- loc )
     hand-loc get-global hand-click-loc get-global v- ;

library/ui/tools/workspace.factor

@@ -55,7 +55,7 @@ tool "toolbar" {
     } ;
 
 C: workspace ( -- workspace )
-    workspace-tabs [ second execute <tool> ] map <book>
+    workspace-tabs 1 <column> [ execute <tool> ] map <book>
     over set-gadget-delegate dup dup set-control-self ;
 
 M: workspace pref-dim* delegate pref-dim* { 550 650 } vmax ;

library/ui/ui.factor

@@ -75,7 +75,7 @@ C: titled-gadget ( gadget title -- )
     <model> <titled-gadget> <world> open-window ;
 
 : find-window ( quot -- world )
-    windows get [ second ] map
+    windows get 1 <column>
     [ world-gadget swap call ] find-last-with nip ; inline
 
 : start-world ( world -- )
@@ -112,7 +112,7 @@ C: titled-gadget ( gadget title -- )
     reset-world ;
 
 : restore-windows ( -- )
-    windows get [ [ second ] map ] keep delete-all
+    windows get [ 1 <column> >array ] keep delete-all
     [ dup reset-world open-window* ] each
     forget-rollover ;