added file-trees vocab

db4
Sam Anklesaria 2009-05-01 11:06:20 -05:00
parent 0c718a047c
commit d9a9e16fd7
2 changed files with 27 additions and 0 deletions

View File

@ -0,0 +1,4 @@
USING: kernel file-trees ;
IN: file-trees.tests
{ "/sample/1" "/sample/2" "/killer/1" "/killer/2/3"
"/killer/2/4" "/killer/2/4/6" "/megakiller" } create-tree drop

View File

@ -0,0 +1,23 @@
USING: accessors delegate delegate.protocols io.pathnames
kernel locals namespaces sequences vectors
tools.annotations prettyprint ;
IN: file-trees
TUPLE: tree node children ;
CONSULT: sequence-protocol tree children>> [ node>> ] map ;
: <tree> ( start -- tree ) V{ } clone
[ tree boa dup children>> ] [ ".." swap tree boa ] bi swap push ;
DEFER: (tree-insert)
: tree-insert ( path tree -- ) [ unclip <tree> ] [ children>> ] bi* (tree-insert) ;
:: (tree-insert) ( path-rest path-head tree-children -- )
tree-children [ node>> path-head node>> = ] find nip
[ path-rest swap tree-insert ]
[
path-head tree-children push
path-rest [ path-head tree-insert ] unless-empty
] if* ;
: create-tree ( file-list -- tree ) [ path-components ] map
t <tree> [ [ tree-insert ] curry each ] keep ;