lantern-system: ship fs.read-dir over the bulk lane (drop the O(n²) json-encode)

Message

fs.read-dir returned #{ entries: (N stat dicts) total: }, which the bridge json-ENCODES on the normal resolve path — and that per-char encode is O(n²) (the same cost fs.read-file already dodges via the bulk lane). Measured on a 600-file folder: json-encoding the result was ~359ms of a ~607ms listing, and it gets quadratically worse on larger folders.

Build the listing's TSV on the host and ship it as base64 over the BULK lane instead (the #{ bulk-b64: meta: } shape fs.read-file uses), bypassing the json-encode entirely. The wire format is exactly what (slate providers lantern) parse-dir-tsv already consumes: "<name>t<type>t<size>" per line, names %-escaped for % / TAB / NEWLINE, with the "capped" marker row baked in when the listing is truncated. The TSV is built in one O(n) string-join (not incremental string-append) and names escape via a char-list pass, so the encode is O(n).

Measured result: 600-file listing 607ms -> 288ms (~53%), and the O(n²) tail is gone so large folders stay responsive. Tests updated to decode the bulk TSV (lantern-system 28 passed, lantern 39 passed).

Changed

 lantern-system/src/lantern-system/fs.sgl    | 64 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++--
 lantern-system/test/test-lantern-system.sgl | 52 +++++++++++++++++++++++++++++++++++++++-------------
 2 files changed, 101 insertions(+), 15 deletions(-)

Diff

lantern-system/src/lantern-system/fs.sglmodified

@@ -47,6 +47,62 @@

mtime: (dict-ref st mtime: 0)

mode: (dict-ref st mode: 0)))

+50

;; ---- read-dir TSV encoding (the BULK lane, O(n)) -------------------------

+51

;; fs.read-dir used to return #{ entries: (600 stat dicts) total: } — which the

+52

;; bridge json-ENCODES on the normal resolve path, and that encode is O(n²)

+53

;; (per-char string-ref; the same cost fs.read-file dodged via the bulk lane).

+54

;; Measured ~359ms of a 607ms 600-file listing. So build the listing's TSV on

+55

;; the host and ship it as base64 over the BULK lane instead — no json-encode,

+56

;; less IPC, and it removes the O(n²) blow-up on large folders. The wire format

+57

;; is exactly what (slate providers lantern) parse-dir-tsv already consumes:

+58

;; "<name>\t<type>\t<size>" per line, names %-escaped for % / TAB / NEWLINE.

+59

+60

;; Escape a name for the TSV: % / TAB / NEWLINE -> %25 / %09 / %0A (so the

+61

;; name never breaks the tab/newline framing; parse-dir-tsv's decode-name

+62

;; reverses it). Built as a char list right-to-left then list->string — O(name),

+63

;; no incremental string-append, only (sigil core) primitives.

+64

