(zilch core vfs): fix vfs-subdir

This commit is contained in:
puck 2025-03-02 14:04:02 +00:00
parent cab43001e6
commit 063550ca00

View file

@ -100,13 +100,13 @@
(if (string=? subdir "")
vfs
(make-vfs
(mapping-map
(lambda (key value)
(mapping-fold
(lambda (key value acc)
(cond
((string=? (car key) subdir) (values (cons "" (cdr key)) value))
((string-prefix? subdirprefix (car key)) (values (cons (string-copy (car key) subdirprefixlength) (cdr key)) value))
(else (values))))
(make-default-comparator)
((string=? (car key) subdir) (mapping-set! acc (cons "" (cdr key)) value))
((string-prefix? subdirprefix (car key)) (mapping-set! acc (cons (string-copy (car key) subdirprefixlength) (cdr key)) value))
(else acc)))
(mapping (make-default-comparator))
(vfs-contents vfs)))))
;; Generates a full VFS structure from an on-disk directory.