Add Typed Jerboa handle drops
ober
2230b762f703e23dae348d003082a2f8b9847b63
--- a/docs/jerboa-to-rust.md +++ b/docs/jerboa-to-rust.md @@ -317,7 +317,10 @@ static JT_HANDLES: OnceLock<Mutex<HashMap<u64, Box<dyn Any + Send>>>> = Values are stored on return and cloned back into owned Rust values when a later typed export receives the handle as an argument. Generated Jerboa wrappers tag the raw id with the typed record or variant name and reject mismatched handles -before calling FFI. +before calling FFI. Wrappers that expose handles also bind +`%typed-rust-handle-drop!`, which calls the generated `jt_handle_drop` entry +point and clears the Scheme-side id so dropped handles fail validation before a +later FFI call. Later versions can use typed handle tables per module or pass runtime contexts explicitly. @@ -326,7 +329,7 @@ Handle requirements: - Runtime type tag - Ownership state -- Destructor integration +- Automatic destructor integration - Debug name - Generation counter to catch stale handles @@ -589,8 +592,9 @@ Second module: typed `rope`. - Generate wrappers. Initial scalar `.ss` wrappers plus `String` and `Bytes` argument wrappers landed. Same-module record and variant values now cross the wrapper boundary as opaque handles. `String` and `Bytes` returns now cross - through generated byte buffer ownership helpers. Option, result, and richer - handle conversions remain future work. + through generated byte buffer ownership helpers. Generated wrappers can + explicitly drop typed handles. Option, result, automatic handle finalization, + and richer handle conversions remain future work. ### Milestone 3: Records and Variants --- a/docs/typed-jerboa.md +++ b/docs/typed-jerboa.md @@ -169,12 +169,15 @@ Current landing: - Exported typed `def` functions can now cross records and variants through an opaque `u64` handle registry when the record or variant type is declared in the same typed module. Generated Scheme wrappers tag handles by typed name and - reject wrong-handle calls before FFI. + reject wrong-handle calls before FFI. Wrappers that expose handles also bind + `%typed-rust-handle-drop!`, which calls the generated Rust destructor entry + point and clears the Scheme handle id so dropped handles cannot be reused. - `make typed-wrapper-smoke` builds the primitive Rust fixture, generates its wrapper, loads the cdylib, and calls the generated Jerboa functions through - Chez FFI, including returned strings, returned bytevectors, and opaque - record/variant handles. It also checks that bad dynamic calls are rejected by - generated wrapper predicates before crossing the FFI boundary. + Chez FFI, including returned strings, returned bytevectors, opaque + record/variant handles, and explicit handle drops. It also checks that bad + dynamic calls are rejected by generated wrapper predicates before crossing the + FFI boundary. - `support/typed-rust.ss`, `make typed-rust`, and `make typed-build` generate a disposable Cargo crate under `build/typed/rust`; `typed-build` also writes wrappers under `build/typed/jerboa` and runs `cargo build` against the @@ -830,7 +833,8 @@ Minimum excluded features: - Generate Jerboa wrappers. Initial `.ss` wrapper generation landed for scalar ABI-safe exported functions, plus `String` and `Bytes` arguments and returns. Same-module record and variant values can cross exported typed - `def` boundaries as opaque handles. + `def` boundaries as opaque handles, and generated wrappers expose explicit + handle drop helpers. ### Milestone 4: First Real Module --- a/lib/jerboa/typed/wrapper.ss +++ b/lib/jerboa/typed/wrapper.ss @@ -164,6 +164,21 @@ [(abi-wrapper-return-buffer-type? (typed-def-return-type (car defs))) #t] [else (loop (cdr defs))]))) + (def (def-uses-handle? module def) + (or (module-handle-type? module (typed-def-return-type def)) + (let loop ([params (typed-def-params def)]) + (cond + [(null? params) #f] + [(module-handle-type? module (typed-param-type (car params))) #t] + [else (loop (cdr params))])))) + + (def (module-needs-handle-runtime? module) + (let loop ([defs (wrapper-defs module)]) + (cond + [(null? defs) #f] + [(def-uses-handle? module (car defs)) #t] + [else (loop (cdr defs))]))) + (def (ffi-binding-name def) (string->symbol (string-append "%" (rust-symbol-name (typed-def-name def))))) @@ -356,7 +371,7 @@ (write-line port 0 ")") (newline port))) - (def (emit-wrapper-header needs-return-buffer? port) + (def (emit-wrapper-header needs-return-buffer? needs-handle-runtime? port) (write-line port 0 ";; Generated by Jerboa's typed wrapper backend. Do not edit.") (write-line port 0 "(import (jerboa prelude)") (if needs-return-buffer? @@ -383,7 +398,13 @@ (write-line port 2 "(exact? x)") (write-line port 2 "(<= 0 x %typed-rust-max-uint64)))") (newline port) + (write-line port 0 "(def (%typed-rust-handle-id-valid? id)") + (write-line port 1 "(and (%typed-rust-uint64? id)") + (write-line port 2 "(> id 0)))") + (newline port) (write-line port 0 "(def (%typed-rust-make-handle type id)") + (write-line port 1 "(unless (%typed-rust-handle-id-valid? id)") + (write-line port 2 "(error '%typed-rust-make-handle \"typed Rust returned invalid handle\" type id))") (write-line port 1 "(vector 'typed-handle type id))") (newline port) (write-line port 0 "(def (%typed-rust-handle? value type)") @@ -391,13 +412,32 @@ (write-line port 2 "(= (vector-length value) 3)") (write-line port 2 "(eq? (vector-ref value 0) 'typed-handle)") (write-line port 2 "(eq? (vector-ref value 1) type)") - (write-line port 2 "(%typed-rust-uint64? (vector-ref value 2))))") + (write-line port 2 "(%typed-rust-handle-id-valid? (vector-ref value 2))))") (newline port) (write-line port 0 "(def (%typed-rust-handle-id value)") (write-line port 1 "(vector-ref value 2))") - (if needs-return-buffer? - (begin + (newline port) + (when needs-handle-runtime? + (write-line port 0 "(def %typed-rust-handle-drop") + (write-line port 1 "(foreign-procedure \"jt_handle_drop\" (unsigned-64) boolean))") (newline port) + (write-line port 0 "(def (%typed-rust-any-handle? value)") + (write-line port 1 "(and (vector? value)") + (write-line port 2 "(= (vector-length value) 3)") + (write-line port 2 "(eq? (vector-ref value 0) 'typed-handle)") + (write-line port 2 "(%typed-rust-handle-id-valid? (vector-ref value 2))))") + (newline port) + (write-line port 0 "(def (%typed-rust-handle-drop! value)") + (write-line port 1 "(unless (%typed-rust-any-handle? value)") + (write-line port 2 "(error '%typed-rust-handle-drop! \"expected typed handle\" value))") + (write-line port 1 "(let ([id (%typed-rust-handle-id value)])") + (write-line port 2 "(let ([dropped? (%typed-rust-handle-drop id)])") + (write-line port 3 "(when dropped?") + (write-line port 4 "(vector-set! value 2 0))") + (write-line port 3 "dropped?)))") + (newline port)) + (when needs-return-buffer? + (begin (write-line port 0 "(def %typed-rust-byte-buffer-free") (write-line port 1 "(foreign-procedure \"jt_byte_buffer_free\" (void* size_t) void))") (newline port) @@ -434,11 +474,13 @@ (newline port) (write-line port 0 "(def (%typed-rust-return-string who thunk)") (write-line port 1 "(utf8->string (%typed-rust-return-bytes who thunk)))") - (newline port)) - (newline port))) + (newline port)))) (def (emit-module-wrapper module port) - (emit-wrapper-header (module-needs-return-buffer? module) port) + (emit-wrapper-header + (module-needs-return-buffer? module) + (module-needs-handle-runtime? module) + port) (for-each (lambda (def) (emit-ffi-binding module def port)) --- a/tests/test-typed-wrapper-e2e.ss +++ b/tests/test-typed-wrapper-e2e.ss @@ -60,6 +60,12 @@ (= (box-value (make-box 17)) 17)) (check "variant handle round trip" (= (token-size (make-some 23)) 23)) + +(define dropped-box (make-box 31)) +(check "handle drop" + (%typed-rust-handle-drop! dropped-box)) +(check "dropped handle rejected" + (raises? (lambda () (box-value dropped-box)))) (check "add-one rejects non-Nat" (raises? (lambda () (add-one "not a number")))) (check "choose rejects non-Bool" @@ -76,6 +82,8 @@ (raises? (lambda () (box-value (make-some 7))))) (check "variant handle rejects wrong type" (raises? (lambda () (token-size (make-box 7))))) +(check "handle drop rejects non-handle" + (raises? (lambda () (%typed-rust-handle-drop! "not a handle")))) (printf "~%Typed wrapper FFI smoke: ~a passed, ~a failed~%" pass fail) (when (> fail 0) --- a/tests/test-typed-wrappers.ss +++ b/tests/test-typed-wrappers.ss @@ -40,7 +40,7 @@ (+ x 1)))) (define calc-wrapper - ";; Generated by Jerboa's typed wrapper backend. Do not edit.\n(import (jerboa prelude)\n (only (chezscheme) foreign-procedure getenv load-shared-object))\n\n(def %typed-rust-library-path (getenv \"JERBOA_TYPED_RUST_LIB\"))\n(when %typed-rust-library-path\n (load-shared-object %typed-rust-library-path))\n\n(def %typed-rust-min-int64 -9223372036854775808)\n(def %typed-rust-max-int64 9223372036854775807)\n(def %typed-rust-max-uint64 18446744073709551615)\n\n(def (%typed-rust-int64? x)\n (and (integer? x)\n (exact? x)\n (<= %typed-rust-min-int64 x %typed-rust-max-int64)))\n\n(def (%typed-rust-uint64? x)\n (and (integer? x)\n (exact? x)\n (<= 0 x %typed-rust-max-uint64)))\n\n(def (%typed-rust-make-handle type id)\n (vector 'typed-handle type id))\n\n(def (%typed-rust-handle? value type)\n (and (vector? value)\n (= (vector-length value) 3)\n (eq? (vector-ref value 0) 'typed-handle)\n (eq? (vector-ref value 1) type)\n (%typed-rust-uint64? (vector-ref value 2))))\n\n(def (%typed-rust-handle-id value)\n (vector-ref value 2))\n\n(def %zero\n (foreign-procedure \"jt_sample_typed_calc_zero\" () unsigned-64))\n\n(def %add_one\n (foreign-procedure \"jt_sample_typed_calc_add_one\" (unsigned-64) unsigned-64))\n\n(def (zero)\n (%zero)\n)\n\n(def (add-one x)\n (unless (%typed-rust-uint64? x)\n (error 'add-one \"expected Nat for x\" x))\n (%add_one x)\n)\n\n") + ";; Generated by Jerboa's typed wrapper backend. Do not edit.\n(import (jerboa prelude)\n (only (chezscheme) foreign-procedure getenv load-shared-object))\n\n(def %typed-rust-library-path (getenv \"JERBOA_TYPED_RUST_LIB\"))\n(when %typed-rust-library-path\n (load-shared-object %typed-rust-library-path))\n\n(def %typed-rust-min-int64 -9223372036854775808)\n(def %typed-rust-max-int64 9223372036854775807)\n(def %typed-rust-max-uint64 18446744073709551615)\n\n(def (%typed-rust-int64? x)\n (and (integer? x)\n (exact? x)\n (<= %typed-rust-min-int64 x %typed-rust-max-int64)))\n\n(def (%typed-rust-uint64? x)\n (and (integer? x)\n (exact? x)\n (<= 0 x %typed-rust-max-uint64)))\n\n(def (%typed-rust-handle-id-valid? id)\n (and (%typed-rust-uint64? id)\n (> id 0)))\n\n(def (%typed-rust-make-handle type id)\n (unless (%typed-rust-handle-id-valid? id)\n (error '%typed-rust-make-handle \"typed Rust returned invalid handle\" type id))\n (vector 'typed-handle type id))\n\n(def (%typed-rust-handle? value type)\n (and (vector? value)\n (= (vector-length value) 3)\n (eq? (vector-ref value 0) 'typed-handle)\n (eq? (vector-ref value 1) type)\n (%typed-rust-handle-id-valid? (vector-ref value 2))))\n\n(def (%typed-rust-handle-id value)\n (vector-ref value 2))\n\n(def %zero\n (foreign-procedure \"jt_sample_typed_calc_zero\" () unsigned-64))\n\n(def %add_one\n (foreign-procedure \"jt_sample_typed_calc_add_one\" (unsigned-64) unsigned-64))\n\n(def (zero)\n (%zero)\n)\n\n(def (add-one x)\n (unless (%typed-rust-uint64? x)\n (error 'add-one \"expected Nat for x\" x))\n (%add_one x)\n)\n\n") (define string-form '(typed-library (sample typed text) @@ -202,6 +202,17 @@ "(%token_size (%typed-rust-handle-id token))")) #t) +(test "wrapper emits handle drop helper" + (and (substring? handle-wrapper + "(foreign-procedure \"jt_handle_drop\" (unsigned-64) boolean)") + (substring? handle-wrapper + "(def (%typed-rust-handle-drop! value)") + (substring? handle-wrapper + "(vector-set! value 2 0)") + (substring? handle-wrapper + "(%typed-rust-handle-id-valid? (vector-ref value 2))")) + #t) + (printf "~%Typed wrapper: ~a passed, ~a failed~%" pass fail) (when (> fail 0) (exit 1))