(define (tsv-escape-name nm)

+65

(let loop ((i (- (string-length nm) 1)) (acc '()))

+66

(if (< i 0)

+67

(list->string acc)

+68

(let ((c (string-ref nm i)))

+69

(loop (- i 1)

+70

(cond ((char=? c #\%) (cons #\% (cons #\2 (cons #\5 acc))))

+71

((char=? c #\tab) (cons #\% (cons #\0 (cons #\9 acc))))

+72

((char=? c #\newline) (cons #\% (cons #\0 (cons #\A acc))))

+73

(else (cons c acc))))))))

+74

+75

;; type: is a symbol (regular/directory/…); parse-dir-tsv only distinguishes

+76

;; "directory", but keep the full lowering for fidelity with stat->json.

+77

(define (tsv-type t)

+78

(cond ((symbol? t) (symbol->string t))

+79

((string? t) t)

+80

(else "regular")))

+81

+82

(define (stat->tsv-row st)

+83

(string-append (tsv-escape-name (dict-ref st name: ""))

+84

"\t" (tsv-type (dict-ref st type: #f))

+85

"\t" (number->string (dict-ref st size: 0))))

+86

+87

;; A visible "capped" marker row when the listing was truncated (limit:), so

+88

;; the missing entries are shown rather than silently dropped (mirrors the old

+89

;; JS entriesTsv marker).

+90

(define (tsv-cap-marker shown total)

+91

(string-append "⋯ +" (number->string (- total shown))

+92

" more (listing capped at " (number->string shown) ")\tregular\t0"))

+93

+94

;; Build the whole listing's TSV in ONE join (O(n) — NOT incremental

+95

;; string-append), then base64 it for the bulk lane.

+96

(define (entries->tsv-b64 sorted total)

+97

(let* ((rows (map stat->tsv-row sorted))

+98

(rows+ (if (> total (length sorted))

+99

(append rows (list (tsv-cap-marker (length sorted) total)))

+100

rows))

+101

(tsv (string-join rows+ "\n")))

+102

;; base64-encode's ->bytes UTF-8-encodes a string, so pass the TSV string

+103

;; directly (no (sigil io) string->utf8 dependency here).

+104

(base64-encode tsv)))

+105

106

;; Build the fs command set bound to grants table `g`.

107

(define (fs-commands g)

108

(list

@@ -99,8 +155,12 @@

155

(let ((st (guard (e (#t #f))

156

(fs-stat g (path-join path (car ns))))))

157

(loop (cdr ns) (if st (cons st acc) acc))))))

−102

(entries (map stat->json (fs-sort-entries stats))))

−103

(dict entries: entries total: total)))))

+158

(sorted (fs-sort-entries stats)))

+159

;; BULK lane: ship the listing's TSV as base64 (no json-encode of

+160

;; the entries — that was ~59% of the cost and O(n²)). Delivered

+161

;; via #{ bulk-b64: meta: }, the same shape fs.read-file uses.

+162

(dict bulk-b64: (entries->tsv-b64 sorted total)

+163

meta: (dict total: total))))))

164

165

;; fs.stat #{ path: } -> a stat dict.

166

