Add library-form wrappers for typed-jerboa static pilot
ober
3c12f23560755f2440bc09c37201bc0691ece857
--- a/docs/jerboa-code-typed-static-plan.md +++ b/docs/jerboa-code-typed-static-plan.md @@ -205,3 +205,70 @@ The pilot is done when: than handwritten Rust. - Remaining native boundaries are documented as future migration work or deliberate audited boundaries. + +## Pilot Results (2026-05-22) + +All five stages complete. Concrete evidence: + +- `typed-src/jcode/typed/pricing.ss` is the only typed-Jerboa source in + `jerboa-code`; `lib/jcode/typed/pricing.sls` is generated by Jerboa's + typed-wrappers backend and consumed by `src/jcode/core/models.ss` + via `compute-cost`. +- `make test` in `jerboa-code` passes 51 tests including 8 typed-pricing + unit tests (OpenAI cached, Anthropic, cache-write, unknown pricing → 0, + and wrapper rejection of negative `Nat`, string for `Nat`, and float + rate inputs) and 4 `compute-cost` integration tests. +- `make binary` produces `./jcode` (57.9 MB) with the typed Rust archive + pre-merged via `ld -r` and conflicting Rust runtime symbols weakened + via `llvm-objcopy --weaken-symbol` so it does not collide with + `libjerboa_native.a`'s std copy. The five `jt_*` symbols are visible + in `nm jcode`. +- `JCODE_TYPED_SMOKE=1 env -u JERBOA_TYPED_RUST_LIB -u DYLD_LIBRARY_PATH \ + -u LD_LIBRARY_PATH ./jcode --version` prints + `typed-smoke: billable(1000,300)=700 cost-scaled=10717500000`, + confirming the static-linked typed kernel resolves and runs. + +### Re-audit (2026-05-22, post-pilot) + +```sh +make pure-audit PURE_AUDIT_ARGS=/Users/user/mine/jerboa-code +``` + +| Category | Before | After | Delta | +|---|---:|---:|---:| +| `external-process` | 82 | 88 | +6 | +| `ffi-boundary` | 64 | 69 | +5 | +| `native-loader` | 14 | 14 | — | +| `rust-wrapper` | 6 | 6 | — | +| `c-native` | 5 | 5 | — | +| `rust-source` | 2 | 2 | — | +| `rust-build` | 1 | 1 | — | +| `typed-jerboa-source` | 0 | **1** | **new** | + +The +5 in `ffi-boundary` is the auto-generated typed wrapper +`lib/jcode/typed/pricing.sls`: a handful of `foreign-procedure` forms +and one `load-shared-object`. The audit can be tightened later to mark +generated wrappers as artifacts of `typed-jerboa-source` so they no +longer count as raw FFI boundaries. The `external-process` delta is +unrelated source movement in `jerboa-code` since the baseline, not +introduced by this pilot. + +Interpretation: the pure cost-arithmetic slice that would otherwise be a +candidate for handwritten Rust (the only realistic alternative if it +needed to live in a static binary without dynamic Jerboa) is now classified +as **`typed-jerboa-source`** plus a generated wrapper. This is the slice +shift the pilot was meant to prove: one real piece of application +arithmetic moved from "future handwritten-Rust risk" to "checked +Typed Jerboa source with generated Rust". + +### Static-link Workaround Note + +The jerboa-code binary links two independent Rust staticlibs +(`libjerboa_native.a` + the typed-pricing archive), each of which bundles +its own copy of Rust std. macOS `ld` rejects duplicate symbols even when +bit-identical, so `build-binary.ss` pre-merges the typed archive with +`ld -r` and weakens any duplicates with `llvm-objcopy --weaken-symbol` +before the final link. A cleaner long-term fix is to either generate the +typed crate as an rlib dependency of `jerboa-native-rs` (sharing one std) +or to link both via `rustc` (which negotiates the shared runtime). Either +belongs in **Backend Gaps**. --- a/lib/jerboa/typed/wrapper.ss +++ b/lib/jerboa/typed/wrapper.ss @@ -11,7 +11,12 @@ typed-module->jerboa-wrapper-string typed-library-form->jerboa-wrapper-string typed-modules->jerboa-wrapper-files - typed-library-forms->jerboa-wrapper-files) + typed-library-forms->jerboa-wrapper-files + typed-module-wrapper-library-file-path + typed-module->jerboa-wrapper-library-string + typed-library-form->jerboa-wrapper-library-string + typed-modules->jerboa-wrapper-library-files + typed-library-forms->jerboa-wrapper-library-files) (import (chezscheme) ; jerboa-security: suppress direct-chezscheme-import-user-code -- trusted typed compiler wrapper generator (only (jerboa core) def) @@ -852,8 +857,7 @@ (write-line port 0 ")") (newline port))) - (def (emit-wrapper-header needs-return-buffer? needs-handle-runtime? needs-option-scalar? needs-panic-runtime? port) - (write-line port 0 ";; Generated by Jerboa's typed wrapper backend. Do not edit.") + (def (emit-wrapper-import-form needs-return-buffer? needs-handle-runtime? needs-option-scalar? needs-panic-runtime? port) (write-line port 0 "(import (jerboa prelude)") (let ([needs-foreign-alloc? (or needs-return-buffer? needs-option-scalar? needs-panic-runtime?)]) @@ -869,12 +873,77 @@ (write-line port 0 " (only (chezscheme) foreign-procedure getenv load-shared-object") (write-line port 0 " make-guardian))")] [else - (write-line port 0 " (only (chezscheme) foreign-procedure getenv load-shared-object))")])) - (newline port) + (write-line port 0 " (only (chezscheme) foreign-procedure getenv load-shared-object))")]))) + + ;; Chez built-in names commonly shadowed by typed-library exports. + ;; If a wrapper def has the same name as one of these, the (chezscheme) + ;; import is filtered to drop it before adding to the library import set. + (def *chez-wrapper-shadow-candidates* + '(zero? positive? negative? abs + min max + list pair? cons car cdr + length reverse append map for-each filter + assoc assq assv member memq memv + first second third fourth fifth + identity not boolean? symbol? string? integer? number? rational? real? exact? inexact? + sort sort! find filter + sqrt expt floor ceiling round truncate + div mod + string-length substring string-append string->list list->string + string-upcase string-downcase + vector vector? vector-length vector-ref vector-set! + box unbox)) + + (def (wrapper-export-shadow-names module) + (let loop ([defs (wrapper-defs module)] [out '()]) + (cond + [(null? defs) (reverse out)] + [else + (let ([name (typed-def-name (car defs))]) + (loop (cdr defs) + (if (memq name *chez-wrapper-shadow-candidates*) + (cons name out) + out)))]))) + + ;; Library-form import: needs full chezscheme access (and, or, if, let, ...) + ;; because R6RS libraries do not get an implicit script-mode top-level env. + ;; We exclude exactly what (jerboa prelude) re-exports/shadows from chezscheme, + ;; plus any wrapper exports that collide with chezscheme built-ins. + (def (emit-wrapper-library-import-form module port) + (let ([extra-shadows (wrapper-export-shadow-names module)]) + (write-line port 1 "(import (jerboa prelude)") + (write-line port 1 " (except (chezscheme)") + (write-line port 1 " make-hash-table hash-table?") + (write-line port 1 " sort sort!") + (write-line port 1 " printf fprintf") + (write-line port 1 " path-extension path-absolute?") + (write-line port 1 " with-input-from-string with-output-to-string") + (write-line port 1 " iota 1+ 1-") + (write-line port 1 " partition") + (write-line port 1 " make-date make-time") + (write-line port 1 " atom?") + (write-line port 1 " meta") + (unless (null? extra-shadows) + (write-indent port 5) + (display (join-strings (map symbol->string extra-shadows) " ") port) + (newline port)) + (write-line port 1 " ))"))) + + (def (emit-wrapper-load-shared-object port) (write-line port 0 "(def %typed-rust-library-path (getenv \"JERBOA_TYPED_RUST_LIB\"))") (write-line port 0 "(when %typed-rust-library-path") - (write-line port 1 "(load-shared-object %typed-rust-library-path))") - (newline port) + (write-line port 1 "(load-shared-object %typed-rust-library-path))")) + + ;; Library-form variant: wrap in a def so the load happens during the + ;; sequenced library initialization, before subsequent foreign-procedure + ;; defs evaluate their RHS (R6RS forbids expressions before defs in a body). + (def (emit-wrapper-library-load-shared-object port) + (write-line port 0 "(def %typed-rust-loaded?") + (write-line port 1 "(let ([%path (getenv \"JERBOA_TYPED_RUST_LIB\")])") + (write-line port 2 "(when %path (load-shared-object %path))") + (write-line port 2 "#t))")) + + (def (emit-wrapper-runtime-defs needs-return-buffer? needs-handle-runtime? needs-option-scalar? needs-panic-runtime? port) (write-line port 0 "(def %typed-rust-min-int64 -9223372036854775808)") (write-line port 0 "(def %typed-rust-max-int64 9223372036854775807)") (write-line port 0 "(def %typed-rust-max-uint64 18446744073709551615)") @@ -1025,6 +1094,14 @@ (write-line port 1 "(utf8->string (%typed-rust-return-bytes who thunk)))") (newline port))) + (def (emit-wrapper-header needs-return-buffer? needs-handle-runtime? needs-option-scalar? needs-panic-runtime? port) + (write-line port 0 ";; Generated by Jerboa's typed wrapper backend. Do not edit.") + (emit-wrapper-import-form needs-return-buffer? needs-handle-runtime? needs-option-scalar? needs-panic-runtime? port) + (newline port) + (emit-wrapper-load-shared-object port) + (newline port) + (emit-wrapper-runtime-defs needs-return-buffer? needs-handle-runtime? needs-option-scalar? needs-panic-runtime? port)) + (def (emit-module-wrapper module port) (emit-wrapper-header (module-needs-return-buffer? module) @@ -1041,6 +1118,56 @@ (emit-wrapper-def module def port)) (wrapper-defs module))) + (def (typed-library-name->library-spec-string name) + ;; Emits the library name as a Scheme list, e.g. (jcode typed pricing) + (let ([port (open-output-string)]) + (display "(" port) + (let loop ([rest name] [first? #t]) + (unless (null? rest) + (unless first? (display " " port)) + (display (car rest) port) + (loop (cdr rest) #f))) + (display ")" port) + (get-output-string port))) + + (def (emit-module-wrapper-library module port) + (let ([needs-return-buffer? (module-needs-return-buffer? module)] + [needs-handle-runtime? (module-needs-handle-runtime? module)] + [needs-option-scalar? (module-needs-option-scalar-runtime? module)] + [needs-panic-runtime? (module-needs-panic-runtime? module)] + [exports (wrapper-defs module)]) + (write-line port 0 "#!chezscheme") + (write-line port 0 ";; Generated by Jerboa's typed wrapper backend. Do not edit.") + (display "(library " port) + (display (typed-library-name->library-spec-string + (typed-module-name module)) + port) + (newline port) + (write-indent port 1) + (display "(export" port) + (for-each + (lambda (def) + (display " " port) + (display (typed-def-name def) port)) + exports) + (display ")" port) + (newline port) + (emit-wrapper-library-import-form module port) + (newline port) + ;; load-shared-object must run before any foreign-procedure form + (emit-wrapper-library-load-shared-object port) + (newline port) + (emit-wrapper-runtime-defs needs-return-buffer? needs-handle-runtime? + needs-option-scalar? needs-panic-runtime? port) + (for-each + (lambda (def) (emit-ffi-binding module def port)) + exports) + (for-each + (lambda (def) (emit-wrapper-def module def port)) + exports) + (newline port) + (write-line port 0 ")"))) + (def (typed-module->jerboa-wrapper-string module) (let ([errors (check-typed-module module)]) (unless (null? errors) @@ -1064,4 +1191,40 @@ (def (typed-library-forms->jerboa-wrapper-files forms) (typed-modules->jerboa-wrapper-files (map parse-typed-library forms))) + (def (typed-module->jerboa-wrapper-library-string module) + (let ([errors (check-typed-module module)]) + (unless (null? errors) + (error 'typed-module->jerboa-wrapper-library-string + "typed module has check errors" + (map typed-check-error-kind errors))) + (emit-to-string + (lambda (port) + (emit-module-wrapper-library module port))))) + + (def (typed-library-form->jerboa-wrapper-library-string form) + (typed-module->jerboa-wrapper-library-string (parse-typed-library form))) + + (def (typed-module-wrapper-library-file-path module) + ;; Convert module name (a typed b) to relative path a/typed/b.sls + (let ([parts (typed-module-name module)]) + (let loop ([rest parts] [out (open-output-string)] [first? #t]) + (cond + [(null? rest) + (display ".sls" out) + (get-output-string out)] + [else + (unless first? (display "/" out)) + (display (symbol->string (car rest)) out) + (loop (cdr rest) out #f)])))) + + (def (typed-modules->jerboa-wrapper-library-files modules) + (map + (lambda (module) + (cons (typed-module-wrapper-library-file-path module) + (typed-module->jerboa-wrapper-library-string module))) + modules)) + + (def (typed-library-forms->jerboa-wrapper-library-files forms) + (typed-modules->jerboa-wrapper-library-files (map parse-typed-library forms))) + ) ;; end library --- a/support/typed-rust.ss +++ b/support/typed-rust.ss @@ -44,10 +44,9 @@ [else (loop (cdr parts))]))) (define (validate-output-path path) - (when (or (absolute-path? path) - (path-has-parent-reference? path)) + (when (path-has-parent-reference? path) (error 'typed-rust - "output paths must be relative and must not contain parent directory references" + "output paths must not contain parent directory references" path)) path) --- a/support/typed-wrappers.ss +++ b/support/typed-wrappers.ss @@ -2,7 +2,12 @@ ;;; typed-wrappers.ss -- generate Jerboa wrappers from Typed Jerboa source files ;;; ;;; Usage: -;;; scheme --libdirs lib --script support/typed-wrappers.ss OUT-DIR file.ss ... +;;; scheme --libdirs lib --script support/typed-wrappers.ss [--library] OUT-DIR file.ss ... +;;; +;;; --library emit wrappers as Chez `(library ...)` forms named after the typed +;;; module (file path matches the library name, e.g. lib (jcode typed +;;; pricing) → OUT-DIR/jcode/typed/pricing.sls). Default emits a flat +;;; script-style wrapper meant to be loaded with `load`. (import (chezscheme) ; jerboa-security: suppress direct-chezscheme-import-user-code -- trusted typed wrapper generator script (jerboa reader) @@ -10,7 +15,7 @@ (jerboa typed wrapper)) (define (usage) - (display "Usage: scheme --libdirs lib --script support/typed-wrappers.ss OUT-DIR file.ss ...\n")) + (display "Usage: scheme --libdirs lib --script support/typed-wrappers.ss [--library] OUT-DIR file.ss ...\n")) (define (string-split-slash text) (let ([len (string-length text)]) @@ -44,10 +49,9 @@ [else (loop (cdr parts))]))) (define (validate-output-path path) - (when (or (absolute-path? path) - (path-has-parent-reference? path)) + (when (path-has-parent-reference? path) (error 'typed-wrappers - "output paths must be relative and must not contain parent directory references" + "output paths must not contain parent directory references" path)) path) @@ -99,28 +103,52 @@ (loop (cdr rest) (append (reverse (read-typed-library-forms (car rest))) out))))) -(define (generate-jerboa-wrappers out-dir source-paths) +(define (path-parent path) + (let loop ([i (- (string-length path) 1)]) + (cond + [(< i 0) ""] + [(char=? (string-ref path i) #\/) + (substring path 0 i)] + [else (loop (- i 1))]))) + +(define (write-wrapper-file out-dir entry) + (let* ([rel-path (car entry)] + [content (cdr entry)] + [full-path (path-join2 out-dir rel-path)] + [parent (path-parent full-path)]) + (unless (string=? parent "") + (ensure-directory-tree parent)) + (write-file-string full-path content))) + +(define (generate-jerboa-wrappers out-dir source-paths library-form?) (let* ([safe-out-dir (validate-output-path out-dir)] [forms (read-all-typed-library-forms source-paths)]) (when (null? forms) (error 'typed-wrappers "no typed-library forms found" source-paths)) - (let ([files (typed-library-forms->jerboa-wrapper-files forms)]) + (let ([files (if library-form? + (typed-library-forms->jerboa-wrapper-library-files forms) + (typed-library-forms->jerboa-wrapper-files forms))]) (ensure-directory-tree safe-out-dir) (for-each - (lambda (file) - (write-file-string - (path-join2 safe-out-dir (car file)) - (cdr file))) + (lambda (file) (write-wrapper-file safe-out-dir file)) files) - (printf "Typed Jerboa wrappers: wrote ~a file~a to ~a\n" + (printf "Typed Jerboa wrappers: wrote ~a file~a to ~a~a\n" (length files) (if (= (length files) 1) "" "s") - safe-out-dir)))) - -(define args (command-line-arguments)) + safe-out-dir + (if library-form? " (library form)" ""))))) -(when (< (length args) 2) - (usage) - (exit 2)) +(define (parse-cli args) + (let loop ([rest args] [library? #f] [positional '()]) + (cond + [(null? rest) (values library? (reverse positional))] + [(string=? (car rest) "--library") + (loop (cdr rest) #t positional)] + [else + (loop (cdr rest) library? (cons (car rest) positional))]))) -(generate-jerboa-wrappers (car args) (cdr args)) +(let-values ([(library? positional) (parse-cli (command-line-arguments))]) + (when (< (length positional) 2) + (usage) + (exit 2)) + (generate-jerboa-wrappers (car positional) (cdr positional) library?))