src/sigil/format.sgl — sigil-format

1;;; (sigil format) - Code Formatter with Paren Inference

2;;;

3;;; This library provides code formatting for Sigil with the ability to

4;;; infer missing parentheses from indentation patterns.

5;;;

6;;; Key insight: In Lisp, indentation encodes programmer intent. When

7;;; indentation decreases, it signals that forms should close. Using 2-space

8;;; convention: column 0 = depth 0, column 2 = depth 1, etc.

9;;;

10;;; Example:

11;;; (format-file "broken.msc") ; → <format-result>

12;;; (format-string "(define (foo" "test.msc") ; → <format-result>

14(define-library (sigil format)

15 (import (sigil struct)

16 (sigil string)

17 (sigil io)

18 (sigil fs)

19 (sigil format tokenize))

21 (export

22 ;; Core API

23 format-file

24 format-string

26 ;; Result inspection

27 format-result?

28 format-result-file

29 format-result-success

30 format-result-output

31 format-result-errors

32 format-result-warnings

33 format-result-inferences

35 ;; Output formatting

36 format-result->string

38 ;; Error/warning/inference records

39 format-error?

40 format-error-line

41 format-error-column

42 format-error-message

43 format-error-code

45 format-warning?

46 format-warning-line

47 format-warning-column

48 format-warning-message

49 format-warning-code

51 paren-inference?

52 paren-inference-line

53 paren-inference-column

54 paren-inference-type

55 paren-inference-confidence

56 paren-inference-reason

58 ;; Positioned tokenizer — re-exported from (sigil format tokenize)

59 ;; so existing (sigil format) consumers keep working unchanged.

60 token?

61 token-type

62 token-value

63 token-line

64 token-column

65 token-indent

67 tokenize

68 tokenize-result-chars

69 tokenize-result-tokens)

71 (begin

73 ;; ============================================================

74 ;;; Records

75 ;; ============================================================

77 (define-struct format-result

78 (file) ; filename

79 (success) ; #t if formatting succeeded

80 (output) ; formatted code (or #f if failed)

81 (errors) ; list of format-error

82 (warnings) ; list of format-warning

83 (inferences)) ; list of paren-inference

85 (define-struct format-error

86 (line) ; 1-based line

87 (column) ; 1-based column

88 (message) ; description

89 (code)) ; E001, E002, etc.

91 (define-struct format-warning

92 (line)

93 (column)

94 (message)

95 (code)) ; W001, W002, etc.

97 (define-struct paren-inference

98 (line) ; where paren was inferred

99 (column)

100 (type) ; 'open, 'close, or 'remove

101 (confidence) ; 'high, 'medium, 'low

102 (reason)) ; explanation string

103

104 ;; ============================================================

105 ;;; Tokens & Tokenizer

106 ;; ============================================================

107 ;;

108 ;; The positioned tokenizer (token type + accessors, `tokenize`, and the

109 ;; `tokenize-result-*` accessors) lives in the io-free sub-library

110 ;; (sigil format tokenize). It is imported above and re-exported below so

111 ;; existing (sigil format) consumers keep working unchanged, while WASM

112 ;; consumers (e.g. Slate Tier-B highlighting) can import just the

113 ;; tokenizer without pulling in the formatter or its deps.

114

115 ;; ============================================================

116 ;;; Paren Stack for Tracking

117 ;; ============================================================

118

119 ;; Paren-info layout: #(type line column indent form-type)

120 ;; Using raw vectors avoids keyword-arg overhead.

121

122 ;; ============================================================

123 ;;; Inference Engine

124 ;; ============================================================

125

126 ;; Zero-allocation form type matching for common keywords.

127 ;; Only allocates (via token-value + string->symbol) for rare define-* forms.

128 (define (get-form-type rest chars)

129 (let loop ((ts rest))

130 (if (null? ts)

131 #f

132 (let* ((tok (car ts))

133 (tt (vector-ref tok 0)))

134 (cond

135 ((or (eq? tt 'whitespace) (eq? tt 'newline) (eq? tt 'comment))

136 (loop (cdr ts)))

137 ((eq? tt 'symbol)

138 (let* ((s (vector-ref tok 1))

139 (e (vector-ref tok 2))

140 (n (- e s)))

141 (cond

142 ((= n 3) ;; let

143 (if (and (char=? (vector-ref chars s) #\l)

144 (char=? (vector-ref chars (+ s 1)) #\e)

145 (char=? (vector-ref chars (+ s 2)) #\t))

146 'let #f))

147 ((= n 4) ;; let*

148 (if (and (char=? (vector-ref chars s) #\l)

149 (char=? (vector-ref chars (+ s 1)) #\e)

150 (char=? (vector-ref chars (+ s 2)) #\t)

151 (char=? (vector-ref chars (+ s 3)) #\*))

152 'let* #f))

153 ((= n 5) ;; begin

154 (if (and (char=? (vector-ref chars s) #\b)

155 (char=? (vector-ref chars (+ s 1)) #\e)

156 (char=? (vector-ref chars (+ s 2)) #\g)

157 (char=? (vector-ref chars (+ s 3)) #\i)

158 (char=? (vector-ref chars (+ s 4)) #\n))

159 'begin #f))

160 ((= n 6) ;; define or letrec

161 (cond

162 ((and (char=? (vector-ref chars s) #\d)

163 (char=? (vector-ref chars (+ s 1)) #\e)

164 (char=? (vector-ref chars (+ s 2)) #\f)

165 (char=? (vector-ref chars (+ s 3)) #\i)

166 (char=? (vector-ref chars (+ s 4)) #\n)

167 (char=? (vector-ref chars (+ s 5)) #\e))

168 'define)

169 ((and (char=? (vector-ref chars s) #\l)

170 (char=? (vector-ref chars (+ s 1)) #\e)

171 (char=? (vector-ref chars (+ s 2)) #\t)

172 (char=? (vector-ref chars (+ s 3)) #\r)

173 (char=? (vector-ref chars (+ s 4)) #\e)

174 (char=? (vector-ref chars (+ s 5)) #\c))

175 'letrec)

176 (else #f)))

177 ;; define-syntax (13), define-struct (13), define-library (14)

178 ((and (> n 6)

179 (char=? (vector-ref chars s) #\d)

180 (char=? (vector-ref chars (+ s 1)) #\e)

181 (char=? (vector-ref chars (+ s 2)) #\f)

182 (char=? (vector-ref chars (+ s 3)) #\i)

183 (char=? (vector-ref chars (+ s 4)) #\n)

184 (char=? (vector-ref chars (+ s 5)) #\e)

185 (char=? (vector-ref chars (+ s 6)) #\-))

186 (string->symbol (token-value tok chars)))

187 (else #f))))

188 (else #f))))))

189

190 ;;; Analyze tokens and infer missing parens

191 (define (analyze-and-infer tokens filename chars)

192 ;; Mutable analysis state as local variables (avoids struct overhead)

193 (let ((paren-stack '())

194 (inferences '())

195 (errors '())

196 (warnings '())

197 (depth 0))

198

199 ;; Find a paren in stack at given indent level with matching form type

200 (define (find-matching-form form-type indent)

201 (let loop ((stack paren-stack) (count 0))

202 (if (null? stack)

203 #f

204 (let ((entry (car stack)))

205 (if (and (eq? (vector-ref entry 4) form-type)

206 (= (vector-ref entry 3) indent))

207 count

208 (loop (cdr stack) (+ count 1)))))))

209

210 ;; Check indent mismatch (form deeper than expected)

211 (define (check-indent-mismatch tok form-type)

212 (if (and form-type

213 (memq form-type '(define define-syntax define-library define-struct

214 let let* letrec begin)))

215 (let ((tok-indent (vector-ref tok 5))

216 (expected-indent (* depth 2)))

217 (if (> tok-indent expected-indent)

218 (set! warnings

219 (cons (format-warning

220 line: (vector-ref tok 3)

221 column: (vector-ref tok 4)

222

                                  message: (format "~a at column ~a is deeper than expected ~a for nesting depth ~a - check if previous form closed too early"

223 form-type (+ tok-indent 1) (+ expected-indent 1) depth)

224 code: "W001")

225 warnings))))))

226

227 ;; Check indent decrease (infer closing parens)

228 (define (check-indent-decrease tok form-type prev-content-line)

229 (if (and form-type

230 (memq form-type '(define define-syntax define-struct let let* letrec)))

231 (let ((match-count (find-matching-form form-type (vector-ref tok 5))))

232 (if match-count

233 (let ((close-at-line (or prev-content-line (vector-ref tok 3))))

234 (let loop ((to-close (+ match-count 1)))

235 (if (and (> to-close 0) (not (null? paren-stack)))

236 (let ((top (car paren-stack)))

237 (set! inferences

238 (cons (paren-inference

239 line: close-at-line

240 column: 9999

241 type: 'close

242 confidence: 'high

243 reason: (format "New ~a at same level - ~a from line ~a should close"

244 form-type

245 (if (eq? (vector-ref top 0) 'lparen) "(" "[")

246 (vector-ref top 1)))

247 inferences))

248 (set! paren-stack (cdr paren-stack))

249 (set! depth (- depth 1))

250 (loop (- to-close 1))))))))))

251

252 ;; Push a paren-info onto the stack

253 (define (push-paren! type tok form-type)

254 (set! paren-stack

255 (cons (vector type (vector-ref tok 3) (vector-ref tok 4)

256 (vector-ref tok 5) form-type)

257 paren-stack))

258 (set! depth (+ depth 1)))

259

260 ;; Pop a paren from the stack

261 (define (pop-paren!)

262 (set! paren-stack (cdr paren-stack))

263 (set! depth (- depth 1)))

264

265 ;; Process each token

266 (let loop ((ts tokens) (prev-tok #f) (prev-content-line #f))

267 (if (null? ts)

268 ;; End of tokens - check for unclosed parens

269 (begin

270 (let close-loop ((stack paren-stack))

271 (if (not (null? stack))

272 (let* ((top (car stack))

273 (top-type (vector-ref top 0))

274 (open-char (case top-type

275 ((lparen) "(")

276 ((lbracket) "[")

277 ((hash-lbrace) "#{")

278 ((hash-lbracket) "#[")

279 (else "?"))))

280 (set! inferences

281 (cons (paren-inference

282 line: (or prev-content-line 1)

283 column: 9999

284 type: top-type

285 confidence: 'medium

286 reason: (format "End of file - closing ~a from line ~a"

287 open-char

288 (vector-ref top 1)))

289 inferences))

290 (close-loop (cdr stack)))))

291 ;; Return analysis result

292 (list (reverse inferences)

293 (reverse errors)

294 (reverse warnings)))

295

296 (let* ((tok (car ts))

297 (rest (cdr ts))

298 (ttype (vector-ref tok 0)))

299

300 ;; Process token

301 (case ttype

302 ((lparen)

303 ;; Compute form-type once; check indent only at line start

304 (let* ((at-line-start (= (vector-ref tok 4) (+ (vector-ref tok 5) 1)))

305 (form-type (if at-line-start (get-form-type rest chars) #f)))

306 (when at-line-start

307 (check-indent-decrease tok form-type prev-content-line)

308 (check-indent-mismatch tok form-type))

309 (push-paren! 'lparen tok form-type)))

310

311 ((lbracket)

312 (push-paren! 'lbracket tok #f))

313

314 ((rparen)

315 (if (null? paren-stack)

316 (set! inferences

317 (cons (paren-inference

318 line: (vector-ref tok 3)

319 column: (vector-ref tok 4)

320 type: 'remove

321 confidence: 'medium

322 reason: "Unexpected closing parenthesis - no matching open")

323 inferences))

324 (let ((top (car paren-stack)))

325 (if (not (eq? (vector-ref top 0) 'lparen))

326 (set! errors

327 (cons (format-error

328 line: (vector-ref tok 3)

329 column: (vector-ref tok 4)

330 message: (format "Mismatched brackets: [ at line ~a closed with )"

331 (vector-ref top 1))

332 code: "E003")

333 errors))

334 (pop-paren!)))))

335

336 ((rbracket)

337 (if (null? paren-stack)

338 (set! inferences

339 (cons (paren-inference

340 line: (vector-ref tok 3)

341 column: (vector-ref tok 4)

342 type: 'remove

343 confidence: 'medium

344 reason: "Unexpected closing bracket - no matching open")

345 inferences))

346 (let ((top (car paren-stack)))

347 (if (not (memq (vector-ref top 0) '(lbracket hash-lbracket)))

348 (set! errors

349 (cons (format-error

350 line: (vector-ref tok 3)

351 column: (vector-ref tok 4)

352 message: (format "Mismatched brackets: ( at line ~a closed with ]"

353 (vector-ref top 1))

354 code: "E003")

355 errors))

356 (pop-paren!)))))

357

358 ((hash-lbrace)

359 (push-paren! 'hash-lbrace tok #f))

360

361 ((hash-lbracket)

362 (push-paren! 'hash-lbracket tok #f))

363

364 ((rbrace)

365 (if (null? paren-stack)

366 (set! inferences

367 (cons (paren-inference

368 line: (vector-ref tok 3)

369 column: (vector-ref tok 4)

370 type: 'remove

371 confidence: 'medium

372 reason: "Unexpected closing brace - no matching open")

373 inferences))

374 (let ((top (car paren-stack)))

375 (if (not (eq? (vector-ref top 0) 'hash-lbrace))

376 (set! errors

377 (cons (format-error

378 line: (vector-ref tok 3)

379 column: (vector-ref tok 4)

380 message: (format "Mismatched: ~a at line ~a closed with }"

381 (vector-ref top 0)

382 (vector-ref top 1))

383 code: "E003")

384 errors))

385 (pop-paren!))))))

386

387 ;; Update prev-content-line if this is a content token

388 (loop rest tok

389 (if (not (or (eq? ttype 'whitespace) (eq? ttype 'newline)

390 (eq? ttype 'comment) (eq? ttype 'eof)))

391 (vector-ref tok 3)

392 prev-content-line)))))))

393

394 ;; ============================================================

395 ;;; Pretty Printer

396 ;; ============================================================

397

398 ;;; Special forms that have specific indentation rules

399 (define special-forms

400 '(define define-syntax define-library define-struct

401 lambda let let* letrec letrec*

402 if cond case when unless

403 begin and or

404 do loop

405 syntax-rules))

406

407 ;;; Check if symbol is a special form

408 (define (special-form? sym)

409 (memq sym special-forms))

410

411 ;;; Build map of line -> inferences

412 (define (make-inference-map infs)

413 (let ((map '()))

414 (for-each

415 (lambda (inf)

416 (let* ((line (paren-inference-line inf))

417 (existing (assoc line map)))

418 (if existing

419 (set-cdr! existing (cons inf (cdr existing)))

420 (set! map (cons (cons line (list inf)) map)))))

421 infs)

422 map))

423

424 ;;; Build a set of tokens to remove (by line:column key)

425 (define (make-removal-set inferences)

426 (filter-map

427 (lambda (inf)

428 (if (eq? (paren-inference-type inf) 'remove)

429 (cons (paren-inference-line inf) (paren-inference-column inf))

430 #f))

431 inferences))

432

433 ;;; Check if a token should be removed

434 (define (should-remove? tok removal-set)

435 (let ((key (cons (token-line tok) (token-column tok))))

436 (member key removal-set)))

437

438 ;;; Pretty print tokens to string

439 (define (pretty-print-tokens tokens inferences chars)

440 ;; Reconstruct the source with inferred parens and removals

441 (let ((out (open-output-string))

442 (inference-map (make-inference-map inferences))

443 (removal-set (make-removal-set inferences)))

444

445 ;; Check if inference type indicates a close operation

446 (define (close-inference-type? type)

447 (memq type '(close lparen lbracket hash-lbrace hash-lbracket)))

448

449 ;; Get the closing character for an opener type

450 (define (closer-for-type type)

451 (case type

452 ((lparen close) #\))

453 ((lbracket hash-lbracket) #\])

454 ((hash-lbrace) #\})

455 (else #\))))

456

457 ;; Get close inferences for a line (column 9999 = end of line)

458 (define (get-close-inferences-for-line line)

459 (filter (lambda (inf)

460 (and (close-inference-type? (paren-inference-type inf))

461 (= (paren-inference-line inf) line)))

462 inferences))

463

464 ;; Insert close parens for a line

465 (define (insert-close-parens-for-line line)

466 (let ((infs (get-close-inferences-for-line line)))

467 (for-each

468 (lambda (inf)

469 (let ((closer (closer-for-type (paren-inference-type inf))))

470 ;; Add space before } or ] to avoid creating invalid tokens like "1}"

471 (if (memq closer '(#\} #\]))

472 (write-char #\space out))

473 (write-char closer out)))

474 infs)))

475

476 ;; Write token value directly from chars vector

477 (define (write-token-value tok)

478 (let ((s (token-start tok))

479 (e (token-end tok)))

480 (let loop ((i s))

481 (when (< i e)

482 (write-char (vector-ref chars i) out)

483 (loop (+ i 1))))))

484

485 ;; Process tokens

486 (let loop ((ts tokens) (last-line 0) (last-content-line 0) (last-inserted 0))

487 (if (null? ts)

488 (begin

489 ;; Insert any trailing close parens (only if not already done)

490 (if (> last-content-line last-inserted)

491 (insert-close-parens-for-line last-content-line))

492 (get-output-string out))

493 (let ((tok (car ts)))

494 (if (eq? (token-type tok) 'eof)

495 (begin

496 ;; Insert any trailing close parens (only if not already done)

497 (if (> last-content-line last-inserted)

498 (insert-close-parens-for-line last-content-line))

499 (get-output-string out))

500 (let ((tok-line (token-line tok))

501 (is-newline (eq? (token-type tok) 'newline)))

502 ;; Before adding a newline, insert close parens for content line

503 ;; But only if we haven't already inserted for this line

504 (let ((did-insert (and is-newline

505 (> last-content-line 0)

506 (> last-content-line last-inserted))))

507 (if did-insert

508 (insert-close-parens-for-line last-content-line))

509 ;; Add token value to output (unless marked for removal)

510 (if (not (should-remove? tok removal-set))

511 (write-token-value tok))

512 ;; Update last-content-line if not whitespace/newline

513 ;; Update last-inserted if we just inserted

514 (loop (cdr ts)

515 tok-line

516 (if (memq (token-type tok) '(whitespace newline))

517 last-content-line

518 tok-line)

519 (if did-insert last-content-line last-inserted))))))))))

520

521 ;; ============================================================

522 ;;; Output Formatters

523 ;; ============================================================

524

525 ;;; Format result as human-readable string

526 (define (format-result->string result)

527 (let ((file (format-result-file result))

528 (success (format-result-success result))

529 (errors (format-result-errors result))

530 (warnings (format-result-warnings result))

531 (inferences (format-result-inferences result)))

532 (string-append

533 (if success

534 (format "Formatting ~a...\n" file)

535 (format "Errors in ~a:\n" file))

536 (if (null? errors)

537 ""

538 (string-append

539 (string-join

540 (map (lambda (e)

541 (format " ~a:~a: error [~a]: ~a"

542 file

543 (format-error-line e)

544 (format-error-code e)

545 (format-error-message e)))

546 errors)

547 "\n")

548 "\n\n"))

549 (if (null? warnings)

550 ""

551 (string-append

552 (string-join

553 (map (lambda (w)

554 (format " ~a:~a: warning [~a]: ~a"

555 file

556 (format-warning-line w)

557 (format-warning-code w)

558 (format-warning-message w)))

559 warnings)

560 "\n")

561 "\n"))

562 (if (null? inferences)

563 ""

564 (string-append

565 "Inferences:\n"

566 (string-join

567 (map (lambda (inf)

568 (format " line ~a: ~a (~a confidence)\n Reason: ~a"

569 (paren-inference-line inf)

570 (case (paren-inference-type inf)

571 ((close lparen) "add ')'")

572 ((lbracket hash-lbracket) "add ']'")

573 ((hash-lbrace) "add '}'")

574 ((open) "add '('")

575 ((remove) "remove extra paren")

576 (else "unknown fix"))

577 (paren-inference-confidence inf)

578 (paren-inference-reason inf)))

579 inferences)

580 "\n")

581 "\n"))

582 (format "\n~a error(s), ~a warning(s), ~a inference(s)\n"

583 (length errors)

584 (length warnings)

585 (length inferences)))))

586

587 ;; format-result->json is defined in (sigil format json), which imports

588 ;; (sigil json). Loaded lazily from the CLI so the bootstrap stdlib

589 ;; does not require (sigil json).

590

591 ;; ============================================================

592 ;;; Main API

593 ;; ============================================================

594

595 ;;; Try to read a string as Scheme code to verify it's valid

596 ;;; Returns #t if valid, #f if parse error

597 (define (verify-syntax str)

598 (guard (exn (else #f))

599 (let ((port (open-input-string str)))

600 (let loop ()

601 (let ((expr (read port)))

602 (if (eof-object? expr)

603 #t

604 (loop)))))))

605

606 ;;; Format a string of source code

607 (define (format-string source filename)

608 (let* ((result (tokenize source filename))

609 (chars (car result))

610 (tokens (cdr result))

611 (analysis (analyze-and-infer tokens filename chars))

612 (inferences (car analysis))

613 (errors (cadr analysis))

614 (warnings (caddr analysis))

615 ;; Generate output if we have inferences to apply AND no hard errors

616 ;; Don't generate output if there are errors (like mismatched brackets)

617 ;; since verify-syntax can't catch reader errors

618 (has-fixes (not (null? inferences)))

619 (output (if (and (null? errors) has-fixes)

620 (pretty-print-tokens tokens inferences chars)

621 (if (null? errors)

622 source ; No changes needed

623 #f))) ; Has errors, can't fix

624 ;; Verify the output parses correctly (only if we generated output)

625 (verified (if output (verify-syntax output) #f))

626 ;; Success if: no errors AND (no inferences OR verified output)

627 (success (and (null? errors)

628 (or (null? inferences) verified))))

629 (format-result

630 file: filename

631 success: success

632 output: (if verified output #f)

633 errors: (if (and output (not verified))

634 ;; Add verification error if output didn't parse

635 (cons (format-error

636 line: 1

637 column: 1

638 message: "Auto-fix produced invalid syntax - manual review needed"

639 code: "E099")

640 errors)

641 errors)

642 warnings: warnings

643 inferences: inferences)))

644

645 ;;; Format a file

646 (define (format-file path)

647 (let ((source (call-with-input-file path

648 (lambda (port)

649 (read-string (file-size path) port)))))

650 (format-string source path)))))