Commitcf0208e1Recorded3 Mar 2026Repositorysigil-format
Optimize formatter: raw vector paren-info, local state, zero-alloc form matching
Message
Replace paren-info define-struct with raw vectors (4.7x faster construction). Replace analysis-state struct with local mutable variables and inner defines, eliminating struct accessor/mutator overhead on every token. Add zero-allocation get-form-type that matches common keywords (let, define, begin, letrec) via direct char comparison, only allocating for rare define-* forms.
Also skip get-form-type entirely for lparens not at line start, since those form-types are only used by indent-based inference checks.
Total format time on build.sgl (2829 lines, 135KB): 30s -> 1.9s.
Changed
src/sigil/format.sgl | 419 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++---------------------------------------------------------------------------------------
1 file changed, 207 insertions(+), 212 deletions(-)Diff
src/sigil/format.sglmodified
@@ -473,143 +473,182 @@
473
;;; Paren Stack for Tracking 474
;; ============================================================ 475
−476
(define-struct paren-info−477
(type) ; 'lparen or 'lbracket−478
(line) ; where opened−479
(column)−480
(indent) ; indentation when opened−481
(form-type)) ; 'define, 'begin, 'let, etc. or #f+476
;; Paren-info layout: #(type line column indent form-type)+477
;; Using raw vectors avoids keyword-arg overhead. 478
479
;; ============================================================ 480
;;; Inference Engine 481
;; ============================================================ 482
−487
;;; Mutable state for analysis−488
(define-struct analysis-state−489
(paren-stack mutable: #t)−490
(inferences mutable: #t)−491
(errors mutable: #t)−492
(warnings mutable: #t)−493
(depth mutable: #t))−494
−495
;; Helper: get form type from first symbol after lparen−496
(define (get-form-type tokens-after chars)−497
(let loop ((ts tokens-after))+483
;; Zero-allocation form type matching for common keywords.+484
;; Only allocates (via token-value + string->symbol) for rare define-* forms.+485
(define (get-form-type rest chars)+486
(let loop ((ts rest)) 487
(if (null? ts) 488
#f−500
(let ((tok (car ts)))−501
(case (token-type tok)−502
((whitespace newline comment) (loop (cdr ts)))−503
((symbol) (string->symbol (token-value tok chars)))+489
(let* ((tok (car ts))+490
(tt (vector-ref tok 0)))+491
(cond+492
((or (eq? tt 'whitespace) (eq? tt 'newline) (eq? tt 'comment))+493
(loop (cdr ts)))+494
((eq? tt 'symbol)+495
(let* ((s (vector-ref tok 1))+496
(e (vector-ref tok 2))+497
(n (- e s)))+498
(cond+499
((= n 3) ;; let+500
(if (and (char=? (vector-ref chars s) #\l)+501
(char=? (vector-ref chars (+ s 1)) #\e)+502
(char=? (vector-ref chars (+ s 2)) #\t))+503
'let #f))+504
((= n 4) ;; let*+505
(if (and (char=? (vector-ref chars s) #\l)+506
(char=? (vector-ref chars (+ s 1)) #\e)+507
(char=? (vector-ref chars (+ s 2)) #\t)+508
(char=? (vector-ref chars (+ s 3)) #\*))+509
'let* #f))+510
((= n 5) ;; begin+511
(if (and (char=? (vector-ref chars s) #\b)+512
(char=? (vector-ref chars (+ s 1)) #\e)+513
(char=? (vector-ref chars (+ s 2)) #\g)+514
(char=? (vector-ref chars (+ s 3)) #\i)+515
(char=? (vector-ref chars (+ s 4)) #\n))+516
'begin #f))+517
((= n 6) ;; define or letrec+518
(cond+519
((and (char=? (vector-ref chars s) #\d)+520
(char=? (vector-ref chars (+ s 1)) #\e)+521
(char=? (vector-ref chars (+ s 2)) #\f)+522
(char=? (vector-ref chars (+ s 3)) #\i)+523
(char=? (vector-ref chars (+ s 4)) #\n)+524
(char=? (vector-ref chars (+ s 5)) #\e))+525
'define)+526
((and (char=? (vector-ref chars s) #\l)+527
(char=? (vector-ref chars (+ s 1)) #\e)+528
(char=? (vector-ref chars (+ s 2)) #\t)+529
(char=? (vector-ref chars (+ s 3)) #\r)+530
(char=? (vector-ref chars (+ s 4)) #\e)+531
(char=? (vector-ref chars (+ s 5)) #\c))+532
'letrec)+533
(else #f)))+534
;; define-syntax (13), define-struct (13), define-library (14)+535
((and (> n 6)+536
(char=? (vector-ref chars s) #\d)+537
(char=? (vector-ref chars (+ s 1)) #\e)+538
(char=? (vector-ref chars (+ s 2)) #\f)+539
(char=? (vector-ref chars (+ s 3)) #\i)+540
(char=? (vector-ref chars (+ s 4)) #\n)+541
(char=? (vector-ref chars (+ s 5)) #\e)+542
(char=? (vector-ref chars (+ s 6)) #\-))+543
(string->symbol (token-value tok chars)))+544
(else #f)))) 545
(else #f)))))) 546
−506
;; Helper: calculate expected indent for current depth−507
;; Using 2-space convention: depth 0 = col 0, depth 1 = col 2, etc.−508
(define (expected-indent-for-depth depth)−509
(* depth 2))−510
−511
;; Helper: check if a form appears at unexpectedly deep indent−512
;; This suggests a previous form was closed prematurely−513
;; Called only for lparen/lbracket at line start with pre-computed form-type−514
(define (check-indent-mismatch state tok form-type)−515
(let ((tok-indent (vector-ref tok 5))−516
(current-depth (analysis-state-depth state)))−517
(if (and form-type−518
(memq form-type '(define define-syntax define-library define-struct−519
let let* letrec begin)))−520
(let ((expected-indent (* current-depth 2)))−521
(if (> tok-indent expected-indent)−522
(set-analysis-state-warnings! state−523
(cons (format-warning−524
line: (vector-ref tok 3)−525
column: (vector-ref tok 4)−526
message: (format "~a at column ~a is deeper than expected ~a for nesting depth ~a - check if previous form closed too early"−527
form-type (+ tok-indent 1) (+ expected-indent 1) current-depth)−528
code: "W001")−529
(analysis-state-warnings state))))))))−530
−531
;; Helper: find a paren in stack at given indent level with matching form type−532
(define (find-matching-form-in-stack state form-type indent)−533
(let loop ((stack (analysis-state-paren-stack state)) (count 0))−534
(if (null? stack)−535
#f−536
(let ((entry (car stack)))−537
(if (and (eq? (paren-info-form-type entry) form-type)−538
(= (paren-info-indent entry) indent))−539
count−540
(loop (cdr stack) (+ count 1)))))))−541
−542
;; Helper: check if we should infer closing parens−543
;; Trigger when we see a form (like define) at the same indentation−544
;; as an unclosed form of the same type in the stack−545
;; Called only for lparen/lbracket at line start with pre-computed form-type−546
(define (check-indent-decrease state tok form-type prev-content-line)−547
(if (and form-type−548
(memq form-type '(define define-syntax define-struct let let* letrec)))−549
(let ((tok-indent (vector-ref tok 5))−550
(tok-line (vector-ref tok 3)))−551
(let ((match-count (find-matching-form-in-stack state form-type tok-indent)))−552
(if match-count−553
;; Close all parens up to and including the matching one−554
;; Use prev-content-line so ) goes at end of previous content−555
(let ((close-at-line (or prev-content-line tok-line)))−556
(let loop ((to-close (+ match-count 1)))−557
(if (and (> to-close 0) (not (null? (analysis-state-paren-stack state))))−558
(let ((top (car (analysis-state-paren-stack state))))−559
(set-analysis-state-inferences! state−560
(cons (paren-inference−561
line: close-at-line−562
column: 9999 ; End of line marker−563
type: 'close−564
confidence: 'high−565
reason: (format "New ~a at same level - ~a from line ~a should close"−566
form-type−567
(if (eq? (paren-info-type top) 'lparen) "(" "[")−568
(paren-info-line top)))−569
(analysis-state-inferences state)))−570
(set-analysis-state-paren-stack! state (cdr (analysis-state-paren-stack state)))−571
(set-analysis-state-depth! state (- (analysis-state-depth state) 1))−572
(loop (- to-close 1)))))))))))−573
−574
;; Helper: check if a token is content (not whitespace/newline/comment)−575
(define (content-token? tok)−576
(not (memq (token-type tok) '(whitespace newline comment eof))))−577
547
;;; Analyze tokens and infer missing parens 548
(define (analyze-and-infer tokens filename chars)−580
(let ((state (analysis-state paren-stack: '() inferences: '() errors: '() warnings: '() depth: 0)))+549
;; Mutable analysis state as local variables (avoids struct overhead)+550
(let ((paren-stack '())+551
(inferences '())+552
(errors '())+553
(warnings '())+554
(depth 0))+555
+556
;; Find a paren in stack at given indent level with matching form type+557
(define (find-matching-form form-type indent)+558
(let loop ((stack paren-stack) (count 0))+559
(if (null? stack)+560
#f+561
(let ((entry (car stack)))+562
(if (and (eq? (vector-ref entry 4) form-type)+563
(= (vector-ref entry 3) indent))+564
count+565
(loop (cdr stack) (+ count 1)))))))+566
+567
;; Check indent mismatch (form deeper than expected)+568
(define (check-indent-mismatch tok form-type)+569
(if (and form-type+570
(memq form-type '(define define-syntax define-library define-struct+571
let let* letrec begin)))+572
(let ((tok-indent (vector-ref tok 5))+573
(expected-indent (* depth 2)))+574
(if (> tok-indent expected-indent)+575
(set! warnings+576
(cons (format-warning+577
line: (vector-ref tok 3)+578
column: (vector-ref tok 4)+579
message: (format "~a at column ~a is deeper than expected ~a for nesting depth ~a - check if previous form closed too early"+580
form-type (+ tok-indent 1) (+ expected-indent 1) depth)+581
code: "W001")+582
warnings))))))+583
+584
;; Check indent decrease (infer closing parens)+585
(define (check-indent-decrease tok form-type prev-content-line)+586
(if (and form-type+587
(memq form-type '(define define-syntax define-struct let let* letrec)))+588
(let ((match-count (find-matching-form form-type (vector-ref tok 5))))+589
(if match-count+590
(let ((close-at-line (or prev-content-line (vector-ref tok 3))))+591
(let loop ((to-close (+ match-count 1)))+592
(if (and (> to-close 0) (not (null? paren-stack)))+593
(let ((top (car paren-stack)))+594
(set! inferences+595
(cons (paren-inference+596
line: close-at-line+597
column: 9999+598
type: 'close+599
confidence: 'high+600
reason: (format "New ~a at same level - ~a from line ~a should close"+601
form-type+602
(if (eq? (vector-ref top 0) 'lparen) "(" "[")+603
(vector-ref top 1)))+604
inferences))+605
(set! paren-stack (cdr paren-stack))+606
(set! depth (- depth 1))+607
(loop (- to-close 1))))))))))+608
+609
;; Push a paren-info onto the stack+610
(define (push-paren! type tok form-type)+611
(set! paren-stack+612
(cons (vector type (vector-ref tok 3) (vector-ref tok 4)+613
(vector-ref tok 5) form-type)+614
paren-stack))+615
(set! depth (+ depth 1)))+616
+617
;; Pop a paren from the stack+618
(define (pop-paren!)+619
(set! paren-stack (cdr paren-stack))+620
(set! depth (- depth 1))) 621
622
;; Process each token−583
;; Track prev-content-line: the line number of the last non-whitespace token 623
(let loop ((ts tokens) (prev-tok #f) (prev-content-line #f)) 624
(if (null? ts) 625
;; End of tokens - check for unclosed parens 626
(begin−588
(if (not (null? (analysis-state-paren-stack state)))−589
(let close-loop ((stack (analysis-state-paren-stack state)))−590
(if (not (null? stack))−591
(let* ((top (car stack))−592
(open-char (case (paren-info-type top)−593
((lparen) "(")−594
((lbracket) "[")−595
((hash-lbrace) "#{")−596
((hash-lbracket) "#[")−597
(else "?"))))−598
(set-analysis-state-inferences! state−599
(cons (paren-inference−600
line: (or prev-content-line 1)−601
column: 9999 ; End of line marker−602
type: (paren-info-type top) ; Store opener type for closer selection−603
confidence: 'medium−604
reason: (format "End of file - closing ~a from line ~a"−605
open-char−606
(paren-info-line top)))−607
(analysis-state-inferences state)))−608
(close-loop (cdr stack))))))+627
(let close-loop ((stack paren-stack))+628
(if (not (null? stack))+629
(let* ((top (car stack))+630
(top-type (vector-ref top 0))+631
(open-char (case top-type+632
((lparen) "(")+633
((lbracket) "[")+634
((hash-lbrace) "#{")+635
((hash-lbracket) "#[")+636
(else "?"))))+637
(set! inferences+638
(cons (paren-inference+639
line: (or prev-content-line 1)+640
column: 9999+641
type: top-type+642
confidence: 'medium+643
reason: (format "End of file - closing ~a from line ~a"+644
open-char+645
(vector-ref top 1)))+646
inferences))+647
(close-loop (cdr stack))))) 648
;; Return analysis result−610
(list (reverse (analysis-state-inferences state))−611
(reverse (analysis-state-errors state))−612
(reverse (analysis-state-warnings state))))+649
(list (reverse inferences)+650
(reverse errors)+651
(reverse warnings))) 652
653
(let* ((tok (car ts)) 654
(rest (cdr ts))@@ -620,131 +659,87 @@
659
((lparen) 660
;; Compute form-type once; check indent only at line start 661
(let* ((at-line-start (= (vector-ref tok 4) (+ (vector-ref tok 5) 1)))−623
(form-type (get-form-type rest chars)))+662
(form-type (if at-line-start (get-form-type rest chars) #f))) 663
(when at-line-start−625
(check-indent-decrease state tok form-type prev-content-line)−626
(check-indent-mismatch state tok form-type))−627
(set-analysis-state-paren-stack! state−628
(cons (paren-info−629
type: 'lparen−630
line: (vector-ref tok 3)−631
column: (vector-ref tok 4)−632
indent: (vector-ref tok 5)−633
form-type: form-type)−634
(analysis-state-paren-stack state)))−635
(set-analysis-state-depth! state (+ (analysis-state-depth state) 1))))+664
(check-indent-decrease tok form-type prev-content-line)+665
(check-indent-mismatch tok form-type))+666
(push-paren! 'lparen tok form-type))) 667
668
((lbracket)−638
(set-analysis-state-paren-stack! state−639
(cons (paren-info−640
type: 'lbracket−641
line: (vector-ref tok 3)−642
column: (vector-ref tok 4)−643
indent: (vector-ref tok 5)−644
form-type: #f)−645
(analysis-state-paren-stack state)))−646
(set-analysis-state-depth! state (+ (analysis-state-depth state) 1)))+669
(push-paren! 'lbracket tok #f)) 670
671
((rparen)−649
(if (null? (analysis-state-paren-stack state))−650
;; No matching open paren - mark for removal instead of error−651
(set-analysis-state-inferences! state+672
(if (null? paren-stack)+673
(set! inferences 674
(cons (paren-inference−653
line: (token-line tok)−654
column: (token-column tok)+675
line: (vector-ref tok 3)+676
column: (vector-ref tok 4) 677
type: 'remove 678
confidence: 'medium 679
reason: "Unexpected closing parenthesis - no matching open")−658
(analysis-state-inferences state)))−659
(let ((top (car (analysis-state-paren-stack state))))−660
(if (not (eq? (paren-info-type top) 'lparen))−661
;; Mismatched bracket type - still an error for now−662
(set-analysis-state-errors! state+680
inferences))+681
(let ((top (car paren-stack)))+682
(if (not (eq? (vector-ref top 0) 'lparen))+683
(set! errors 684
(cons (format-error−664
line: (token-line tok)−665
column: (token-column tok)+685
line: (vector-ref tok 3)+686
column: (vector-ref tok 4) 687
message: (format "Mismatched brackets: [ at line ~a closed with )"−667
(paren-info-line top))+688
(vector-ref top 1)) 689
code: "E003")−669
(analysis-state-errors state)))−670
(begin−671
(set-analysis-state-paren-stack! state (cdr (analysis-state-paren-stack state)))−672
(set-analysis-state-depth! state (- (analysis-state-depth state) 1)))))))+690
errors))+691
(pop-paren!))))) 692
693
((rbracket)−675
(if (null? (analysis-state-paren-stack state))−676
;; No matching open bracket - mark for removal instead of error−677
(set-analysis-state-inferences! state+694
(if (null? paren-stack)+695
(set! inferences 696
(cons (paren-inference−679
line: (token-line tok)−680
column: (token-column tok)+697
line: (vector-ref tok 3)+698
column: (vector-ref tok 4) 699
type: 'remove 700
confidence: 'medium 701
reason: "Unexpected closing bracket - no matching open")−684
(analysis-state-inferences state)))−685
(let ((top (car (analysis-state-paren-stack state))))−686
(if (not (memq (paren-info-type top) '(lbracket hash-lbracket)))−687
(set-analysis-state-errors! state+702
inferences))+703
(let ((top (car paren-stack)))+704
(if (not (memq (vector-ref top 0) '(lbracket hash-lbracket)))+705
(set! errors 706
(cons (format-error−689
line: (token-line tok)−690
column: (token-column tok)+707
line: (vector-ref tok 3)+708
column: (vector-ref tok 4) 709
message: (format "Mismatched brackets: ( at line ~a closed with ]"−692
(paren-info-line top))+710
(vector-ref top 1)) 711
code: "E003")−694
(analysis-state-errors state)))−695
(begin−696
(set-analysis-state-paren-stack! state (cdr (analysis-state-paren-stack state)))−697
(set-analysis-state-depth! state (- (analysis-state-depth state) 1)))))))+712
errors))+713
(pop-paren!))))) 714
−699
;; Dict literal: #{...} 715
((hash-lbrace)−701
(set-analysis-state-paren-stack! state−702
(cons (paren-info−703
type: 'hash-lbrace−704
line: (token-line tok)−705
column: (token-column tok)−706
indent: (token-indent tok)−707
form-type: #f)−708
(analysis-state-paren-stack state)))−709
(set-analysis-state-depth! state (+ (analysis-state-depth state) 1)))−710
−711
;; Array literal: #[...]+716
(push-paren! 'hash-lbrace tok #f))+717
718
((hash-lbracket)−713
(set-analysis-state-paren-stack! state−714
(cons (paren-info−715
type: 'hash-lbracket−716
line: (token-line tok)−717
column: (token-column tok)−718
indent: (token-indent tok)−719
form-type: #f)−720
(analysis-state-paren-stack state)))−721
(set-analysis-state-depth! state (+ (analysis-state-depth state) 1)))−722
−723
;; Closing brace for #{...}+719
(push-paren! 'hash-lbracket tok #f))+720
721
((rbrace)−725
(if (null? (analysis-state-paren-stack state))−726
(set-analysis-state-inferences! state+722
(if (null? paren-stack)+723
(set! inferences 724
(cons (paren-inference−728
line: (token-line tok)−729
column: (token-column tok)+725
line: (vector-ref tok 3)+726
column: (vector-ref tok 4) 727
type: 'remove 728
confidence: 'medium 729
reason: "Unexpected closing brace - no matching open")−733
(analysis-state-inferences state)))−734
(let ((top (car (analysis-state-paren-stack state))))−735
(if (not (eq? (paren-info-type top) 'hash-lbrace))−736
(set-analysis-state-errors! state+730
inferences))+731
(let ((top (car paren-stack)))+732
(if (not (eq? (vector-ref top 0) 'hash-lbrace))+733
(set! errors 734
(cons (format-error−738
line: (token-line tok)−739
column: (token-column tok)+735
line: (vector-ref tok 3)+736
column: (vector-ref tok 4) 737
message: (format "Mismatched: ~a at line ~a closed with }"−741
(paren-info-type top)−742
(paren-info-line top))+738
(vector-ref top 0)+739
(vector-ref top 1)) 740
code: "E003")−744
(analysis-state-errors state)))−745
(begin−746
(set-analysis-state-paren-stack! state (cdr (analysis-state-paren-stack state)))−747
(set-analysis-state-depth! state (- (analysis-state-depth state) 1))))))))+741
errors))+742
(pop-paren!)))))) 743
744
;; Update prev-content-line if this is a content token 745
(loop rest tok