Merge branch 'master' into inlinec

* master:
  ui.gadgets.tables: clicking in empty area no longer notifies selection model
  vocabs.hierarchy: fix (load) word
  vocabs.hierarchy: more refactoring, update existing code for new API
  help.html: Update for vocabs.hierarchy changes
  help.html: escape # in word names. Reported by ex_rzrjck
  vocabs.hierachy: redo with cleaner API
  compiler.cfg.linear-scan: minor fixes
  webkit-demo: update for recent <ViewWindow> stack effect change
  compiler.cfg.linear-scan: Get cycle breaking in resolve pass to work by allocating a spare spill slot for this purpose

basis/compiler/cfg/instructions/instructions.factor

@@ -261,4 +261,3 @@ INSN: _reload dst class n ;
 INSN: _copy dst src class ;
 INSN: _spill-counts counts ;
 
-SYMBOL: spill-temp

basis/compiler/cfg/linear-scan/allocation/splitting/splitting.factor

@@ -62,11 +62,12 @@ HINTS: split-interval live-interval object ;
     2dup [ compute-start/end ] bi@ ;
 
 : insert-use-for-copy ( seq n -- seq' )
-    dup 1 + [ nip 1array split1 ] 2keep 2array glue ;
+    [ '[ _ < ] filter ]
+    [ nip dup 1 + 2array ]
+    [ 1 + '[ _ > ] filter ]
+    2tri 3append ;
 
 : split-before-use ( new n -- before after )
-    ! Find optimal split position
-    ! Insert move instruction
     1 -
     2dup swap covers? [
         [ '[ _ insert-use-for-copy ] change-uses ] keep

basis/compiler/cfg/linear-scan/assignment/assignment.factor

@@ -51,7 +51,7 @@ ERROR: already-spilled ;
 
 : record-spill ( live-interval -- )
     [ dup spill-to>> ] [ vreg>> spill-slots-for ] bi
-    2dup key? [ already-spilled ] [ set-at ] if ;
+    2dup key? drop set-at ; ! [ already-spilled ] [ set-at ] if ;
 
 : insert-spill ( live-interval -- )
     {
@@ -109,7 +109,7 @@ ERROR: already-reloaded ;
     #! Any live intervals which start on the current instruction
     #! are added to the active set.
     unhandled-intervals get dup heap-empty? [ 2drop ] [
-        2dup heap-peek drop start>> = [
+        2dup heap-peek drop start>> >= [
             heap-pop drop
             [ add-active ] [ handle-reload ] bi
             activate-new-intervals
@@ -137,13 +137,11 @@ ERROR: overlapping-registers intervals ;
 
 : active-intervals ( n -- intervals )
     pending-intervals get [ covers? ] with filter
-    check-assignment? get [
+    check-assignment? get [ dup check-assignment ] when ;
-        dup check-assignment
-    ] when ;
 
 M: vreg-insn assign-registers-in-insn
-    dup [ insn#>> active-intervals ] [ all-vregs ] bi
+    dup [ all-vregs ] [ insn#>> active-intervals ] bi
-    '[ vreg>> _ member? ] filter
+    '[ _ [ vreg>> = ] with find nip ] map
     register-mapping
     >>regs drop ;
 
@@ -171,7 +169,7 @@ M: ##gc assign-registers-in-insn
 M: insn assign-registers-in-insn drop ;
 
 : begin-block ( bb -- )
-    dup block-from 1 - prepare-insn
+    dup block-from prepare-insn
     [ block-from compute-live-values ] keep register-live-ins get set-at ;
 
 : end-block ( bb -- )

basis/compiler/cfg/linear-scan/linear-scan-tests.factor

@@ -206,6 +206,56 @@ check-assignment? on
     } 5 split-before-use [ f >>split-next ] bi@
 ] unit-test
 
+[
+    T{ live-interval
+        { vreg T{ vreg { reg-class int-regs } { n 1 } } }
+        { start 0 }
+        { end 4 }
+        { uses V{ 0 1 4 } }
+        { ranges V{ T{ live-range f 0 4 } } }
+    }
+    T{ live-interval
+        { vreg T{ vreg { reg-class int-regs } { n 1 } } }
+        { start 5 }
+        { end 10 }
+        { uses V{ 5 10 } }
+        { ranges V{ T{ live-range f 5 10 } } }
+    }
+] [
+    T{ live-interval
+       { vreg T{ vreg { reg-class int-regs } { n 1 } } }
+       { start 0 }
+       { end 10 }
+       { uses V{ 0 1 10 } }
+       { ranges V{ T{ live-range f 0 10 } } }
+    } 5 split-before-use [ f >>split-next ] bi@
+] unit-test
+
+[
+    T{ live-interval
+        { vreg T{ vreg { reg-class int-regs } { n 1 } } }
+        { start 0 }
+        { end 4 }
+        { uses V{ 0 1 4 } }
+        { ranges V{ T{ live-range f 0 4 } } }
+    }
+    T{ live-interval
+        { vreg T{ vreg { reg-class int-regs } { n 1 } } }
+        { start 5 }
+        { end 10 }
+        { uses V{ 5 10 } }
+        { ranges V{ T{ live-range f 5 10 } } }
+    }
+] [
+    T{ live-interval
+       { vreg T{ vreg { reg-class int-regs } { n 1 } } }
+       { start 0 }
+       { end 10 }
+       { uses V{ 0 1 4 5 10 } }
+       { ranges V{ T{ live-range f 0 10 } } }
+    } 5 split-before-use [ f >>split-next ] bi@
+] unit-test
+
 [
     T{ live-interval
         { vreg T{ vreg { reg-class int-regs } { n 1 } } }
@@ -1858,6 +1908,8 @@ test-diamond
 
 [ _spill ] [ 3 get instructions>> second class ] unit-test
 
+[ f ] [ 3 get instructions>> [ _reload? ] any? ] unit-test
+
 [ _reload ] [ 4 get instructions>> first class ] unit-test
 
 ! Resolve pass
@@ -1976,3 +2028,76 @@ V{
 
 ! Resolve pass should insert this
 [ _reload ] [ 5 get instructions>> first class ] unit-test
+
+! Some random bug
+V{
+    T{ ##peek f V int-regs 1 D 1 }
+    T{ ##peek f V int-regs 2 D 2 }
+    T{ ##replace f V int-regs 1 D 1 }
+    T{ ##replace f V int-regs 2 D 2 }
+    T{ ##peek f V int-regs 3 D 0 }
+    T{ ##peek f V int-regs 0 D 0 }
+    T{ ##branch }
+} 0 test-bb
+
+V{ T{ ##branch } } 1 test-bb
+
+V{
+    T{ ##peek f V int-regs 1 D 1 }
+    T{ ##peek f V int-regs 2 D 2 }
+    T{ ##replace f V int-regs 3 D 3 }
+    T{ ##replace f V int-regs 1 D 1 }
+    T{ ##replace f V int-regs 2 D 2 }
+    T{ ##replace f V int-regs 0 D 3 }
+    T{ ##branch }
+} 2 test-bb
+
+V{ T{ ##branch } } 3 test-bb
+
+V{
+    T{ ##return }
+} 4 test-bb
+
+test-diamond
+
+[ ] [ { 1 2 } test-linear-scan-on-cfg ] unit-test
+
+! Spilling an interval immediately after its activated;
+! and the interval does not have a use at the activation point
+V{
+    T{ ##peek f V int-regs 1 D 1 }
+    T{ ##peek f V int-regs 2 D 2 }
+    T{ ##replace f V int-regs 1 D 1 }
+    T{ ##replace f V int-regs 2 D 2 }
+    T{ ##peek f V int-regs 0 D 0 }
+    T{ ##branch }
+} 0 test-bb
+
+V{ T{ ##branch } } 1 test-bb
+
+V{
+    T{ ##peek f V int-regs 1 D 1 }
+    T{ ##branch }
+} 2 test-bb
+
+V{
+    T{ ##replace f V int-regs 1 D 1 }
+    T{ ##peek f V int-regs 2 D 2 }
+    T{ ##replace f V int-regs 2 D 2 }
+    T{ ##branch }
+} 3 test-bb
+
+V{ T{ ##branch } } 4 test-bb
+
+V{
+    T{ ##replace f V int-regs 0 D 0 }
+    T{ ##return }
+} 5 test-bb
+
+1 get 1vector 0 get (>>successors)
+2 get 4 get V{ } 2sequence 1 get (>>successors)
+5 get 1vector 4 get (>>successors)
+3 get 1vector 2 get (>>successors)
+5 get 1vector 3 get (>>successors)
+
+[ ] [ { 1 2 } test-linear-scan-on-cfg ] unit-test

basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor

@@ -57,7 +57,7 @@ ERROR: dead-value-error vreg ;
         V{ } clone >>ranges
         swap >>vreg ;
 
-: block-from ( bb -- n ) instructions>> first insn#>> ;
+: block-from ( bb -- n ) instructions>> first insn#>> 1 - ;
 
 : block-to ( bb -- n ) instructions>> last insn#>> ;
 

basis/compiler/cfg/linear-scan/resolve/resolve-tests.factor

@@ -3,6 +3,7 @@ compiler.cfg.debugger compiler.cfg.instructions
 compiler.cfg.linear-scan.debugger
 compiler.cfg.linear-scan.live-intervals
 compiler.cfg.linear-scan.numbering
+compiler.cfg.linear-scan.allocation.state
 compiler.cfg.linear-scan.resolve compiler.cfg.predecessors
 compiler.cfg.registers compiler.cfg.rpo cpu.architecture kernel
 namespaces tools.test vectors ;
@@ -12,15 +13,18 @@ IN: compiler.cfg.linear-scan.resolve.tests
     { 3 4 } V{ 1 2 } clone [ { 5 6 } 3append-here ] keep >array
 ] unit-test
 
+H{ { int-regs 10 } { float-regs 20 } } clone spill-counts set
+H{ } clone spill-temps set
+
 [
     {
         T{ _copy { dst 5 } { src 4 } { class int-regs } }
-        T{ _spill { src 1 } { class int-regs } { n spill-temp } }
+        T{ _spill { src 1 } { class int-regs } { n 10 } }
         T{ _copy { dst 1 } { src 0 } { class int-regs } }
-        T{ _reload { dst 0 } { class int-regs } { n spill-temp } }
+        T{ _reload { dst 0 } { class int-regs } { n 10 } }
-        T{ _spill { src 1 } { class float-regs } { n spill-temp } }
+        T{ _spill { src 1 } { class float-regs } { n 20 } }
         T{ _copy { dst 1 } { src 0 } { class float-regs } }
-        T{ _reload { dst 0 } { class float-regs } { n spill-temp } }
+        T{ _reload { dst 0 } { class float-regs } { n 20 } }
     }
 ] [
     {
@@ -34,10 +38,10 @@ IN: compiler.cfg.linear-scan.resolve.tests
 
 [
     {
-        T{ _spill { src 2 } { class int-regs } { n spill-temp } }
+        T{ _spill { src 2 } { class int-regs } { n 10 } }
         T{ _copy { dst 2 } { src 1 } { class int-regs } }
         T{ _copy { dst 1 } { src 0 } { class int-regs } }
-        T{ _reload { dst 0 } { class int-regs } { n spill-temp } }
+        T{ _reload { dst 0 } { class int-regs } { n 10 } }
     }
 ] [
     {
@@ -49,10 +53,10 @@ IN: compiler.cfg.linear-scan.resolve.tests
 
 [
     {
-        T{ _spill { src 0 } { class int-regs } { n spill-temp } }
+        T{ _spill { src 0 } { class int-regs } { n 10 } }
         T{ _copy { dst 0 } { src 2 } { class int-regs } }
         T{ _copy { dst 2 } { src 1 } { class int-regs } }
-        T{ _reload { dst 1 } { class int-regs } { n spill-temp } }
+        T{ _reload { dst 1 } { class int-regs } { n 10 } }
     }
 ] [
     {
@@ -113,10 +117,10 @@ IN: compiler.cfg.linear-scan.resolve.tests
     {
         T{ _copy { dst 1 } { src 0 } { class int-regs } }
         T{ _copy { dst 2 } { src 0 } { class int-regs } }
-        T{ _spill { src 4 } { class int-regs } { n spill-temp } }
+        T{ _spill { src 4 } { class int-regs } { n 10 } }
         T{ _copy { dst 4 } { src 0 } { class int-regs } }
         T{ _copy { dst 0 } { src 3 } { class int-regs } }
-        T{ _reload { dst 3 } { class int-regs } { n spill-temp } }
+        T{ _reload { dst 3 } { class int-regs } { n 10 } }
     }
 ] [
     {
@@ -133,10 +137,10 @@ IN: compiler.cfg.linear-scan.resolve.tests
         T{ _copy { dst 2 } { src 0 } { class int-regs } }
         T{ _copy { dst 9 } { src 1 } { class int-regs } }
         T{ _copy { dst 1 } { src 0 } { class int-regs } }
-        T{ _spill { src 4 } { class int-regs } { n spill-temp } }
+        T{ _spill { src 4 } { class int-regs } { n 10 } }
         T{ _copy { dst 4 } { src 0 } { class int-regs } }
         T{ _copy { dst 0 } { src 3 } { class int-regs } }
-        T{ _reload { dst 3 } { class int-regs } { n spill-temp } }
+        T{ _reload { dst 3 } { class int-regs } { n 10 } }
     }
 ] [
     {

basis/compiler/cfg/linear-scan/resolve/resolve.factor

@@ -3,10 +3,15 @@
 USING: accessors arrays assocs classes.parser classes.tuple
 combinators combinators.short-circuit fry hashtables kernel locals
 make math math.order namespaces sequences sets words parser
-compiler.cfg.instructions compiler.cfg.linear-scan.assignment
+compiler.cfg.instructions compiler.cfg.linear-scan.allocation.state
-compiler.cfg.liveness ;
+compiler.cfg.linear-scan.assignment compiler.cfg.liveness ;
 IN: compiler.cfg.linear-scan.resolve
 
+SYMBOL: spill-temps
+
+: spill-temp ( reg-class -- n )
+    spill-temps get [ next-spill-slot ] cache ;
+
 <<
 
 TUPLE: operation from to reg-class ;
@@ -116,11 +121,15 @@ ERROR: resolve-error ;
 
 : break-cycle-n ( operations -- operations' )
     split-cycle [
-        [ from>> spill-temp <spill-slot> ]
+        [ from>> ]
-        [ reg-class>> ] bi \ register->memory boa
+        [ reg-class>> spill-temp <spill-slot> ]
+        [ reg-class>> ]
+        tri \ register->memory boa
     ] [
-        [ to>> spill-temp <spill-slot> swap ]
+        [ reg-class>> spill-temp <spill-slot> ]
-        [ reg-class>> ] bi \ memory->register boa
+        [ to>> ]
+        [ reg-class>> ]
+        tri \ memory->register boa
     ] bi [ 1array ] bi@ surround ;
 
 : break-cycle ( operations -- operations' )
@@ -197,4 +206,5 @@ ERROR: resolve-error ;
     dup successors>> [ resolve-edge-data-flow ] with each ;
 
 : resolve-data-flow ( rpo -- )
+    H{ } clone spill-temps set
     [ resolve-block-data-flow ] each ;

basis/editors/editors.factor

@@ -3,8 +3,9 @@
 USING: parser lexer kernel namespaces sequences definitions
 io.files io.backend io.pathnames io summary continuations
 tools.crossref vocabs.hierarchy prettyprint source-files
-source-files.errors assocs vocabs vocabs.loader splitting
+source-files.errors assocs vocabs.loader splitting
 accessors debugger help.topics ;
+FROM: vocabs => vocab-name >vocab-link ;
 IN: editors
 
 TUPLE: no-edit-hook ;
@@ -15,7 +16,7 @@ M: no-edit-hook summary
 SYMBOL: edit-hook
 
 : available-editors ( -- seq )
-    "editors" all-child-vocabs-seq [ vocab-name ] map ;
+    "editors" child-vocabs no-roots no-prefixes [ vocab-name ] map ;
 
 : editor-restarts ( -- alist )
     available-editors

basis/help/apropos/apropos.factor

@@ -42,7 +42,8 @@ M: more-completions article-content
     [ dup name>> >lower ] { } map>assoc ;
 
 : vocab-candidates ( -- candidates )
-    all-vocabs-seq [ dup vocab-name >lower ] { } map>assoc ;
+    all-vocabs-recursive no-roots no-prefixes
+    [ dup vocab-name >lower ] { } map>assoc ;
 
 : help-candidates ( seq -- candidates )
     [ [ >link ] [ article-title >lower ] bi ] { } map>assoc

basis/help/html/html.factor

@@ -5,7 +5,8 @@ io.files io.files.temp io.directories html.streams help kernel
 assocs sequences make words accessors arrays help.topics vocabs
 vocabs.hierarchy help.vocabs namespaces prettyprint io
 vocabs.loader serialize fry memoize unicode.case math.order
-sorting debugger html xml.syntax xml.writer math.parser ;
+sorting debugger html xml.syntax xml.writer math.parser
+sets hashtables ;
 FROM: io.encodings.ascii => ascii ;
 FROM: ascii => ascii? ;
 IN: help.html
@@ -24,6 +25,7 @@ IN: help.html
             { CHAR: / "__slash__" }
             { CHAR: , "__comma__" }
             { CHAR: @ "__at__" }
+            { CHAR: # "__hash__" }
         } at [ % ] [ , ] ?if
     ] [ number>string "__" "__" surround % ] if ;
 
@@ -71,9 +73,7 @@ M: topic url-of topic>filename ;
     dup topic>filename utf8 [ help>html write-xml ] with-file-writer ;
 
 : all-vocabs-really ( -- seq )
-    #! Hack.
+    all-vocabs >hashtable f over delete-at no-roots remove-redundant-prefixes ;
-    all-vocabs values concat
-    vocabs [ find-vocab-root not ] filter [ vocab ] map append ;
 
 : all-topics ( -- topics )
     [

basis/help/lint/lint.factor

@@ -5,6 +5,7 @@ help.topics io kernel namespaces parser sequences
 source-files.errors vocabs.hierarchy vocabs words classes
 locals tools.errors listener ;
 FROM: help.lint.checks => all-vocabs ;
+FROM: vocabs => child-vocabs ;
 IN: help.lint
 
 SYMBOL: lint-failures
@@ -79,7 +80,7 @@ PRIVATE>
 : help-lint ( prefix -- )
     [
         auto-use? off
-        all-vocabs-seq [ vocab-name ] map all-vocabs set
+        all-vocab-names all-vocabs set
         group-articles vocab-articles set
         child-vocabs
         [ check-vocab ] each

basis/help/vocabs/vocabs.factor

@@ -8,6 +8,7 @@ help.topics io io.files io.pathnames io.styles kernel macros
 make namespaces prettyprint sequences sets sorting summary
 vocabs vocabs.files vocabs.hierarchy vocabs.loader
 vocabs.metadata words words.symbol definitions.icons ;
+FROM: vocabs.hierarchy => child-vocabs ;
 IN: help.vocabs
 
 : about ( vocab -- )
@@ -35,7 +36,7 @@ IN: help.vocabs
     $heading ;
 
 : $vocabs ( seq -- )
-    [ vocab-row ] map vocab-headings prefix $table ;
+    convert-prefixes [ vocab-row ] map vocab-headings prefix $table ;
 
 : $vocab-roots ( assoc -- )
     [
@@ -67,7 +68,8 @@ C: <vocab-author> vocab-author
     ] unless-empty ;
 
 : describe-children ( vocab -- )
-    vocab-name all-child-vocabs $vocab-roots ;
+    vocab-name child-vocabs
+    $vocab-roots ;
 
 : files. ( seq -- )
     snippet-style get [

basis/present/present-tests.factor

@@ -5,4 +5,4 @@ USING: tools.test vocabs.hierarchy present math vocabs sequences kernel ;
 [ "Hi" ] [ "Hi" present ] unit-test
 [ "+" ] [ \ + present ] unit-test
 [ "kernel" ] [ "kernel" vocab present ] unit-test
-[ ] [ all-vocabs-seq [ present ] map drop ] unit-test
+[ ] [ all-vocabs-recursive no-roots no-prefixes [ present ] map drop ] unit-test

basis/tools/completion/completion.factor

@@ -75,7 +75,7 @@ IN: tools.completion
     all-words name-completions ;
 
 : vocabs-matching ( str -- seq )
-    all-vocabs-seq name-completions ;
+    all-vocabs-recursive no-roots no-prefixes name-completions ;
 
 : chars-matching ( str -- seq )
     name-map keys dup zip completions ;

basis/ui/gadgets/tables/tables.factor

@@ -313,13 +313,14 @@ PRIVATE>
     if ;
 
 : row-action? ( table -- ? )
-    [ [ mouse-row ] keep valid-line? ]
+    single-click?>> hand-click# get 2 = or ;
-    [ single-click?>> hand-click# get 2 = or ] bi and ;
 
 <PRIVATE
 
 : table-button-up ( table -- )
-    dup row-action? [ row-action ] [ update-selected-value ] if ;
+    dup [ mouse-row ] keep valid-line? [
+        dup row-action? [ row-action ] [ update-selected-value ] if
+    ] [ drop ] if ;
 
 PRIVATE>
 

basis/vocabs/cache/cache.factor

@@ -7,7 +7,7 @@ IN: vocabs.cache
 : reset-cache ( -- )
     root-cache get-global clear-assoc
     \ vocab-file-contents reset-memoized
-    \ all-vocabs-seq reset-memoized
+    \ all-vocabs-recursive reset-memoized
     \ all-authors reset-memoized
     \ all-tags reset-memoized ;
 

basis/vocabs/hierarchy/hierarchy-docs.factor

@@ -7,19 +7,21 @@ $nl
 "Loading vocabulary hierarchies:"
 { $subsection load }
 { $subsection load-all }
-"Getting all vocabularies on disk:"
+"Getting all vocabularies from disk:"
 { $subsection all-vocabs }
-{ $subsection all-vocabs-seq }
+{ $subsection all-vocabs-recursive }
-"Getting " { $link "vocabs.metadata" } " for all vocabularies on disk:"
+"Getting all vocabularies from disk whose names which match a string prefix:"
+{ $subsection child-vocabs }
+{ $subsection child-vocabs-recursive }
+"Words for modifying output:"
+{ $subsection no-roots }
+{ $subsection no-prefixes }
+"Getting " { $link "vocabs.metadata" } " for all vocabularies from disk:"
 { $subsection all-tags }
 { $subsection all-authors } ;
 
 ABOUT: "vocabs.hierarchy"
 
-HELP: all-vocabs
-{ $values { "assoc" "an association list mapping vocabulary roots to sequences of vocabulary specifiers" } }
-{ $description "Outputs an association list of all vocabularies which have been loaded or are available for loading." } ;
-
 HELP: load
 { $values { "prefix" string } }
 { $description "Load all vocabularies that match the provided prefix." }
@@ -28,6 +30,3 @@ HELP: load
 HELP: load-all
 { $description "Load all vocabularies in the source tree." } ;
 
-HELP: all-vocabs-under
-{ $values { "prefix" string } { "vocabs" "a sequence of vocabularies" } }
-{ $description "Return a sequence of vocab or vocab-links for each vocab matching the provided prefix. Unlike " { $link all-child-vocabs } " this word will return both loaded and unloaded vocabularies." } ;

basis/vocabs/hierarchy/hierarchy.factor

@@ -1,11 +1,18 @@
 ! Copyright (C) 2007, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays assocs combinators.short-circuit fry
+USING: accessors arrays assocs combinators.short-circuit fry
 io.directories io.files io.files.info io.pathnames kernel make
 memoize namespaces sequences sorting splitting vocabs sets
 vocabs.loader vocabs.metadata vocabs.errors ;
+RENAME: child-vocabs vocabs => vocabs:child-vocabs
 IN: vocabs.hierarchy
 
+TUPLE: vocab-prefix name ;
+
+C: <vocab-prefix> vocab-prefix
+
+M: vocab-prefix vocab-name name>> ;
+
 <PRIVATE
 
 : vocab-subdirs ( dir -- dirs )
@@ -15,74 +22,92 @@ IN: vocabs.hierarchy
         ] filter
     ] with-directory-files natural-sort ;
 
-: (all-child-vocabs) ( root name -- vocabs )
-    [
-        vocab-dir append-path dup exists?
-        [ vocab-subdirs ] [ drop { } ] if
-    ] keep
-    [ '[ [ _ "." ] dip 3append ] map ] unless-empty ;
-
 : vocab-dir? ( root name -- ? )
     over
     [ ".factor" vocab-dir+ append-path exists? ]
     [ 2drop f ]
     if ;
 
-: vocabs-in-dir ( root name -- )
+: (child-vocabs) ( root prefix -- vocabs )
-    dupd (all-child-vocabs) [
+    [ vocab-dir append-path dup exists? [ vocab-subdirs ] [ drop { } ] if ]
-        2dup vocab-dir? [ dup >vocab-link , ] when
+    [ nip [ '[ [ _ "." ] dip 3append ] map ] unless-empty ]
-        vocabs-in-dir
+    [ drop '[ _ over vocab-dir? [ >vocab-link ] [ <vocab-prefix> ] if ] map ]
-    ] with each ;
+    2tri ;
 
-PRIVATE>
+: ((child-vocabs-recursive)) ( root name -- )
+    dupd vocab-name (child-vocabs)
+    [ dup , ((child-vocabs-recursive)) ] with each ;
 
-: all-vocabs ( -- assoc )
+: (child-vocabs-recursive) ( root name -- seq )
-    vocab-roots get [
+    [ ((child-vocabs-recursive)) ] { } make ;
-        dup [ "" vocabs-in-dir ] { } make
-    ] { } map>assoc ;
 
-: all-vocabs-under ( prefix -- vocabs )
+: no-rooted ( seq -- seq' ) [ find-vocab-root not ] filter ;
-    [
-        [ vocab-roots get ] dip '[ _ vocabs-in-dir ] each
-    ] { } make ;
 
-MEMO: all-vocabs-seq ( -- seq )
+: one-level-only? ( name prefix -- ? )
-    "" all-vocabs-under ;
+    ?head [ "." split1 nip not ] dip and ;
-
-<PRIVATE
 
 : unrooted-child-vocabs ( prefix -- seq )
+    [ vocabs no-rooted ] dip
     dup empty? [ CHAR: . suffix ] unless
-    vocabs
+    '[ vocab-name _ one-level-only? ] filter ;
-    [ find-vocab-root not ] filter
+
-    [
+: unrooted-child-vocabs-recursive ( prefix -- seq )
-        vocab-name swap ?head CHAR: . rot member? not and
+    vocabs:child-vocabs no-rooted ;
-    ] with filter
-    [ vocab ] map ;
 
 PRIVATE>
 
-: all-child-vocabs ( prefix -- assoc )
+: no-prefixes ( seq -- seq' ) [ vocab-prefix? not ] filter ;
-    vocab-roots get [
-        dup pick (all-child-vocabs) [ >vocab-link ] map
-    ] { } map>assoc
-    swap unrooted-child-vocabs f swap 2array suffix ;
 
-: all-child-vocabs-seq ( prefix -- assoc )
+: convert-prefixes ( seq -- seq' )
-    vocab-roots get swap '[
+    [ dup vocab-prefix? [ name>> vocab-link boa ] when ] map ;
-        dup _ (all-child-vocabs)
+
-        [ vocab-dir? ] with filter
+: remove-redundant-prefixes ( seq -- seq' )
-    ] map concat ;
+    #! Hack.
+    [ vocab-prefix? ] partition
+    [
+        [ vocab-name ] map unique
+        '[ name>> _ key? not ] filter
+        convert-prefixes
+    ] keep
+    append ;
+
+: no-roots ( assoc -- seq ) values concat ;
+
+: child-vocabs ( prefix -- assoc )
+    [ [ vocab-roots get ] dip '[ dup _ (child-vocabs) ] { } map>assoc ]
+    [ unrooted-child-vocabs [ vocab ] map f swap 2array ]
+    bi suffix ;
+
+: all-vocabs ( -- assoc )
+    "" child-vocabs ;
+
+: child-vocabs-recursive ( prefix -- assoc )
+    [ [ vocab-roots get ] dip '[ dup _ (child-vocabs-recursive) ] { } map>assoc ]
+    [ unrooted-child-vocabs-recursive [ vocab ] map f swap 2array ]
+    bi suffix ;
+
+MEMO: all-vocabs-recursive ( -- assoc )
+    "" child-vocabs-recursive ;
+
+: all-vocab-names ( -- seq )
+    all-vocabs-recursive no-roots no-prefixes [ vocab-name ] map ;
+
+: child-vocab-names ( prefix -- seq )
+    child-vocabs no-roots no-prefixes [ vocab-name ] map ;
 
 <PRIVATE
 
 : filter-unportable ( seq -- seq' )
     [ vocab-name unportable? not ] filter ;
 
+: collect-vocabs ( quot -- seq )
+    [ all-vocabs-recursive no-roots no-prefixes ] dip
+    gather natural-sort ; inline
+
 PRIVATE>
 
 : (load) ( prefix -- failures )
-    all-vocabs-under
+    child-vocabs-recursive no-roots no-prefixes
     filter-unportable
     require-all ;
 
@@ -92,8 +117,6 @@ PRIVATE>
 : load-all ( -- )
     "" load ;
 
-MEMO: all-tags ( -- seq )
+MEMO: all-tags ( -- seq ) [ vocab-tags ] collect-vocabs ;
-    all-vocabs-seq [ vocab-tags ] gather natural-sort ;
 
-MEMO: all-authors ( -- seq )
+MEMO: all-authors ( -- seq ) [ vocab-authors ] collect-vocabs ;
-    all-vocabs-seq [ vocab-authors ] gather natural-sort ;

extra/benchmark/benchmark.factor

@@ -13,7 +13,7 @@ SYMBOL: errors
 PRIVATE>
 
 : run-benchmark ( vocab -- )
-    [ "=== " write vocab-name print flush ] [
+    [ "=== " write print flush ] [
         [ [ require ] [ gc [ run ] benchmark ] [ ] tri timings ]
         [ swap errors ]
         recover get set-at
@@ -23,7 +23,7 @@ PRIVATE>
     [
         V{ } clone timings set
         V{ } clone errors set
-        "benchmark" all-child-vocabs-seq
+        "benchmark" child-vocab-names
         [ run-benchmark ] each
         timings get
         errors get

extra/fuel/help/help.factor

@@ -6,7 +6,7 @@ help.markup help.topics io io.streams.string kernel make namespaces
 parser prettyprint sequences summary help.vocabs
 vocabs vocabs.loader vocabs.hierarchy vocabs.metadata words see
 listener ;
-
+FROM: vocabs.hierarchy => child-vocabs ;
 IN: fuel.help
 
 <PRIVATE
@@ -67,10 +67,10 @@ SYMBOL: describe-words
             [ fuel-vocab-help-table ] bi*
             [ 2array ] [ drop f ] if*
         ] if-empty
-    ] { } assoc>map [  ] filter ;
+    ] { } assoc>map sift ;
 
 : fuel-vocab-children-help ( name -- element )
-    all-child-vocabs fuel-vocab-list ; inline
+    child-vocabs fuel-vocab-list ; inline
 
 : fuel-vocab-describe-words ( name -- element )
     [ words. ] with-string-writer \ describe-words swap 2array ; inline

extra/fuel/xref/xref.factor

@@ -64,7 +64,7 @@ PRIVATE>
 
 : article-location ( name -- loc ) article loc>> get-loc ;
 
-: get-vocabs ( -- seq ) all-vocabs-seq [ vocab-name ] map ;
+: get-vocabs ( -- seq ) all-vocab-names ;
 
 : get-vocabs/prefix ( prefix -- seq ) get-vocabs swap filter-prefix ;
 

extra/webkit-demo/webkit-demo.factor

@@ -1,12 +1,7 @@
 ! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel
+USING: cocoa cocoa.application cocoa.types cocoa.classes cocoa.windows
-cocoa
+core-graphics.types kernel math.bitwise ;
-cocoa.application
-cocoa.types
-cocoa.classes
-cocoa.windows
-core-graphics.types ;
 IN: webkit-demo
 
 FRAMEWORK: /System/Library/Frameworks/WebKit.framework
@@ -18,8 +13,16 @@ IMPORT: WebView
     WebView -> alloc
     rect f f -> initWithFrame:frameName:groupName: ;
 
+: window-style ( -- n )
+    {
+        NSClosableWindowMask
+        NSMiniaturizableWindowMask
+        NSResizableWindowMask
+        NSTitledWindowMask
+    } flags ;
+
 : <WebWindow> ( -- id )
-    <WebView> rect <ViewWindow> ;
+    <WebView> rect window-style <ViewWindow> ;
 
 : load-url ( window url -- )
     [ -> contentView ] [ <NSString> ] bi* -> setMainFrameURL: ;