(lantern-command "fs.stat"

lantern-system/test/test-lantern-system.sglmodified

@@ -141,11 +141,29 @@

141

;; and nothing got registered for a would-be handle

142

(assert-equal (servable-lookup reg "f1") #f)))

143

+144

;; fs.read-dir now ships the listing's TSV over the BULK lane (bulk-b64) to skip

+145

;; the O(n²) json-encode. Decode it back to rows — the test-side mirror of

+146

;; (slate providers lantern) parse-dir-tsv — so these tests assert on the same

+147

;; entries the folder view sees.

+148

(define (read-dir-rows r)

+149

(let ((tsv (utf8->string (base64-decode (dict-ref r bulk-b64: "")))))

+150

(if (string=? tsv "")

+151

'()

+152

(map (lambda (line)

+153

(let ((f (string-split line "\t")))

+154

(dict name: (car f) type: (cadr f) size: (or (string->number (caddr f)) 0))))

+155

(string-split tsv "\n")))))

+156

(define (read-dir-total r) (dict-ref (dict-ref r meta: #{}) total: 0))

+157

;; The "⋯ +N more (listing capped)" marker row (name starts with U+22EF).

+158

(define (cap-marker-row? e)

+159

(let ((nm (dict-ref e name: "")))

+160

(and (> (string-length nm) 0) (= (char->integer (string-ref nm 0)) #x22EF))))

+161

162

(test "fs.read-dir lists entries with kinds"

163

(let* ((fx (fs-fixture))

164

(rd (handler-for (dict-ref fx cmds:) "fs.read-dir")))

165

(let* ((r (rd (dict path: (dict-ref fx dir:)) #f))

−148

(entries (dict-ref r entries: '()))

+166

(entries (read-dir-rows r))

167

(names (map (lambda (e) (dict-ref e name: #f)) entries)))

168

(assert-true (member "a.txt" names))

169

(assert-true (member "sub" names))

@@ -170,7 +188,7 @@

188

(write-file-string (path-join dir ".gitignore") "i")

189

(ensure-directory (path-join dir ".git"))

190

(let* ((r (rd (dict path: dir) #f))

−173

(names (map (lambda (e) (dict-ref e name: #f)) (dict-ref r entries: '()))))

+191

(names (map (lambda (e) (dict-ref e name: #f)) (read-dir-rows r))))

192

;; hidden dirs, dirs, hidden files, files — alphabetical within each tier

193

(assert-equal names (list ".git" "sub" ".gitignore" "a.txt" "README.md")))))

194

@@ -178,13 +196,19 @@

196

(let* ((fx (fs-fixture))

197

(rd (handler-for (dict-ref fx cmds:) "fs.read-dir")))

198

;; the fixture dir has 2 top-level entries (a.txt + sub/)

−181

(let ((r (rd (dict path: (dict-ref fx dir:) limit: 1) #f)))

−182

(assert-equal (length (dict-ref r entries: '())) 1)

−183

(assert-equal (dict-ref r total: 0) 2))

−184

;; no limit: everything, total matches

−185

(let ((r (rd (dict path: (dict-ref fx dir:)) #f)))

−186

(assert-equal (length (dict-ref r entries: '())) 2)

−187

(assert-equal (dict-ref r total: 0) 2))))

+199

(let* ((r (rd (dict path: (dict-ref fx dir:) limit: 1) #f))

+200

(rows (read-dir-rows r)))

+201

;; total is the FULL count (in meta:), regardless of the cap

+202

(assert-equal (read-dir-total r) 2)

+203

;; 1 real kept entry, plus a visible "capped" marker row

+204

(assert-equal (length (filter (lambda (e) (not (cap-marker-row? e))) rows)) 1)

+205

(assert-equal (length (filter cap-marker-row? rows)) 1))

+206

;; no limit: everything, total matches, no marker

+207

(let* ((r (rd (dict path: (dict-ref fx dir:)) #f))

+208

(rows (read-dir-rows r)))

+209

(assert-equal (length rows) 2)

+210

(assert-equal (read-dir-total r) 2)

+211

(assert-equal (length (filter cap-marker-row? rows)) 0))))

212

213

(test "fs.read-file returns the file bytes on the bulk lane (utf8 meta)"

214

(let* ((fx (fs-fixture))

@@ -446,7 +470,7 @@

470

(write-file-string (path-join dir "a.txt") "hello A")

471

(dict dir: dir g: g bridge: (sys-bridge g))))

472

−449

(test "bridge: fs.read-dir resolves with entries JSON"

+473

(test "bridge: fs.read-dir resolves on the bulk lane (TSV base64, no entries JSON)"

474

(reset-evals!)

475

(let* ((fx (fs-bridge-fixture))

476

(bridge (dict-ref fx bridge:)))

@@ -454,9 +478,11 @@

478

(string-append "{\"id\":1,\"cmd\":\"fs.read-dir\",\"args\":{\"path\":\""

479

(dict-ref fx dir:) "\"}}"))

480

(let ((js (last-eval)))

−457

(assert-true (string-contains? js "window.lantern._resolve(1,"))

−458

(assert-true (string-contains? js "entries"))

−459

(assert-true (string-contains? js "a.txt")))))

+481

;; the listing crosses on the BULK lane now (base64 TSV via _resolveBulk),

+482

;; NOT as an entries JSON body — that per-entry json-encode was the O(n²) cost

+483

(assert-true (string-contains? js "window.lantern._resolveBulk(1,"))

+484

(assert-true (string-contains? js "\"total\":")) ; the full count rides in meta

+485

(assert-false (string-contains? js "entries")))))

486

487

(test "bridge: fs.read-file resolves on the bulk lane (raw base64, no JSON body)"

488

(reset-evals!)