Lower Typed Jerboa borrows as Rust references
ober
9ca49e3657c50a987c026a458e3392010efc2b2f
--- a/docs/typed-jerboa.md +++ b/docs/typed-jerboa.md @@ -240,11 +240,17 @@ Current landing: operands as runtime values. Exported Option/Result values cross the current Jerboa FFI boundary as opaque typed handles; direct conversion to idiomatic Scheme option/result values remains future work. -- The current Rust lowering uses a conservative Clone-only ownership model: - generated constructors, ordinary calls, and recursive match rebinding clone - owned values so recursive branch code can pass the same child value to more - than one helper. This is deliberately simple and correct for the first - split-tree slice; borrow-aware lowering remains future work. +- The Rust lowering still uses a conservative Clone-heavy ownership model for + owned values: generated constructors, ordinary calls, and recursive match + rebinding clone owned values so recursive branch code can pass the same child + value to more than one helper. Borrow/MutBorrow parameter types now lower to + `&T` / `&mut T` and call sites emit `&(expr)` / `&mut (expr)` instead of + `.clone()` — the checker accepts `Owned T` actuals at both `Borrow T` and + `MutBorrow T` parameter positions, so the only owned `.clone()` left is for + Cell-bearing values that the IR still hands off as `T` arguments. Resource + declarations now emit a `pub struct Name { pub _opaque: () }` placeholder and, + when annotated with `#:close fn`, a `impl Drop for Name { fn drop ... }` that + delegates to the close hook. ## Handoff Snapshot @@ -312,9 +318,15 @@ Highest-value next steps: pair for buffer inners via `jt_return_bytes`); params lower to a `u8` tag plus per-side raw arguments (raw scalar value or pointer/length pair); the wrapper surfaces `(cons 'ok V)` / `(cons 'err E)`. -4. Make resource lowering borrow-aware. The checker has straight-line owned - move rules, but the Rust backend still uses a conservative Clone-heavy model - and does not use resource `#:close` hooks for generated `Drop`. +4. Make resource lowering borrow-aware (Done). The Rust backend now lowers + `(Borrow T)` parameters to `&T` and `(MutBorrow T)` to `&mut T`, and emits + call-site references (`&(expr)` / `&mut (expr)`) instead of `.clone()` for + borrowed argument positions. The checker also accepts `Owned T` actuals at + both `(Borrow T)` and `(MutBorrow T)` parameter positions. Resource + declarations now lower to opaque `pub struct Name { pub _opaque: () }` + placeholders, and `(resource Name #:close fn)` additionally emits an + `impl Drop for Name { fn drop(&mut self) { fn(self); } }` block so the + close hook fires when the resource value goes out of scope. 5. Add structured error returns (Done). The Rust emitter now installs a thread-local panic capture: every safe export wraps its body in `catch_unwind`, the Err branch routes through `jt_capture_panic` to record --- a/lib/jerboa/typed/checker.ss +++ b/lib/jerboa/typed/checker.ss @@ -316,9 +316,14 @@ (and (pair? type) (eq? (car type) 'Borrow))) + (def (mut-borrow-type? type) + (and (pair? type) + (eq? (car type) 'MutBorrow))) + (def (owned-to-borrow-assignable? actual expected) (and (owned-type? actual) - (borrow-type? expected) + (or (borrow-type? expected) + (mut-borrow-type? expected)) (equal? (cadr actual) (cadr expected)))) (def (type-assignable? actual expected) --- a/lib/jerboa/typed/rust.ss +++ b/lib/jerboa/typed/rust.ss @@ -25,6 +25,8 @@ (def *rust-record-env* (make-parameter '())) (def *rust-variant-env* (make-parameter '())) (def *rust-variant-case-env* (make-parameter '())) + ;; alist of (def-name . list-of-param-types) for call-site lowering + (def *rust-def-env* (make-parameter '())) ;; alist of (def-name . typed-ir-begin) populated per module by emit-module (def *rust-ir-env* (make-parameter '())) @@ -165,6 +167,9 @@ [(Vector List) (string-append "Vec<" (rust-type (cadr type)) ">")] [(Pair) (string-append "(" (rust-type (cadr type)) ", " (rust-type (caddr type)) ")")] + [(Owned) (rust-type (cadr type))] + [(Borrow) (string-append "&" (rust-type (cadr type)))] + [(MutBorrow) (string-append "&mut " (rust-type (cadr type)))] [else (error 'typed-rust "unsupported compound type" type)])] [else (error 'typed-rust "unsupported type" type)])) @@ -182,6 +187,28 @@ (def (emit-argument-expression expr) (string-append "(" (emit-expression expr) ").clone()")) + (def (emit-argument-for-param expr param-type) + (cond + [(and (pair? param-type) (eq? (car param-type) 'Borrow)) + (string-append "&(" (emit-expression expr) ")")] + [(and (pair? param-type) (eq? (car param-type) 'MutBorrow)) + (string-append "&mut (" (emit-expression expr) ")")] + [else (emit-argument-expression expr)])) + + (def (emit-call-arguments name args) + (let ([param-types (lookup-name name (*rust-def-env*))]) + (cond + [(and param-types (= (length param-types) (length args))) + (let loop ([rest-args args] [rest-types param-types] [out '()]) + (cond + [(null? rest-args) (reverse out)] + [else + (loop (cdr rest-args) + (cdr rest-types) + (cons (emit-argument-for-param (car rest-args) (car rest-types)) + out))]))] + [else (map emit-argument-expression args)]))) + (def (append-map f xs) (let loop ([rest xs] [out '()]) (if (null? rest) @@ -264,10 +291,25 @@ [(eq? name (symbol-append (caar rest) "?")) (cdar rest)] [else (loop (cdr rest))]))) + (def (def-env modules) + (append-map + (lambda (module) + (let loop ([rest (typed-module-declarations module)] [out '()]) + (cond + [(null? rest) (reverse out)] + [(typed-def? (car rest)) + (loop (cdr rest) + (cons (cons (typed-def-name (car rest)) + (map typed-param-type (typed-def-params (car rest)))) + out))] + [else (loop (cdr rest) out)]))) + modules)) + (def (with-rust-env modules thunk) (parameterize ([*rust-record-env* (record-env modules)] [*rust-variant-env* (variant-env modules)] - [*rust-variant-case-env* (variant-case-env modules)]) + [*rust-variant-case-env* (variant-case-env modules)] + [*rust-def-env* (def-env modules)]) (thunk))) (def (emit-record record port) @@ -1291,7 +1333,7 @@ (string-append (rust-symbol-name name) "(" - (join-strings (map emit-argument-expression args) ", ") + (join-strings (emit-call-arguments name args) ", ") ")")]))) (def (emit-ir-expression ir) @@ -1451,7 +1493,7 @@ (string-append (rust-symbol-name operator) "(" - (join-strings (map emit-argument-expression args) ", ") + (join-strings (emit-call-arguments operator args) ", ") ")")] [else (error 'typed-rust "unknown IR call kind" kind)]))) @@ -1528,10 +1570,27 @@ (write-line port 0 "}") (newline port))) + (def (emit-resource resource port) + (let ([name (rust-symbol-name (typed-resource-name resource))] + [close (typed-resource-close resource)]) + (write-line port 0 "#[derive(Debug)]") + (write-line port 0 (string-append "pub struct " name " {")) + (write-line port 1 "pub _opaque: (),") + (write-line port 0 "}") + (newline port) + (when close + (write-line port 0 (string-append "impl Drop for " name " {")) + (write-line port 1 "fn drop(&mut self) {") + (write-line port 2 (string-append (rust-symbol-name close) "(self);")) + (write-line port 1 "}") + (write-line port 0 "}") + (newline port)))) + (def (emit-declaration decl port) (cond [(typed-record? decl) (emit-record decl port)] [(typed-variant? decl) (emit-variant decl port)] + [(typed-resource? decl) (emit-resource decl port)] [(typed-def? decl) (emit-def decl port)] [else #f])) --- a/tests/test-typed-rust.ss +++ b/tests/test-typed-rust.ss @@ -270,6 +270,42 @@ (define equality-rust (typed-library-form->rust-string equality-form)) +(define borrow-form + '(typed-library (sample typed borrow) + (export borrow-sum borrow-mut-bump) + (record Cell + ((value : Nat))) + (def (read-cell (c : (Borrow Cell))) : Nat + 0) + (def (bump-cell (c : (MutBorrow Cell))) : Nat + 0) + (def (borrow-sum (a : (Owned Cell)) (b : (Owned Cell))) : Nat + (+ (read-cell a) (read-cell b))) + (def (borrow-mut-bump (a : (Owned Cell))) : Nat + (bump-cell a)))) + +(define borrow-rust + (typed-library-form->rust-string borrow-form)) + +(define resource-form + '(typed-library (sample typed resource) + (export) + (resource FileHandle #:close close-file) + (record Flag ((mut done? : Bool))) + (def (close-file (fh : (MutBorrow FileHandle))) : Unit + (Flag-done?-set! (make-Flag #f) #t)))) + +(define resource-no-close-form + '(typed-library (sample typed resource-noclose) + (export) + (resource FileHandle))) + +(define resource-rust + (typed-library-form->rust-string resource-form)) + +(define resource-no-close-rust + (typed-library-form->rust-string resource-no-close-form)) + (printf "--- Typed Jerboa Rust emitter tests ---~%") (test "rust symbol sanitizes" @@ -459,6 +495,33 @@ (substring? equality-rust "jt_return_bytes(token_debug(token).into_bytes(), out_ptr, out_len)")) #t) +(test "rust lowers Borrow params to &T" + (and (substring? borrow-rust "pub fn read_cell(c: &Cell) -> u64") + (substring? borrow-rust "pub fn bump_cell(c: &mut Cell) -> u64")) + #t) + +(test "rust lowers Borrow call sites as references not clones" + (and (substring? borrow-rust "read_cell(&(a))") + (substring? borrow-rust "read_cell(&(b))") + (substring? borrow-rust "bump_cell(&mut (a))")) + #t) + +(test "rust emits resource struct with opaque marker" + (and (substring? resource-rust "pub struct FileHandle {") + (substring? resource-rust "pub _opaque: (),")) + #t) + +(test "rust emits Drop impl for resource with #:close hook" + (and (substring? resource-rust "impl Drop for FileHandle") + (substring? resource-rust "fn drop(&mut self)") + (substring? resource-rust "close_file(self)")) + #t) + +(test "rust omits Drop impl for resource without #:close hook" + (and (substring? resource-no-close-rust "pub struct FileHandle {") + (not (substring? resource-no-close-rust "impl Drop for FileHandle"))) + #t) + (define import-provider-form '(typed-library (rust import provider) (export inc make-Pt Pt-x Pt-y)