From 5faea12c89f663666fc12cd57ece627fb92098f8 Mon Sep 17 00:00:00 2001 From: slava Date: Sun, 22 Oct 2006 22:08:49 +0000 Subject: [PATCH] Column virtual sequence improvements --- TODO.FACTOR.txt | 1 + library/collections/sequences-epilogue.factor | 2 +- library/collections/virtual-sequences.factor | 12 ++++-------- library/compiler/generator/templates.factor | 4 ++-- library/compiler/inference/errors.factor | 7 +++++-- library/help/markup.factor | 4 ++-- library/help/search.factor | 2 +- library/modules.factor | 8 ++++---- library/test/collections/sequences.factor | 6 +++--- library/tools/word-tools.factor | 2 +- library/ui/gadgets/tracks.factor | 2 +- library/ui/gestures.factor | 2 +- library/ui/tools/workspace.factor | 2 +- library/ui/ui.factor | 4 ++-- 14 files changed, 29 insertions(+), 29 deletions(-) diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index 5955497d23..f600f03bc8 100644 --- a/TODO.FACTOR.txt +++ b/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: diff --git a/library/collections/sequences-epilogue.factor b/library/collections/sequences-epilogue.factor index a88a47f563..82c0fb39e1 100644 --- a/library/collections/sequences-epilogue.factor +++ b/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 + [ dup like ] map-with ] unless ; : unpair ( assoc -- keys values ) diff --git a/library/collections/virtual-sequences.factor b/library/collections/virtual-sequences.factor index 20f54a1b38..179296bae6 100644 --- a/library/collections/virtual-sequences.factor +++ b/library/collections/virtual-sequences.factor @@ -1,5 +1,5 @@ -! Copyright (C) 2005 Slava Pestov. -! See http://factor.sf.net/license.txt for BSD license. +! Copyright (C) 2005, 2006 Slava Pestov. +! 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 ; diff --git a/library/compiler/generator/templates.factor b/library/compiler/generator/templates.factor index 9bcc324465..ad61509e7d 100644 --- a/library/compiler/generator/templates.factor +++ b/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 ; : 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 requested-vregs >r + r> ; : alloc-scratch ( -- ) +scratch get [ first2 >r spec>vreg r> set ] each ; diff --git a/library/compiler/inference/errors.factor b/library/compiler/inference/errors.factor index 21124eda84..0c6a4e78b4 100644 --- a/library/compiler/inference/errors.factor +++ b/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 >array dup empty? [ "Word: " write dup peek . ] unless swap delegate error. "Nesting: " write . ; diff --git a/library/help/markup.factor b/library/help/markup.factor index 3c0d5793dc..139a12c782 100644 --- a/library/help/markup.factor +++ b/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 ; diff --git a/library/help/search.factor b/library/help/search.factor index fbf300c968..a06e960f9f 100644 --- a/library/help/search.factor +++ b/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 help-outliner ; : index-help ( -- ) term-index get [ diff --git a/library/modules.factor b/library/modules.factor index ac6507eb54..005540f177 100644 --- a/library/modules.factor +++ b/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 >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 ; -: all-module-names ( -- seq ) modules get [ first ] map ; +: all-module-names ( -- seq ) modules get 0 ; : 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 ; diff --git a/library/test/collections/sequences.factor b/library/test/collections/sequences.factor index 6e8ec7ccf4..ac8563a5d7 100644 --- a/library/test/collections/sequences.factor +++ b/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 >array ] unit-test -[ ] [ 1 "seq" get [ sq ] inject ] unit-test -[ { 4 25 64 } ] [ 1 "seq" get >array ] unit-test +[ { 1 4 7 } ] [ "seq" get 0 >array ] unit-test +[ ] [ "seq" get 1 [ sq ] inject ] unit-test +[ { 4 25 64 } ] [ "seq" get 1 >array ] unit-test diff --git a/library/tools/word-tools.factor b/library/tools/word-tools.factor index 600b0940f6..e34ddd4417 100644 --- a/library/tools/word-tools.factor +++ b/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 [ swap 2array ] map-with ; : usage. ( word -- ) diff --git a/library/ui/gadgets/tracks.factor b/library/ui/gadgets/tracks.factor index 810990fe3d..369e3c9bff 100644 --- a/library/ui/gadgets/tracks.factor +++ b/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 pref-dims dup rot track-sizes track-pref-dims >r max-dim r> ] keep gadget-orientation set-axis ; diff --git a/library/ui/gestures.factor b/library/ui/gestures.factor index 7290d25b23..7c470ee943 100644 --- a/library/ui/gestures.factor +++ b/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 prune f like ; : drag-loc ( -- loc ) hand-loc get-global hand-click-loc get-global v- ; diff --git a/library/ui/tools/workspace.factor b/library/ui/tools/workspace.factor index 40aa5cac97..f9b171da87 100644 --- a/library/ui/tools/workspace.factor +++ b/library/ui/tools/workspace.factor @@ -55,7 +55,7 @@ tool "toolbar" { } ; C: workspace ( -- workspace ) - workspace-tabs [ second execute ] map + workspace-tabs 1 [ execute ] map over set-gadget-delegate dup dup set-control-self ; M: workspace pref-dim* delegate pref-dim* { 550 650 } vmax ; diff --git a/library/ui/ui.factor b/library/ui/ui.factor index c5e8467c93..285b48d699 100644 --- a/library/ui/ui.factor +++ b/library/ui/ui.factor @@ -75,7 +75,7 @@ C: titled-gadget ( gadget title -- ) open-window ; : find-window ( quot -- world ) - windows get [ second ] map + windows get 1 [ 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 >array ] keep delete-all [ dup reset-world open-window* ] each forget-rollover ;