1 USING: accessors delegate delegate.protocols io.pathnames
2 kernel locals namespaces sequences vectors
3 tools.annotations prettyprint ;
6 TUPLE: tree node children ;
7 CONSULT: sequence-protocol tree children>> [ node>> ] map ;
9 : <tree> ( start -- tree ) V{ } clone
10 [ tree boa dup children>> ] [ ".." swap tree boa ] bi swap push ;
14 : tree-insert ( path tree -- ) [ unclip <tree> ] [ children>> ] bi* (tree-insert) ;
15 :: (tree-insert) ( path-rest path-head tree-children -- )
16 tree-children [ node>> path-head node>> = ] find nip
17 [ path-rest swap tree-insert ]
19 path-head tree-children push
20 path-rest [ path-head tree-insert ] unless-empty
22 : create-tree ( file-list -- tree ) [ path-components ] map
23 t <tree> [ [ tree-insert ] curry each ] keep ;