jerbuild: auto-inject (chezscheme) base for full-Jerboa binary entries
ober
3a933927934ad416a2073844f89b17383a5ffbe5
--- a/jerbuild.ss +++ b/jerbuild.ss @@ -752,6 +752,75 @@ [else (loop (cdr lst) (cons (car lst) seen))]))) ;;;; ============================================================ +;;;; Full-Jerboa program entry wrapping (for `jerbuild binary`) +;;;; ============================================================ +;; +;; `jerbuild binary` feeds its entry straight to compile-program, which — +;; unlike the .ss→.sls transpiler — injects no base language. A full-Jerboa +;; entry that imports only (jerboa prelude)/(std ...) would leave display, /, +;; etc. unbound, because (jerboa prelude) is ADDITIVE over (chezscheme): it +;; works under `scheme --script` only because the script env supplies the chez +;; base implicitly, but a compiled top-level program has no implicit base. +;; +;; So if the entry does NOT already import (chezscheme), rewrite it into a temp +;; #!chezscheme program that imports (except (chezscheme) <conflicts>) plus the +;; user's own imports — where <conflicts> are the chez names re-exported by the +;; user's libs (computed live via environment-symbols, honouring `only`) or +;; shadowed by local defs. This mirrors what the transpiler does for libraries, +;; so users write plain Jerboa and never hand-write the chez plumbing. + +(define (chez-base-lib? lib) + (or (equal? lib '(chezscheme)) (equal? lib '(scheme)) + (equal? lib '(rnrs)) (equal? lib '(rnrs base)))) + +(define (entry-imports-chez? import-specs) + (and (find chez-base-lib? (map unwrap-import-lib import-specs)) #t)) + +(define (spec-conflict-candidates spec chez-set) + ;; Names this user import spec brings in that ALSO exist in (chezscheme), + ;; i.e. would clash when (chezscheme) is also imported. Honours import + ;; sub-forms; (prefix ...) never clashes. Unknown/unfound libs contribute + ;; nothing (guarded) — compile-program will surface a real missing-lib error. + (define (intersect names) (filter (lambda (s) (memq s chez-set)) names)) + (cond + [(and (pair? spec) (eq? (car spec) 'only)) (intersect (cddr spec))] + [(and (pair? spec) (eq? (car spec) 'prefix)) '()] + [(and (pair? spec) (eq? (car spec) 'rename)) (intersect (map cadr (cddr spec)))] + [else + (guard (e [#t '()]) + (intersect (environment-symbols (environment (unwrap-import-lib spec)))))])) + +(define (maybe-wrap-jerboa-entry entry obj-dir) + ;; Returns the path to feed to compile-program: a generated #!chezscheme + ;; wrapper (full-Jerboa entry) or the original entry (already chez-style / + ;; importless). library-directories must already point at the entry's libs. + (let ([forms (read-source-file entry)]) + (let-values ([(exports imports body) (classify-forms forms)]) + (cond + [(or (null? imports) (entry-imports-chez? imports)) entry] + [else + (let* ([chez-set (environment-symbols (environment '(chezscheme)))] + [conflicts (delete-duplicates + (append + (apply append + (map (lambda (s) (spec-conflict-candidates s chez-set)) + imports)) + (collect-local-defs body)) + eq?)] + [wrapped (format "~a/jerboa-entry.ss" obj-dir)]) + (printf " Jerboa entry: injecting (chezscheme) base (~a name(s) excepted)\n" + (length conflicts)) + (call-with-output-file wrapped + (lambda (port) + (parameterize ([print-extended-identifiers #t]) + (display "#!chezscheme\n" port) + (write `(import (except (chezscheme) ,@conflicts) ,@imports) port) + (newline port) + (for-each (lambda (f) (write f port) (newline port)) body))) + 'replace) + wrapped)])))) + +;;;; ============================================================ ;;;; Auto-imports ;;;; ============================================================ @@ -1967,6 +2036,14 @@ int main(int argc, const char *argv[]) { (system (format "mkdir -p ~a" (shell-quote obj-dir))) + ;; Full-Jerboa entry support: if the entry imports only (jerboa prelude)/ + ;; (std ...) and not (chezscheme), wrap it so compile-program gets the chez + ;; base (see maybe-wrap-jerboa-entry). library-directories must resolve the + ;; entry's imports for the live export-set lookup; the compile paths below + ;; reset it with the obj-dir redirects they need. + (library-directories (append user-libs (list bundle-lib))) + (set! entry (maybe-wrap-jerboa-entry entry obj-dir)) + ;; Set library-directories: user libs redirect to obj-dir (so ;; compile-imported-libraries doesn't pollute user source trees); ;; bundle lib is plain (precompiled .so/.wpo live there already).