Add tokenizer differential + perf harnesses
bench/bench-diff.sgl proves the local tokenizer byte-identical to the v0.16.2 implementation (inlined verbatim): full token streams, chars vectors, and token-value strings across edge cases (CRLF, tab-indent quirk, unterminated strings/block comments, unicode incl. astral), this repo's own source files, and a generated corpus.
bench/bench-perf.sgl times whole-buffer tokenize (one measurement per process; BENCHIMPL=cli|local BENCHLINES=n).
bench/README.md documents the CLI-embedded-module trap these harnesses work around: the sigil CLI embeds (sigil format ...) and shadows the local build in sigil test / eval / file runs, so imports of (sigil format tokenize) exercise the bundled version, not the working tree. The harnesses import a renamed gitignored copy (sigil format tokenize2) instead; the README has the regeneration one-liner.
.gitignore | 1 +
bench/README.md | 34 +++++++++++++
bench/bench-diff.sgl | 449 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
bench/bench-perf.sgl | 45 ++++++++++++++++++
4 files changed, 529 insertions(+).gitignoremodified
build/.sigil/src/sigil/format/tokenize2.sglbench/README.mdadded
# Tokenizer validation + benchmarks## The CLI-embedded-module trap (read first)The `sigil` CLI **embeds** `(sigil format ...)` for its `format` subcommand, andthe embedded modules SHADOW this package's local build in `sigil test`,`sigil eval`, and direct file runs. Importing `(sigil format tokenize)` in atest or bench therefore exercises the CLI's bundled version, NOT your workingtree. (Verified 2026-07-16: an export added locally is unbound at runtime;SIGIL_LIB / -L / store-cache flush / version bump do not change resolution.)Workaround used by these harnesses: create a renamed copy of the module andimport that — the embedded CLI has no `(sigil format tokenize2)`: sed 's/(define-library (sigil format tokenize)/(define-library (sigil format tokenize2)/' \ src/sigil/format/tokenize.sgl > src/sigil/format/tokenize2.sgl sigil buildThe `tokenize2.sgl` copy is gitignored scratch — regenerate it after everytokenize.sgl edit, and never commit it.## Harnesses- `bench-diff.sgl` — differential correctness: compares the local build (via tokenize2) against the v0.16.2 implementation inlined verbatim in the file. Token streams must be byte-identical (all 6 token fields, the chars vector, and token-value strings) across edge cases, this repo's own source files, and a generated corpus. Run: `sigil eval -f bench/bench-diff.sgl` (use `eval -f`, NOT a direct file run — the direct runner swallows all runtime errors silently and exits 0).- `bench-perf.sgl` — timing, one measurement per process: `BENCH_IMPL=cli|local BENCH_LINES=n sigil eval -f bench/bench-perf.sgl`. `cli` = the CLI's embedded tokenizer, `local` = the tokenize2 copy. Wall-clock on a busy box is noisy; prefer paired/min-of-N comparisons.bench/bench-diff.sgladded
;;; Differential test: NEW (sigil format tokenize) vs the OLD v0.16.2;;; implementation (inlined below, verbatim algorithm). Token streams must be;;; identical: same chars vector, same (type start end line col indent) per;;; token, same token-value strings.(import (sigil core) (sigil io) (sigil fs) (sigil format tokenize2));; ============================================================;; OLD implementation (verbatim from v0.16.2, renamed old-*);; ============================================================(define (old-token-value tok chars) (let* ((s (vector-ref tok 1)) (e (vector-ref tok 2)) (n (- e s)) (v (make-string n))) (let loop ((i 0)) (if (>= i n) v (begin (string-set! v i (vector-ref chars (+ s i))) (loop (+ i 1)))))))(define (old-char-digit? c) (and c (char>=? c #\0) (char<=? c #\9)))(define old-delimiter-table (let ((t (make-vector 128 #f))) (for-each (lambda (c) (vector-set! t (char->integer c) #t)) '(#\( #\) #\[ #\] #\{ #\} #\" #\; #\' #\` #\, #\space #\tab #\newline #\return)) t))(define (old-delimiter? c) (or (not c) (let ((code (char->integer c))) (and (< code 128) (vector-ref old-delimiter-table code)))))(define (old-looks-like-number? s) (let ((len (string-length s))) (if (= len 0) #f (let ((first (string-ref s 0))) (cond ((old-char-digit? first) #t) ((and (or (char=? first #\+) (char=? first #\-)) (> len 1) (old-char-digit? (string-ref s 1))) #t) ((and (char=? first #\.) (> len 1) (old-char-digit? (string-ref s 1))) #t) (else #f))))))(define (old-tokenize source filename) (let* ((chars (string->vector source)) (len (vector-length chars)) (pos 0) (cur-line 1) (col 1) (indent 0)) (define (advance-one!) (set! pos (+ pos 1)) (set! col (+ col 1))) (define (advance-newline!) (set! pos (+ pos 1)) (set! cur-line (+ cur-line 1)) (set! col 1) (let loop ((off 0)) (if (>= (+ pos off) len) (set! indent off) (let ((ch (vector-ref chars (+ pos off)))) (cond ((char=? ch #\space) (loop (+ off 1))) ((char=? ch #\tab) (loop (+ off 2))) (else (set! indent off))))))) (define (advance!) (when (< pos len) (let ((c (vector-ref chars pos))) (if (char=? c #\newline) (advance-newline!) (advance-one!))))) (define (skip-whitespace start-pos start-line start-col start-indent) (let loop () (if (< pos len) (let ((c (vector-ref chars pos))) (cond ((or (char=? c #\space) (char=? c #\tab)) (set! pos (+ pos 1)) (set! col (+ col 1)) (loop)) ((char=? c #\return) (set! pos (+ pos 1)) (loop)) (else (vector 'whitespace start-pos pos start-line start-col start-indent)))) (vector 'whitespace start-pos pos start-line start-col start-indent)))) (define (skip-to-delimiter) (let loop () (if (>= pos len) pos (let ((code (char->integer (vector-ref chars pos)))) (if (and (< code 128) (vector-ref old-delimiter-table code)) pos (begin (set! pos (+ pos 1)) (set! col (+ col 1)) (loop))))))) (define (skip-until-newline) (let loop () (if (>= pos len) pos (if (char=? (vector-ref chars pos) #\newline) pos (begin (set! pos (+ pos 1)) (set! col (+ col 1)) (loop)))))) (define (count-leading-spaces) (let loop ((off 0)) (if (>= (+ pos off) len) off (let ((c (vector-ref chars (+ pos off)))) (cond ((char=? c #\space) (loop (+ off 1))) ((char=? c #\tab) (loop (+ off 2))) (else off)))))) (define (read-comment start-pos start-line start-col start-indent) (let sloop ((count 0)) (if (and (< pos len) (char=? (vector-ref chars pos) #\;)) (begin (set! pos (+ pos 1)) (set! col (+ col 1)) (sloop (+ count 1))) (begin (skip-until-newline) (vector (if (>= count 3) 'doc-comment 'comment) start-pos pos start-line start-col start-indent))))) (define (read-string-token start-pos start-line start-col start-indent) (advance-one!) (let loop () (if (>= pos len) (vector 'string start-pos pos start-line start-col start-indent) (let ((c (vector-ref chars pos))) (cond ((char=? c #\") (advance-one!) (vector 'string start-pos pos start-line start-col start-indent)) ((char=? c #\\) (advance-one!) (when (< pos len) (if (char=? (vector-ref chars pos) #\newline) (advance-newline!) (advance-one!))) (loop)) ((char=? c #\newline) (advance-newline!) (loop)) (else (set! pos (+ pos 1)) (set! col (+ col 1)) (loop))))))) (define (read-hash-token start-pos start-line start-col start-indent) (advance-one!) (if (>= pos len) (vector 'hash-other start-pos pos start-line start-col start-indent) (let ((c (vector-ref chars pos))) (cond ((or (char=? c #\t) (char=? c #\T)) (advance-one!) (vector 'hash-t start-pos pos start-line start-col start-indent)) ((or (char=? c #\f) (char=? c #\F)) (advance-one!) (vector 'hash-f start-pos pos start-line start-col start-indent)) ((char=? c #\\) (advance-one!) (if (>= pos len) (vector 'char start-pos pos start-line start-col start-indent) (begin (advance-one!) (skip-to-delimiter) (vector 'char start-pos pos start-line start-col start-indent)))) ((char=? c #\|) (advance-one!) (let loop ((depth 1)) (if (= depth 0) (vector 'block-comment start-pos pos start-line start-col start-indent) (if (>= pos len) (vector 'block-comment start-pos pos start-line start-col start-indent) (let ((c (vector-ref chars pos))) (cond ((char=? c #\|) (advance-one!) (if (and (< pos len) (char=? (vector-ref chars pos) #\#)) (begin (advance-one!) (loop (- depth 1))) (loop depth))) ((char=? c #\#) (advance-one!) (if (and (< pos len) (char=? (vector-ref chars pos) #\|)) (begin (advance-one!) (loop (+ depth 1))) (loop depth))) (else (advance!) (loop depth)))))))) ((char=? c #\{) (advance-one!) (vector 'hash-lbrace start-pos pos start-line start-col start-indent)) ((char=? c #\[) (advance-one!) (vector 'hash-lbracket start-pos pos start-line start-col start-indent)) (else (skip-to-delimiter) (vector 'hash-other start-pos pos start-line start-col start-indent)))))) (set! indent (count-leading-spaces)) (let loop ((tokens '())) (if (>= pos len) (let ((eof-tok (vector 'eof pos pos cur-line col indent))) (cons chars (reverse (cons eof-tok tokens)))) (let ((c (vector-ref chars pos)) (start-pos pos) (start-line cur-line) (start-col col) (start-indent indent)) (cond ((or (char=? c #\space) (char=? c #\tab) (char=? c #\return)) (loop (cons (skip-whitespace start-pos start-line start-col start-indent) tokens))) ((char=? c #\newline) (advance-newline!) (loop (cons (vector 'newline start-pos pos start-line start-col start-indent) tokens))) ((char=? c #\;) (loop (cons (read-comment start-pos start-line start-col start-indent) tokens))) ((char=? c #\() (advance-one!) (loop (cons (vector 'lparen start-pos pos start-line start-col start-indent) tokens))) ((char=? c #\)) (advance-one!) (loop (cons (vector 'rparen start-pos pos start-line start-col start-indent) tokens))) ((char=? c #\[) (advance-one!) (loop (cons (vector 'lbracket start-pos pos start-line start-col start-indent) tokens))) ((char=? c #\]) (advance-one!) (loop (cons (vector 'rbracket start-pos pos start-line start-col start-indent) tokens))) ((char=? c #\{) (advance-one!) (loop (cons (vector 'lbrace start-pos pos start-line start-col start-indent) tokens))) ((char=? c #\}) (advance-one!) (loop (cons (vector 'rbrace start-pos pos start-line start-col start-indent) tokens))) ((char=? c #\') (advance-one!) (loop (cons (vector 'quote start-pos pos start-line start-col start-indent) tokens))) ((char=? c #\`) (advance-one!) (loop (cons (vector 'quasiquote start-pos pos start-line start-col start-indent) tokens))) ((char=? c #\,) (advance-one!) (if (and (< pos len) (char=? (vector-ref chars pos) #\@)) (begin (advance-one!) (loop (cons (vector 'unquote-splicing start-pos pos start-line start-col start-indent) tokens))) (loop (cons (vector 'unquote start-pos pos start-line start-col start-indent) tokens)))) ((char=? c #\") (loop (cons (read-string-token start-pos start-line start-col start-indent) tokens))) ((char=? c #\#) (loop (cons (read-hash-token start-pos start-line start-col start-indent) tokens))) ((char=? c #\.) (let ((next (if (< (+ pos 1) len) (vector-ref chars (+ pos 1)) #f))) (if (old-delimiter? next) (begin (advance-one!) (loop (cons (vector 'dot start-pos pos start-line start-col start-indent) tokens))) (begin (skip-to-delimiter) (let* ((text (old-token-value (vector 'symbol start-pos pos start-line start-col start-indent) chars)) (tok-type (if (old-looks-like-number? text) 'number 'symbol))) (loop (cons (vector tok-type start-pos pos start-line start-col start-indent) tokens))))))) ((or (char=? c #\+) (char=? c #\-)) (skip-to-delimiter) (let* ((text (old-token-value (vector 'symbol start-pos pos start-line start-col start-indent) chars)) (tok-type (if (old-looks-like-number? text) 'number 'symbol))) (loop (cons (vector tok-type start-pos pos start-line start-col start-indent) tokens)))) ((and (char>=? c #\0) (char<=? c #\9)) (skip-to-delimiter) (loop (cons (vector 'number start-pos pos start-line start-col start-indent) tokens))) (else (skip-to-delimiter) (loop (cons (vector 'symbol start-pos pos start-line start-col start-indent) tokens)))))))));; ============================================================;; Comparison harness;; ============================================================(define failures 0)(define (compare-streams label src) (let* ((new-r (tokenize src "diff.sgl")) (old-r (old-tokenize src "diff.sgl")) (new-chars (car new-r)) (old-chars (car old-r)) (new-toks (cdr new-r)) (old-toks (cdr old-r))) ;; chars vectors identical (let ((nn (vector-length new-chars)) (on (vector-length old-chars))) (if (not (= nn on)) (begin (set! failures (+ failures 1)) (display "FAIL ") (display label) (display ": chars length ") (display nn) (display " vs ") (display on) (newline)) (let closs ((i 0)) (when (< i nn) (if (not (char=? (vector-ref new-chars i) (vector-ref old-chars i))) (begin (set! failures (+ failures 1)) (display "FAIL ") (display label) (display ": chars differ at ") (display i) (newline)) (closs (+ i 1))))))) ;; token streams identical (let tloop ((n new-toks) (o old-toks) (idx 0)) (cond ((and (null? n) (null? o)) #t) ((or (null? n) (null? o)) (set! failures (+ failures 1)) (display "FAIL ") (display label) (display ": token count differs at index ") (display idx) (newline)) (else (let ((nt (car n)) (ot (car o))) (let fieldloop ((f 0)) (when (< f 6) (if (not (equal? (vector-ref nt f) (vector-ref ot f))) (begin (set! failures (+ failures 1)) (display "FAIL ") (display label) (display ": token ") (display idx) (display " field ") (display f) (display " new=") (write (vector-ref nt f)) (display " old=") (write (vector-ref ot f)) (display " (old tok ") (write ot) (display ")") (newline)) (fieldloop (+ f 1))))) ;; token-value identical. The OLD accessor vm-errors on non-ASCII ;; tokens (string-set! byte-width), so compare against the old ;; accessor only for ASCII tokens; for all tokens also compare ;; against an independent char-by-char string-append expected. (when (and (= (vector-length nt) 6) (= (vector-length ot) 6)) (let* ((s (vector-ref nt 1)) (e (vector-ref nt 2)) (ascii? (let aloop ((i s)) (cond ((>= i e) #t) ((>= (char->integer (vector-ref new-chars i)) 128) #f) (else (aloop (+ i 1)))))) (expected (let xloop ((i s) (acc "")) (if (>= i e) acc (xloop (+ i 1) (string-append acc (string (vector-ref new-chars i))))))) (nv (token-value nt new-chars))) (when (not (string=? nv expected)) (set! failures (+ failures 1)) (display "FAIL ") (display label) (display ": token-value vs expected differs at ") (display idx) (display " new=") (write nv) (display " expected=") (write expected) (newline)) (when ascii? (let ((ov (old-token-value ot old-chars))) (when (not (string=? nv ov)) (set! failures (+ failures 1)) (display "FAIL ") (display label) (display ": token-value differs at ") (display idx) (display " new=") (write nv) (display " old=") (write ov) (newline)))))) (tloop (cdr n) (cdr o) (+ idx 1)))))) (display "ok: ") (display label) (newline)));; --- Edge cases ---(compare-streams "empty" "")(compare-streams "whitespace-only" " \t ")(compare-streams "newlines-only" "\n\n\n")(compare-streams "crlf" "(a b)\r\n(c d)\r\n")(compare-streams "cr-inside-ws" "a \r b")(compare-streams "tabs-indent" "\t\tfoo\n\ta\n b")(compare-streams "tab-quirk" "\ta\n\tb")(compare-streams "simple" "(+ 1 2)")(compare-streams "nested" "(define (foo x)\n (+ x 1))")(compare-streams "numbers" "1 2.5 +5 -3 .5 +x -y . .foo +")(compare-streams "dot-eof" ".")(compare-streams "dot-delim" "(.)")(compare-streams "plus-eof" "+")(compare-streams "minus-eof" "-")(compare-streams "strings" "\"hello\" \"multi\nline\" \"esc\\\"aped\" \"back\\\\slash\"")(compare-streams "string-esc-newline" "\"a\\\nb\"")(compare-streams "string-unterminated" "\"abc")(compare-streams "string-trailing-backslash" "\"abc\\")(compare-streams "string-crlf-inside" "\"a\r\nb\"")(compare-streams "comments" "; one\n;; two\n;;; doc\n;;;; four\nx ; trail")(compare-streams "comment-eof" "; no newline")(compare-streams "semis-only" ";;;")(compare-streams "hash-t-f" "#t #f #T #F #true #false")(compare-streams "char-literals" "#\\a #\\newline #\\space #\\( #\\) #\\\\")(compare-streams "char-literal-newline" "#\\\n x")(compare-streams "char-eof" "#\\")(compare-streams "hash-eof" "#")(compare-streams "hash-paren" "#(1 2)")(compare-streams "hash-keyword" "#:key #!eof #u8(1)")(compare-streams "hash-brace" "#{a 1} #[1 2]")(compare-streams "block-comment" "#| simple |# x")(compare-streams "block-comment-nested" "#| a #| b |# c |# y")(compare-streams "block-comment-multiline" "#| line1\nline2\n line3 |# z")(compare-streams "block-comment-unterminated" "#| never ends")(compare-streams "block-comment-hash-tail" "#| a # | #|# x")(compare-streams "quotes" "'a `b ,c ,@d , ")(compare-streams "comma-eof" ",")(compare-streams "comma-at-eof" ",@")(compare-streams "unicode-symbols" "(λ (α β→γ) \"héllo wörld\") ; ünïcode\nπ")(compare-streams "unicode-astral" "\"emoji: 😀🎸\" 😀-sym")(compare-streams "mixed-indent" "(a\n (b\n\t(c\n \t d)))")(compare-streams "keywords" "name: value: #:kw")(compare-streams "empty-string-tok" "\"\"")(compare-streams "adjacent" "()[]{}\"\"''``,,");; --- Real files from this repo ---(define (compare-file path) (compare-streams path (read-file-string path)))(compare-file "src/sigil/format.sgl")(compare-file "src/sigil/format/tokenize.sgl")(compare-file "src/sigil/format/json.sgl")(compare-file "test/test-format.sgl")(compare-file "test/test-tokenize.sgl");; --- Generated large corpus ---(define (gen-source n-lines) (call-with-output-string (lambda (p) (let loop ((i 0)) (when (< i n-lines) (write-string "(define (fn-" p) (write-string (number->string i) p) (write-string " x) ; comment here\n (+ x " p) (write-string (number->string i) p) (write-string " \"str\"))\n" p) (loop (+ i 1)))))))(compare-streams "generated-2k-lines" (gen-source 1000))(newline)(if (= failures 0) (display "ALL DIFFERENTIAL CHECKS PASSED\n") (begin (display failures) (display " FAILURES\n")))bench/bench-perf.sgladded
;;; Single measurement in a fresh process: BENCH_IMPL=cli|local BENCH_LINES=n;;; Runs the tokenizer twice and reports both (first = cold, second = warm).(import (sigil core) (sigil io) (sigil env) (sigil time) (prefix (sigil format tokenize) cli:) (prefix (sigil format tokenize2) local:))(define (gen-source n-lines) (call-with-output-string (lambda (p) (let loop ((i 0)) (when (< i n-lines) (write-string "(define (fn-" p) (write-string (number->string i) p) (write-string " x) ; comment here\n (+ x " p) (write-string (number->string i) p) (write-string " \"str\"))\n" p) (loop (+ i 1)))))))(define impl (or (getenv "BENCH_IMPL") "new"))(define n-lines (string->number (or (getenv "BENCH_LINES") "1000")))(define src (gen-source n-lines))(define (run!) (if (string=? impl "cli") (cli:tokenize src "b.sgl") ; the sigil CLI's embedded version (local:tokenize src "b.sgl"))) ; the local build (via the tokenize2 copy)(display impl)(display " lines=") (display n-lines)(display " chars=") (display (string-length src))(display " runs=")(let loop ((k 0) (best #f)) (if (>= k 3) (begin (display " min=") (display best) (display "ms") (newline)) (let* ((t0 (current-milliseconds)) (r (run!)) (t1 (current-milliseconds)) (ms (- t1 t0))) (display ms) (display " ") (loop (+ k 1) (if (or (not best) (< ms best)) ms best)))))