Lower (Option Scalar) directly across the Typed Jerboa boundary
ober
42f7633b652133c3e0fc0363e9e1ca52609df064
--- a/docs/typed-jerboa.md +++ b/docs/typed-jerboa.md @@ -296,9 +296,14 @@ Highest-value next steps: elaboration, so cross-module record/variant/def references compile into a single Rust crate. The emitter still inlines all modules into one file and does not yet emit cross-module `use` declarations. -3. Improve boundary semantics for Option/Result. They currently cross the FFI - boundary as opaque handles; direct conversion to idiomatic Scheme result - values is still open. +3. Improve boundary semantics for Option/Result (partial). `(Option <Scalar>)` + for Scalar in `{Bool, Char, Int, Nat, Fixnum, Float}` now crosses the FFI + boundary as a tagged Scheme value (`#f` or `(cons 'some V)`): the Rust ABI + writes the inner value through a `*mut <ScalarRustType>` out-pointer and + returns a `bool` status, and the generated wrapper allocates the buffer with + `dynamic-wind`-protected free. Option-scalar params lower to a `u8` tag plus + the raw scalar value. `(Result T E)` and `(Option <non-scalar>)` still cross + as opaque handles; direct conversion for those remains open. 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`. --- a/lib/jerboa/typed/rust.ss +++ b/lib/jerboa/typed/rust.ss @@ -340,13 +340,21 @@ (and (eq? (car type) 'Result) (= (length type) 3))))) + (def (abi-option-scalar-type? type) + (and (pair? type) + (eq? (car type) 'Option) + (= (length type) 2) + (abi-safe-type? (cadr type)) + (not (eq? (cadr type) 'Unit)))) + (def (abi-handle-type? type) (or (and (symbol? type) (or (lookup-name type (*rust-record-env*)) (lookup-name type (*rust-variant-env*))) #t) - (abi-option-result-handle-type? type))) + (and (abi-option-result-handle-type? type) + (not (abi-option-scalar-type? type))))) (def (abi-return-buffer-type? type) (and (symbol? type) @@ -356,12 +364,14 @@ (def (abi-safe-return-type? type) (or (abi-safe-type? type) (abi-handle-type? type) - (abi-return-buffer-type? type))) + (abi-return-buffer-type? type) + (abi-option-scalar-type? type))) (def (abi-safe-param-type? type) (or (abi-safe-type? type) (memq type '(String Bytes)) - (abi-handle-type? type))) + (abi-handle-type? type) + (abi-option-scalar-type? type))) (def (abi-rust-type type) (case type @@ -403,20 +413,22 @@ (rust-symbol-name (typed-def-name def)))) (def (emit-abi-param param) - (let ([name (rust-symbol-name (typed-param-name param))]) - (case (typed-param-type param) - [(String Bytes) + (let ([name (rust-symbol-name (typed-param-name param))] + [type (typed-param-type param)]) + (cond + [(memq type '(String Bytes)) (list (string-append name "_ptr: *const u8") (string-append name "_len: usize"))] + [(abi-option-scalar-type? type) + (list + (string-append name "_tag: u8") + (string-append name "_value: " (abi-rust-type (cadr type))))] + [(abi-handle-type? type) + (list (string-append name "_handle: u64"))] [else - (if (abi-handle-type? (typed-param-type param)) - (list (string-append name "_handle: u64")) - (list - (string-append - name - ": " - (abi-rust-type (typed-param-type param)))))]))) + (list + (string-append name ": " (abi-rust-type type)))]))) (def (emit-handle-registry port) (write-line port 0 "use std::any::Any;") @@ -537,9 +549,10 @@ (emit-byte-buffer-runtime port))) (def (emit-abi-param-conversion param port) - (let ([name (rust-symbol-name (typed-param-name param))]) - (case (typed-param-type param) - [(Char) + (let ([name (rust-symbol-name (typed-param-name param))] + [type (typed-param-type param)]) + (cond + [(eq? type 'Char) (write-line port 2 (string-append "let " @@ -547,7 +560,7 @@ " = char::from_u32(" name ").unwrap_or('\\u{FFFD}');"))] - [(String Bytes) + [(memq type '(String Bytes)) (write-line port 2 (string-append "let " name " = {")) (write-line port 3 (string-append @@ -567,21 +580,38 @@ "_len) }")) (write-line port 3 "};") (write-line port 3 - (if (eq? (typed-param-type param) 'String) + (if (eq? type 'String) "String::from_utf8_lossy(bytes).into_owned()" "bytes.to_vec()")) (write-line port 2 "};")] - [else - (when (abi-handle-type? (typed-param-type param)) + [(abi-option-scalar-type? type) + (let* ([inner (cadr type)] + [some-expr + (if (eq? inner 'Char) + (string-append + "Some(char::from_u32(" + name + "_value).unwrap_or('\\u{FFFD}'))") + (string-append "Some(" name "_value)"))]) (write-line port 2 (string-append "let " name - " = jt_clone_handle::<" - (rust-type (typed-param-type param)) - ">(" + " = if " name - "_handle).unwrap_or_else(|| panic!(\"invalid typed handle\"));")))]))) + "_tag != 0 { " + some-expr + " } else { None };")))] + [(abi-handle-type? type) + (write-line port 2 + (string-append + "let " + name + " = jt_clone_handle::<" + (rust-type type) + ">(" + name + "_handle).unwrap_or_else(|| panic!(\"invalid typed handle\"));"))]))) (def (abi-return-expression def call) (let ([return-type (typed-def-return-type def)]) @@ -618,6 +648,7 @@ (let* ([params (typed-def-params def)] [return-type (typed-def-return-type def)] [return-buffer? (abi-return-buffer-type? return-type)] + [return-option-scalar? (abi-option-scalar-type? return-type)] [param-names (map (lambda (param) (rust-symbol-name (typed-param-name param))) params)] @@ -630,9 +661,20 @@ [abi-params (append (append-map emit-abi-param params) - (if return-buffer? - '("out_ptr: *mut *mut u8" "out_len: *mut usize") - '()))]) + (cond + [return-buffer? + '("out_ptr: *mut *mut u8" "out_len: *mut usize")] + [return-option-scalar? + (list + (string-append + "out_ptr: *mut " + (abi-rust-type (cadr return-type))))] + [else '()]))] + [extern-return-type + (cond + [return-buffer? "bool"] + [return-option-scalar? "bool"] + [else (abi-rust-type return-type)])]) (write-line port 0 "#[unsafe(no_mangle)]") (write-line port 0 (string-append @@ -641,9 +683,7 @@ "(" (join-strings abi-params ", ") ") -> " - (if return-buffer? - "bool" - (abi-rust-type return-type)) + extern-return-type " {")) (write-line port 1 "match std::panic::catch_unwind(std::panic::AssertUnwindSafe(|| {") @@ -651,18 +691,30 @@ (lambda (param) (emit-abi-param-conversion param port)) params) - (write-line port 2 - (if return-buffer? - (abi-return-buffer-expression def call) - (abi-return-expression def call))) + (cond + [return-buffer? + (write-line port 2 (abi-return-buffer-expression def call))] + [return-option-scalar? + (let ([inner (cadr return-type)]) + (write-line port 2 (string-append "match " call " {")) + (write-line port 3 + (string-append + "Some(value) => { unsafe { *out_ptr = " + (if (eq? inner 'Char) "(value as u32)" "value") + "; } true }")) + (write-line port 3 "None => false,") + (write-line port 2 "}"))] + [else + (write-line port 2 (abi-return-expression def call))]) (write-line port 1 "})) {") (write-line port 2 "Ok(value) => value,") (write-line port 2 (string-append "Err(_) => " - (if return-buffer? - "false" - (abi-default-expression return-type)) + (cond + [return-buffer? "false"] + [return-option-scalar? "false"] + [else (abi-default-expression return-type)]) ",")) (write-line port 1 "}") (write-line port 0 "}") --- a/lib/jerboa/typed/wrapper.ss +++ b/lib/jerboa/typed/wrapper.ss @@ -98,9 +98,22 @@ (and (eq? (car type) 'Result) (= (length type) 3))))) + (def (abi-wrapper-scalar-type? type) + (and (symbol? type) + (memq type '(Unit Bool Char Int Nat Fixnum Float)) + #t)) + + (def (option-scalar-type? type) + (and (pair? type) + (eq? (car type) 'Option) + (= (length type) 2) + (abi-wrapper-scalar-type? (cadr type)) + (not (eq? (cadr type) 'Unit)))) + (def (module-handle-type? module type) (or - (option-result-handle-type? type) + (and (option-result-handle-type? type) + (not (option-scalar-type? type))) (and (symbol? type) (let loop ([decls (typed-module-declarations module)]) (cond @@ -113,11 +126,6 @@ #t] [else (loop (cdr decls))]))))) - (def (abi-wrapper-scalar-type? type) - (and (symbol? type) - (memq type '(Unit Bool Char Int Nat Fixnum Float)) - #t)) - (def (abi-wrapper-return-buffer-type? type) (and (symbol? type) (memq type '(String Bytes)) @@ -126,12 +134,14 @@ (def (wrapper-safe-return-type? module type) (or (abi-wrapper-scalar-type? type) (module-handle-type? module type) - (abi-wrapper-return-buffer-type? type))) + (abi-wrapper-return-buffer-type? type) + (option-scalar-type? type))) (def (wrapper-safe-param-type? module type) (or (abi-wrapper-scalar-type? type) (memq type '(String Bytes)) - (module-handle-type? module type))) + (module-handle-type? module type) + (option-scalar-type? type))) (def (wrapper-safe-def? module def) (and (wrapper-safe-return-type? module (typed-def-return-type def)) @@ -145,16 +155,17 @@ (def (abi-chez-return-type module type) (cond [(abi-wrapper-return-buffer-type? type) 'boolean] + [(option-scalar-type? type) 'boolean] [(module-handle-type? module type) 'unsigned-64] [else (abi-chez-type type)])) (def (abi-chez-argument-types module type) - (case type - [(String Bytes) '(u8* size_t)] - [else - (if (module-handle-type? module type) - '(unsigned-64) - (list (abi-chez-type type)))])) + (cond + [(memq type '(String Bytes)) '(u8* size_t)] + [(option-scalar-type? type) + (list 'unsigned-8 (abi-chez-type (cadr type)))] + [(module-handle-type? module type) '(unsigned-64)] + [else (list (abi-chez-type type))])) (def (wrapper-defs module) (let loop ([rest (typed-module-declarations module)] [out '()]) @@ -188,31 +199,130 @@ [(def-uses-handle? module (car defs)) #t] [else (loop (cdr defs))]))) + (def (def-uses-option-scalar? def) + (or (option-scalar-type? (typed-def-return-type def)) + (let loop ([params (typed-def-params def)]) + (cond + [(null? params) #f] + [(option-scalar-type? (typed-param-type (car params))) #t] + [else (loop (cdr params))])))) + + (def (module-needs-option-scalar-runtime? module) + (let loop ([defs (wrapper-defs module)]) + (cond + [(null? defs) #f] + [(def-uses-option-scalar? (car defs)) #t] + [else (loop (cdr defs))]))) + + (def (chez-foreign-size-name type) + (case type + [(Bool) "boolean"] + [(Char) "unsigned-32"] + [(Int) "integer-64"] + [(Nat) "unsigned-64"] + [(Fixnum) "iptr"] + [(Float) "double"] + [else (error 'typed-wrapper "unsupported option-scalar inner" type)])) + + (def (option-scalar-param-tag-name param) + (string->symbol + (string-append + "%" + (rust-symbol-name (typed-param-name param)) + "_tag"))) + + (def (option-scalar-param-value-name param) + (string->symbol + (string-append + "%" + (rust-symbol-name (typed-param-name param)) + "_value"))) + + (def (option-scalar-value-of-name param) + (let ([inner (cadr (typed-param-type param))]) + (case inner + [(Char) + (string-append "(char->integer (cdr " (datum->code (typed-param-name param)) "))")] + [else + (string-append "(cdr " (datum->code (typed-param-name param)) ")")]))) + + (def (option-scalar-default-value inner) + (case inner + [(Bool) "#f"] + [(Char) "0"] + [(Int Nat Fixnum) "0"] + [(Float) "0.0"] + [else (error 'typed-wrapper "unsupported option-scalar inner" inner)])) + + (def (option-scalar-foreign-type inner) + (case inner + [(Bool) "unsigned-8"] + [(Char) "unsigned-32"] + [(Int) "integer-64"] + [(Nat) "unsigned-64"] + [(Fixnum) "iptr"] + [(Float) "double"] + [else (error 'typed-wrapper "unsupported option-scalar inner" inner)])) + + (def (option-scalar-init-value inner) + (case inner + [(Bool Char Int Nat Fixnum) "0"] + [(Float) "0.0"] + [else (error 'typed-wrapper "unsupported option-scalar inner" inner)])) + + (def (option-scalar-read-expression inner buf) + (let ([raw + (string-append + "(foreign-ref '" + (option-scalar-foreign-type inner) + " " + buf + " 0)")]) + (case inner + [(Char) (string-append "(integer->char " raw ")")] + [(Bool) (string-append "(not (zero? " raw "))")] + [else raw]))) + (def (ffi-binding-name def) (string->symbol (string-append "%" (rust-symbol-name (typed-def-name def))))) + (def (scalar-check-expression inner name) + (case inner + [(Bool) (string-append "(boolean? " name ")")] + [(Char) (string-append "(char? " name ")")] + [(Int) (string-append "(%typed-rust-int64? " name ")")] + [(Nat) (string-append "(%typed-rust-uint64? " name ")")] + [(Fixnum) (string-append "(fixnum? " name ")")] + [(Float) (string-append "(real? " name ")")] + [else (error 'typed-wrapper "unsupported scalar inner" inner)])) + (def (param-check-expression module param) - (let ([name (datum->code (typed-param-name param))]) - (case (typed-param-type param) - [(Bool) (string-append "(boolean? " name ")")] - [(Char) (string-append "(char? " name ")")] - [(Int) (string-append "(%typed-rust-int64? " name ")")] - [(Nat) (string-append "(%typed-rust-uint64? " name ")")] - [(Fixnum) (string-append "(fixnum? " name ")")] - [(Float) (string-append "(real? " name ")")] - [(String) (string-append "(string? " name ")")] - [(Bytes) (string-append "(bytevector? " name ")")] + (let ([name (datum->code (typed-param-name param))] + [type (typed-param-type param)]) + (cond + [(eq? type 'Bool) (string-append "(boolean? " name ")")] + [(eq? type 'Char) (string-append "(char? " name ")")] + [(eq? type 'Int) (string-append "(%typed-rust-int64? " name ")")] + [(eq? type 'Nat) (string-append "(%typed-rust-uint64? " name ")")] + [(eq? type 'Fixnum) (string-append "(fixnum? " name ")")] + [(eq? type 'Float) (string-append "(real? " name ")")] + [(eq? type 'String) (string-append "(string? " name ")")] + [(eq? type 'Bytes) (string-append "(bytevector? " name ")")] + [(option-scalar-type? type) + (string-append + "(or (eq? " name " #f) (and (pair? " name ") (eq? (car " name ") 'some) " + (scalar-check-expression (cadr type) (string-append "(cdr " name ")")) + "))")] + [(module-handle-type? module type) + (string-append + "(%typed-rust-handle? " + name + " " + (quoted-symbol-code type) + ")")] [else - (if (module-handle-type? module (typed-param-type param)) - (string-append - "(%typed-rust-handle? " - name - " " - (quoted-symbol-code (typed-param-type param)) - ")") - (error 'typed-wrapper "unsupported ABI parameter type" - (typed-param-type param)))]))) + (error 'typed-wrapper "unsupported ABI parameter type" type)]))) (def (emit-param-check module def param port) (let* ([name (typed-param-name param)] @@ -248,22 +358,31 @@ [else (loop (cdr rest))]))) (def (wrapper-argument-expressions module param) - (let ([name (datum->code (typed-param-name param))]) - (case (typed-param-type param) - [(Char) (list (string-append "(char->integer " name ")"))] - [(String) + (let ([name (datum->code (typed-param-name param))] + [type (typed-param-type param)]) + (cond + [(eq? type 'Char) (list (string-append "(char->integer " name ")"))] + [(eq? type 'String) (let ([bytes-name (datum->code (string-bytes-name param))]) (list bytes-name (string-append "(bytevector-length " bytes-name ")")))] - [(Bytes) + [(eq? type 'Bytes) (list name (string-append "(bytevector-length " name ")"))] - [else - (if (module-handle-type? module (typed-param-type param)) - (list (string-append "(%typed-rust-handle-id " name ")")) - (list name))]))) + [(option-scalar-type? type) + (list + (string-append "(if " name " 1 0)") + (string-append + "(if " name " " + (option-scalar-value-of-name param) + " " + (option-scalar-default-value (cadr type)) + ")"))] + [(module-handle-type? module type) + (list (string-append "(%typed-rust-handle-id " name ")"))] + [else (list name)]))) (def (wrapper-call-expression* module def extra-args) (string-append @@ -297,6 +416,22 @@ " (lambda (%out_ptr %out_len) " (wrapper-call-expression* module def '("%out_ptr" "%out_len")) "))")] + [(option-scalar-type? return-type) + (let* ([inner (cadr return-type)] + [ftype (option-scalar-foreign-type inner)]) + (string-append + "(let ([%out (foreign-alloc (foreign-sizeof '" ftype "))])" + " (dynamic-wind" + " (lambda () #f)" + " (lambda ()" + " (foreign-set! '" ftype " %out 0 " (option-scalar-init-value inner) ")" + " (if " + (wrapper-call-expression* module def '("%out")) + " (cons 'some " + (option-scalar-read-expression inner "%out") + ")" + " #f))" + " (lambda () (foreign-free %out))))"))] [(module-handle-type? module return-type) (string-append "(%typed-rust-make-handle " @@ -307,30 +442,32 @@ [else call]))) (def (emit-ffi-binding module def port) - (write-line port 0 - (string-append - "(def " - (datum->code (ffi-binding-name def)))) - (write-line port 1 - (string-append - "(foreign-procedure " - (datum->code (abi-wrapper-name module def)) - " (" - (join-strings - (append - (append-map - (lambda (param) - (map datum->code - (abi-chez-argument-types module (typed-param-type param)))) - (typed-def-params def)) - (if (abi-wrapper-return-buffer-type? (typed-def-return-type def)) - '("void*" "void*") - '())) - " ") - ") " - (datum->code (abi-chez-return-type module (typed-def-return-type def))) - "))")) - (newline port)) + (let ([return-type (typed-def-return-type def)]) + (write-line port 0 + (string-append + "(def " + (datum->code (ffi-binding-name def)))) + (write-line port 1 + (string-append + "(foreign-procedure " + (datum->code (abi-wrapper-name module def)) + " (" + (join-strings + (append + (append-map + (lambda (param) + (map datum->code + (abi-chez-argument-types module (typed-param-type param)))) + (typed-def-params def)) + (cond + [(abi-wrapper-return-buffer-type? return-type) '("void*" "void*")] + [(option-scalar-type? return-type) '("void*")] + [else '()])) + " ") + ") " + (datum->code (abi-chez-return-type module return-type)) + "))")) + (newline port))) (def (emit-wrapper-def module def port) (let ([params (typed-def-params def)]) @@ -380,22 +517,23 @@ (write-line port 0 ")") (newline port))) - (def (emit-wrapper-header needs-return-buffer? needs-handle-runtime? port) + (def (emit-wrapper-header needs-return-buffer? needs-handle-runtime? needs-option-scalar? port) (write-line port 0 ";; Generated by Jerboa's typed wrapper backend. Do not edit.") (write-line port 0 "(import (jerboa prelude)") - (cond - [(and needs-return-buffer? needs-handle-runtime?) - (write-line port 0 " (only (chezscheme) foreign-procedure getenv load-shared-object") - (write-line port 0 " foreign-alloc foreign-free foreign-ref foreign-set! foreign-sizeof") - (write-line port 0 " make-guardian))")] - [needs-return-buffer? - (write-line port 0 " (only (chezscheme) foreign-procedure getenv load-shared-object") - (write-line port 0 " foreign-alloc foreign-free foreign-ref foreign-set! foreign-sizeof))")] - [needs-handle-runtime? - (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))")]) + (let ([needs-foreign-alloc? (or needs-return-buffer? needs-option-scalar?)]) + (cond + [(and needs-foreign-alloc? needs-handle-runtime?) + (write-line port 0 " (only (chezscheme) foreign-procedure getenv load-shared-object") + (write-line port 0 " foreign-alloc foreign-free foreign-ref foreign-set! foreign-sizeof") + (write-line port 0 " make-guardian))")] + [needs-foreign-alloc? + (write-line port 0 " (only (chezscheme) foreign-procedure getenv load-shared-object") + (write-line port 0 " foreign-alloc foreign-free foreign-ref foreign-set! foreign-sizeof))")] + [needs-handle-runtime? + (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 "(def %typed-rust-library-path (getenv \"JERBOA_TYPED_RUST_LIB\"))") (write-line port 0 "(when %typed-rust-library-path") @@ -526,6 +664,7 @@ (emit-wrapper-header (module-needs-return-buffer? module) (module-needs-handle-runtime? module) + (module-needs-option-scalar-runtime? module) port) (for-each (lambda (def) --- a/tests/test-typed-rust.ss +++ b/tests/test-typed-rust.ss @@ -310,13 +310,25 @@ (substring? option-result-rust "Err((message).clone())")) #t) -(test "rust emits option and result handle ABI wrappers" +(test "rust emits option-scalar direct ABI wrappers" + (and (substring? option-result-rust + "pub extern \"C\" fn jt_sample_typed_option_result_maybe_value(x: u64, out_ptr: *mut u64) -> bool") + (substring? option-result-rust + "Some(value) => { unsafe { *out_ptr = value; } true }") + (substring? option-result-rust + "None => false,") + (substring? option-result-rust + "pub extern \"C\" fn jt_sample_typed_option_result_echo_maybe(maybe_tag: u8, maybe_value: u64, out_ptr: *mut u64) -> bool") + (substring? option-result-rust + "let maybe = if maybe_tag != 0 { Some(maybe_value) } else { None };")) + #t) + +(test "rust still uses handles for Option<non-scalar> and Result" (and (substring? option-result-rust "fn jt_store_handle<T: Any + Send>(value: T) -> u64") - (substring? option-result-rust "pub extern \"C\" fn jt_sample_typed_option_result_maybe_value(x: u64) -> u64") - (substring? option-result-rust "jt_store_handle(maybe_value(x))") - (substring? option-result-rust "pub extern \"C\" fn jt_sample_typed_option_result_echo_maybe(maybe_handle: u64) -> u64") - (substring? option-result-rust "let maybe = jt_clone_handle::<Option<u64>>(maybe_handle).unwrap_or_else(|| panic!(\"invalid typed handle\"));") - (substring? option-result-rust "jt_store_handle(echo_maybe(maybe))") + (substring? option-result-rust "pub extern \"C\" fn jt_sample_typed_option_result_none_text() -> u64") + (substring? option-result-rust "jt_store_handle(none_text())") + (substring? option-result-rust "pub extern \"C\" fn jt_sample_typed_option_result_ok_value(x: u64) -> u64") + (substring? option-result-rust "jt_store_handle(ok_value(x))") (substring? option-result-rust "pub extern \"C\" fn jt_sample_typed_option_result_echo_result(r_handle: u64) -> u64") (substring? option-result-rust "let r = jt_clone_handle::<Result<u64, String>>(r_handle).unwrap_or_else(|| panic!(\"invalid typed handle\"));") (substring? option-result-rust "jt_store_handle(echo_result(r))")) --- a/tests/test-typed-wrapper-e2e.ss +++ b/tests/test-typed-wrapper-e2e.ss @@ -63,12 +63,15 @@ (check "variant debug string" (string=? (token-debug (make-some 44)) "Some { value: 44 }")) -(define maybe-handle (maybe-value 29)) -(check "option handle return" - (%typed-rust-handle? maybe-handle '(Option Nat))) -(define maybe-roundtrip (echo-maybe maybe-handle)) -(check "option handle round trip" - (%typed-rust-handle? maybe-roundtrip '(Option Nat))) +(define maybe-some (maybe-value 29)) +(check "option scalar Some return" + (equal? maybe-some (cons 'some 29))) +(define maybe-roundtrip (echo-maybe maybe-some)) +(check "option scalar Some round trip" + (equal? maybe-roundtrip (cons 'some 29))) +(define maybe-none-roundtrip (echo-maybe #f)) +(check "option scalar None round trip" + (eq? maybe-none-roundtrip #f)) (define ok-handle (ok-value 37)) (check "result ok handle return" @@ -80,10 +83,12 @@ (check "result handle round trip" (%typed-rust-handle? result-roundtrip '(Result Nat String))) -(check "option handle rejects result" +(check "option scalar rejects non-Option" (raises? (lambda () (echo-maybe ok-handle)))) +(check "option scalar rejects bad shape" + (raises? (lambda () (echo-maybe (cons 'whatever 1))))) (check "result handle rejects option" - (raises? (lambda () (echo-result maybe-handle)))) + (raises? (lambda () (echo-result maybe-some)))) (define dropped-box (make-box 31)) (check "handle drop" @@ -116,10 +121,8 @@ (collect) (check "handle guardian reaps unreachable handles" (> (%typed-rust-reap-handles!) 0))) -(check "option and result handle drops" - (and (%typed-rust-handle-drop! maybe-handle) - (%typed-rust-handle-drop! maybe-roundtrip) - (%typed-rust-handle-drop! ok-handle) +(check "result handle drops" + (and (%typed-rust-handle-drop! ok-handle) (%typed-rust-handle-drop! err-handle) (%typed-rust-handle-drop! result-roundtrip))) --- a/tests/test-typed-wrappers.ss +++ b/tests/test-typed-wrappers.ss @@ -241,22 +241,27 @@ "(%typed-rust-finalize-handle! value)")) #t) -(test "wrapper returns option and result handles" +(test "wrapper lowers Option scalar returns directly" (and (substring? option-result-wrapper - "(foreign-procedure \"jt_sample_typed_option_result_maybe_value\" (unsigned-64) unsigned-64)") + "(foreign-procedure \"jt_sample_typed_option_result_maybe_value\" (unsigned-64 void*) boolean)") (substring? option-result-wrapper - "(%typed-rust-make-handle '(Option Nat) (%maybe_value x))") + "(if (%maybe_value x %out) (cons 'some (foreign-ref 'unsigned-64 %out 0)) #f)")) + #t) + +(test "wrapper lowers Option scalar params directly" + (and (substring? option-result-wrapper + "(foreign-procedure \"jt_sample_typed_option_result_echo_maybe\" (unsigned-8 unsigned-64 void*) boolean)") (substring? option-result-wrapper - "(%typed-rust-make-handle '(Result Nat String) (%ok_value x))") + "(unless (or (eq? maybe #f) (and (pair? maybe) (eq? (car maybe) 'some) (%typed-rust-uint64? (cdr maybe))))") (substring? option-result-wrapper - "(%typed-rust-make-handle '(Result Nat String) (%err_value %message_bytes (bytevector-length %message_bytes)))")) + "(%echo_maybe (if maybe 1 0) (if maybe (cdr maybe) 0) %out)")) #t) -(test "wrapper passes option and result handle parameters" +(test "wrapper still uses handles for Result returns and params" (and (substring? option-result-wrapper - "(unless (%typed-rust-handle? maybe '(Option Nat))") + "(%typed-rust-make-handle '(Result Nat String) (%ok_value x))") (substring? option-result-wrapper - "(%echo_maybe (%typed-rust-handle-id maybe))") + "(%typed-rust-make-handle '(Result Nat String) (%err_value %message_bytes (bytevector-length %message_bytes)))") (substring? option-result-wrapper "(unless (%typed-rust-handle? r '(Result Nat String))") (substring? option-result-wrapper