added file-trees vocab

diff --git a/extra/file-trees/file-trees-tests.factor b/extra/file-trees/file-trees-tests.factor
new file mode 100644 (file)
index 0000000..dbb8f9f
--- /dev/null
+++ b/extra/file-trees/file-trees-tests.factor
@@ -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
\ No newline at end of file

diff --git a/extra/file-trees/file-trees.factor b/extra/file-trees/file-trees.factor
new file mode 100644 (file)
index 0000000..788291c
--- /dev/null
+++ b/extra/file-trees/file-trees.factor
@@ -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 ;
\ No newline at end of file