Surface Typed Jerboa Rust panics as Scheme errors
ober
1669681f4fafe3aca78f8d90dcd487ffe2b77dea
--- a/docs/typed-jerboa.md +++ b/docs/typed-jerboa.md @@ -315,9 +315,18 @@ Highest-value next steps: 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`. -5. Add structured error returns. Rust ABI wrappers catch panics and return - conservative defaults; there is not yet a typed error/result ABI for wrapper - failures. +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 + the payload as a UTF-8 String, and two extern `"C"` helpers + (`jt_has_panic` and `jt_take_last_panic`) drain that state via the same + ptr/len byte-buffer protocol used for buffer returns. Generated wrappers + bind `%typed-rust-check-panic!` and wrap every safe call body in + `(let ([%result <body>]) (%typed-rust-check-panic! '<who>) %result)`, so a + Rust panic surfaces as a Scheme error whose irritants carry the panic + message. `%typed-rust-return-bytes` and `%typed-rust-make-handle` also + check-panic before raising their own diagnostics, so the panic message + always wins over a generic "call failed" / "invalid handle" error. 6. Thread expression-level source spans through to generated Rust comments so compiler errors can map back to typed source line and column. 7. Add fuzz/property tests for parser/checker and broader differential tests --- a/lib/jerboa/typed/rust.ss +++ b/lib/jerboa/typed/rust.ss @@ -570,6 +570,40 @@ (write-line port 0 "}") (newline port)) + (def (emit-panic-runtime port) + (write-line port 0 "thread_local! {") + (write-line port 1 + "static JT_LAST_PANIC: std::cell::RefCell<Option<String>> = const { std::cell::RefCell::new(None) };") + (write-line port 0 "}") + (newline port) + (write-line port 0 + "fn jt_capture_panic(payload: std::boxed::Box<dyn std::any::Any + Send>) {") + (write-line port 1 "let msg = if let Some(s) = payload.downcast_ref::<&'static str>() {") + (write-line port 2 "(*s).to_string()") + (write-line port 1 "} else if let Some(s) = payload.downcast_ref::<String>() {") + (write-line port 2 "s.clone()") + (write-line port 1 "} else {") + (write-line port 2 "\"unknown panic\".to_string()") + (write-line port 1 "};") + (write-line port 1 "JT_LAST_PANIC.with(|p| *p.borrow_mut() = Some(msg));") + (write-line port 0 "}") + (newline port) + (write-line port 0 "#[unsafe(no_mangle)]") + (write-line port 0 "pub extern \"C\" fn jt_has_panic() -> bool {") + (write-line port 1 "JT_LAST_PANIC.with(|p| p.borrow().is_some())") + (write-line port 0 "}") + (newline port) + (write-line port 0 "#[unsafe(no_mangle)]") + (write-line port 0 + "pub extern \"C\" fn jt_take_last_panic(out_ptr: *mut *mut u8, out_len: *mut usize) -> bool {") + (write-line port 1 "let msg = JT_LAST_PANIC.with(|p| p.borrow_mut().take());") + (write-line port 1 "match msg {") + (write-line port 2 "Some(s) => jt_return_bytes(s.into_bytes(), out_ptr, out_len),") + (write-line port 2 "None => false,") + (write-line port 1 "}") + (write-line port 0 "}") + (newline port)) + (def (emit-byte-buffer-runtime port) (write-line port 0 "fn jt_return_bytes(bytes: Vec<u8>, out_ptr: *mut *mut u8, out_len: *mut usize) -> bool {") (write-line port 1 "if out_ptr.is_null() || out_len.is_null() {") @@ -652,11 +686,31 @@ [(module-needs-byte-buffer-runtime? (car rest)) #t] [else (loop (cdr rest))]))) + (def (module-has-safe-exports? module) + (let loop ([decls (typed-module-declarations module)]) + (cond + [(null? decls) #f] + [(and (typed-def? (car decls)) + (exported-def? module (car decls)) + (abi-safe-def? (car decls))) + #t] + [else (loop (cdr decls))]))) + + (def (modules-have-safe-exports? modules) + (let loop ([rest modules]) + (cond + [(null? rest) #f] + [(module-has-safe-exports? (car rest)) #t] + [else (loop (cdr rest))]))) + (def (emit-runtime-helpers modules port) (when (modules-need-handle-registry? modules) (emit-handle-registry port)) - (when (modules-need-byte-buffer-runtime? modules) - (emit-byte-buffer-runtime port))) + (when (or (modules-need-byte-buffer-runtime? modules) + (modules-have-safe-exports? modules)) + (emit-byte-buffer-runtime port)) + (when (modules-have-safe-exports? modules) + (emit-panic-runtime port))) (def (emit-abi-param-conversion param port) (let ([name (rust-symbol-name (typed-param-name param))] @@ -895,14 +949,14 @@ (write-line port 2 "Ok(value) => value,") (write-line port 2 (string-append - "Err(_) => " + "Err(payload) => { jt_capture_panic(payload); " (cond [return-buffer? "false"] [return-option-buffer? "false"] [return-option-scalar? "false"] [return-result-direct? "0u8"] [else (abi-default-expression return-type)]) - ",")) + " },")) (write-line port 1 "}") (write-line port 0 "}") (newline port)))) --- a/lib/jerboa/typed/wrapper.ss +++ b/lib/jerboa/typed/wrapper.ss @@ -245,6 +245,12 @@ [(def-touches-buffer? (car defs)) #t] [else (loop (cdr defs))]))) + (def (module-has-safe-defs? module) + (not (null? (wrapper-defs module)))) + + (def (module-needs-panic-runtime? module) + (module-has-safe-defs? module)) + (def (def-uses-handle? module def) (or (module-handle-type? module (typed-def-return-type def)) (let loop ([params (typed-def-params def)]) @@ -827,21 +833,30 @@ (lambda (param) (emit-param-check module def param port)) params) - (let ([bindings (append-map param-prelude-bindings params)]) + (let ([bindings (append-map param-prelude-bindings params)] + [who-sym (quoted-symbol-code (typed-def-name def))] + [body-expr + (string-append + "(let ([%result " + (wrapper-return-expression module def) + "]) (%typed-rust-check-panic! " + (quoted-symbol-code (typed-def-name def)) + ") %result)")]) (if (null? bindings) - (write-line port 1 (wrapper-return-expression module def)) + (write-line port 1 body-expr) (begin (write-line port 1 (string-append "(let (" (join-strings bindings " ") ")")) - (write-line port 2 (wrapper-return-expression module def)) + (write-line port 2 body-expr) (write-line port 1 ")")))) (write-line port 0 ")") (newline port))) - (def (emit-wrapper-header needs-return-buffer? needs-handle-runtime? needs-option-scalar? 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.") (write-line port 0 "(import (jerboa prelude)") - (let ([needs-foreign-alloc? (or needs-return-buffer? needs-option-scalar?)]) + (let ([needs-foreign-alloc? + (or needs-return-buffer? needs-option-scalar? needs-panic-runtime?)]) (cond [(and needs-foreign-alloc? needs-handle-runtime?) (write-line port 0 " (only (chezscheme) foreign-procedure getenv load-shared-object") @@ -885,6 +900,8 @@ (when needs-handle-runtime? (write-line port 1 "(%typed-rust-reap-handles!)")) (write-line port 1 "(unless (%typed-rust-handle-id-valid? id)") + (when needs-panic-runtime? + (write-line port 2 "(%typed-rust-check-panic! '%typed-rust-make-handle)")) (write-line port 2 "(error '%typed-rust-make-handle \"typed Rust returned invalid handle\" type id))") (if needs-handle-runtime? (begin @@ -941,8 +958,7 @@ (write-line port 4 "(vector-set! value 2 0))") (write-line port 3 "dropped?)))") (newline port)) - (when needs-return-buffer? - (begin + (when (or needs-return-buffer? needs-panic-runtime?) (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) @@ -958,7 +974,33 @@ (write-line port 1 "(dynamic-wind") (write-line port 2 "(lambda () #f)") (write-line port 2 "(lambda () (%typed-rust-copy-byte-buffer ptr len))") - (write-line port 2 "(lambda () (%typed-rust-byte-buffer-free ptr len))))") + (write-line port 2 "(lambda () (%typed-rust-byte-buffer-free ptr len))))")) + (when needs-panic-runtime? + (newline port) + (write-line port 0 "(def %typed-rust-has-panic") + (write-line port 1 "(foreign-procedure \"jt_has_panic\" () boolean))") + (newline port) + (write-line port 0 "(def %typed-rust-take-last-panic") + (write-line port 1 "(foreign-procedure \"jt_take_last_panic\" (void* void*) boolean))") + (newline port) + (write-line port 0 "(def (%typed-rust-check-panic! who)") + (write-line port 1 "(when (%typed-rust-has-panic)") + (write-line port 2 "(let ([ptr-box (foreign-alloc (foreign-sizeof 'void*))]") + (write-line port 3 "[len-box (foreign-alloc (foreign-sizeof 'size_t))])") + (write-line port 2 "(dynamic-wind") + (write-line port 3 "(lambda () #f)") + (write-line port 3 "(lambda ()") + (write-line port 4 "(foreign-set! 'void* ptr-box 0 0)") + (write-line port 4 "(foreign-set! 'size_t len-box 0 0)") + (write-line port 4 "(when (%typed-rust-take-last-panic ptr-box len-box)") + (write-line port 5 "(let ([msg (utf8->string (%typed-rust-take-byte-buffer") + (write-line port 6 "(foreign-ref 'void* ptr-box 0)") + (write-line port 6 "(foreign-ref 'size_t len-box 0)))])") + (write-line port 5 "(error who \"typed Rust panic\" msg))))") + (write-line port 3 "(lambda ()") + (write-line port 4 "(foreign-free ptr-box)") + (write-line port 4 "(foreign-free len-box))))))")) + (when needs-return-buffer? (newline port) (write-line port 0 "(def (%typed-rust-return-bytes who thunk)") (write-line port 1 "(let ([ptr-box (foreign-alloc (foreign-sizeof 'void*))]") @@ -968,8 +1010,10 @@ (write-line port 3 "(lambda ()") (write-line port 4 "(foreign-set! 'void* ptr-box 0 0)") (write-line port 4 "(foreign-set! 'size_t len-box 0 0)") - (write-line port 4 "(unless (thunk ptr-box len-box)") - (write-line port 5 "(error who \"typed Rust call failed\"))") + (write-line port 4 "(let ([ok? (thunk ptr-box len-box)])") + (write-line port 5 "(%typed-rust-check-panic! who)") + (write-line port 5 "(unless ok?") + (write-line port 6 "(error who \"typed Rust call failed\")))") (write-line port 4 "(%typed-rust-take-byte-buffer") (write-line port 5 "(foreign-ref 'void* ptr-box 0)") (write-line port 5 "(foreign-ref 'size_t len-box 0)))") @@ -979,13 +1023,14 @@ (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))) (def (emit-module-wrapper module port) (emit-wrapper-header (module-needs-return-buffer? module) (module-needs-handle-runtime? module) (module-needs-option-scalar-runtime? module) + (module-needs-panic-runtime? module) port) (for-each (lambda (def) --- a/tests/fixtures/typed/rust-basic.ss +++ b/tests/fixtures/typed/rust-basic.ss @@ -3,7 +3,7 @@ bytes-length echo-bytes make-box box-value make-some token-size token-debug maybe-value echo-maybe ok-value err-value echo-result only-pos echo-only-pos maybe-text echo-maybe-text echo-maybe-bytes - text-or-zero echo-text-or echo-text-or-bytes) + text-or-zero echo-text-or echo-text-or-bytes divide) (record Box ((value : Nat))) @@ -103,4 +103,7 @@ r) (def (echo-text-or-bytes (r : (Result String Bytes))) : (Result String Bytes) - r)) + r) + + (def (divide (a : Nat) (b : Nat)) : Nat + (/ a b))) --- a/tests/test-typed-rust.ss +++ b/tests/test-typed-rust.ss @@ -29,6 +29,61 @@ [(string=? (substring haystack i (+ i nlen)) needle) #t] [else (loop (+ i 1))])))) +(define rust-file-header + "// Generated by Jerboa's typed Rust backend. Do not edit.\n#![deny(unsafe_op_in_unsafe_fn)]\n#![allow(unused_parens)]\n#![allow(unused_variables)]\n\n") + +(define safe-prelude + (string-append + "fn jt_return_bytes(bytes: Vec<u8>, out_ptr: *mut *mut u8, out_len: *mut usize) -> bool {\n" + " if out_ptr.is_null() || out_len.is_null() {\n" + " return false;\n" + " }\n" + " let mut boxed = bytes.into_boxed_slice();\n" + " let len = boxed.len();\n" + " let ptr = boxed.as_mut_ptr();\n" + " std::mem::forget(boxed);\n" + " // unsafe: out pointers are provided by the generated Jerboa wrapper.\n" + " unsafe {\n" + " *out_ptr = ptr;\n" + " *out_len = len;\n" + " }\n" + " true\n" + "}\n\n" + "#[unsafe(no_mangle)]\n" + "pub extern \"C\" fn jt_byte_buffer_free(ptr: *mut u8, len: usize) {\n" + " if !ptr.is_null() {\n" + " // unsafe: ptr/len must be a buffer returned by jt_return_bytes.\n" + " unsafe {\n" + " drop(std::boxed::Box::from_raw(std::slice::from_raw_parts_mut(ptr, len)));\n" + " }\n" + " }\n" + "}\n\n" + "thread_local! {\n" + " static JT_LAST_PANIC: std::cell::RefCell<Option<String>> = const { std::cell::RefCell::new(None) };\n" + "}\n\n" + "fn jt_capture_panic(payload: std::boxed::Box<dyn std::any::Any + Send>) {\n" + " let msg = if let Some(s) = payload.downcast_ref::<&'static str>() {\n" + " (*s).to_string()\n" + " } else if let Some(s) = payload.downcast_ref::<String>() {\n" + " s.clone()\n" + " } else {\n" + " \"unknown panic\".to_string()\n" + " };\n" + " JT_LAST_PANIC.with(|p| *p.borrow_mut() = Some(msg));\n" + "}\n\n" + "#[unsafe(no_mangle)]\n" + "pub extern \"C\" fn jt_has_panic() -> bool {\n" + " JT_LAST_PANIC.with(|p| p.borrow().is_some())\n" + "}\n\n" + "#[unsafe(no_mangle)]\n" + "pub extern \"C\" fn jt_take_last_panic(out_ptr: *mut *mut u8, out_len: *mut usize) -> bool {\n" + " let msg = JT_LAST_PANIC.with(|p| p.borrow_mut().take());\n" + " match msg {\n" + " Some(s) => jt_return_bytes(s.into_bytes(), out_ptr, out_len),\n" + " None => false,\n" + " }\n" + "}\n\n")) + (define calc-form '(typed-library (sample typed calc) (export zero add-one) @@ -40,7 +95,8 @@ (+ x 1)))) (define calc-rust - "// Generated by Jerboa's typed Rust backend. Do not edit.\n#![deny(unsafe_op_in_unsafe_fn)]\n#![allow(unused_parens)]\n#![allow(unused_variables)]\n\npub fn private_zero() -> u64 {\n 0u64\n}\n\npub fn zero() -> u64 {\n private_zero()\n}\n\npub fn add_one(x: u64) -> u64 {\n (x + 1u64)\n}\n\n#[unsafe(no_mangle)]\npub extern \"C\" fn jt_sample_typed_calc_zero() -> u64 {\n match std::panic::catch_unwind(std::panic::AssertUnwindSafe(|| {\n zero()\n })) {\n Ok(value) => value,\n Err(_) => 0u64,\n }\n}\n\n#[unsafe(no_mangle)]\npub extern \"C\" fn jt_sample_typed_calc_add_one(x: u64) -> u64 {\n match std::panic::catch_unwind(std::panic::AssertUnwindSafe(|| {\n add_one(x)\n })) {\n Ok(value) => value,\n Err(_) => 0u64,\n }\n}\n\n") + (string-append rust-file-header safe-prelude + "pub fn private_zero() -> u64 {\n 0u64\n}\n\npub fn zero() -> u64 {\n private_zero()\n}\n\npub fn add_one(x: u64) -> u64 {\n (x + 1u64)\n}\n\n#[unsafe(no_mangle)]\npub extern \"C\" fn jt_sample_typed_calc_zero() -> u64 {\n match std::panic::catch_unwind(std::panic::AssertUnwindSafe(|| {\n zero()\n })) {\n Ok(value) => value,\n Err(payload) => { jt_capture_panic(payload); 0u64 },\n }\n}\n\n#[unsafe(no_mangle)]\npub extern \"C\" fn jt_sample_typed_calc_add_one(x: u64) -> u64 {\n match std::panic::catch_unwind(std::panic::AssertUnwindSafe(|| {\n add_one(x)\n })) {\n Ok(value) => value,\n Err(payload) => { jt_capture_panic(payload); 0u64 },\n }\n}\n\n")) (define data-form '(typed-library (sample typed data) @@ -63,7 +119,8 @@ ch))) (define char-rust - "// Generated by Jerboa's typed Rust backend. Do not edit.\n#![deny(unsafe_op_in_unsafe_fn)]\n#![allow(unused_parens)]\n#![allow(unused_variables)]\n\npub fn same_char(ch: char) -> char {\n ch\n}\n\n#[unsafe(no_mangle)]\npub extern \"C\" fn jt_sample_typed_char_same_char(ch: u32) -> u32 {\n match std::panic::catch_unwind(std::panic::AssertUnwindSafe(|| {\n let ch = char::from_u32(ch).unwrap_or('\\u{FFFD}');\n (same_char(ch) as u32)\n })) {\n Ok(value) => value,\n Err(_) => 0xFFFDu32,\n }\n}\n\n") + (string-append rust-file-header safe-prelude + "pub fn same_char(ch: char) -> char {\n ch\n}\n\n#[unsafe(no_mangle)]\npub extern \"C\" fn jt_sample_typed_char_same_char(ch: u32) -> u32 {\n match std::panic::catch_unwind(std::panic::AssertUnwindSafe(|| {\n let ch = char::from_u32(ch).unwrap_or('\\u{FFFD}');\n (same_char(ch) as u32)\n })) {\n Ok(value) => value,\n Err(payload) => { jt_capture_panic(payload); 0xFFFDu32 },\n }\n}\n\n")) (define string-form '(typed-library (sample typed text) @@ -72,7 +129,8 @@ (string-length s)))) (define string-rust - "// Generated by Jerboa's typed Rust backend. Do not edit.\n#![deny(unsafe_op_in_unsafe_fn)]\n#![allow(unused_parens)]\n#![allow(unused_variables)]\n\npub fn text_length(s: String) -> u64 {\n (s).len() as u64\n}\n\n#[unsafe(no_mangle)]\npub extern \"C\" fn jt_sample_typed_text_text_length(s_ptr: *const u8, s_len: usize) -> u64 {\n match std::panic::catch_unwind(std::panic::AssertUnwindSafe(|| {\n let s = {\n let bytes: &[u8] = if s_ptr.is_null() {\n &[]\n } else {\n // unsafe: pointer and length are produced by the generated Jerboa wrapper.\n unsafe { std::slice::from_raw_parts(s_ptr, s_len) }\n };\n String::from_utf8_lossy(bytes).into_owned()\n };\n text_length(s)\n })) {\n Ok(value) => value,\n Err(_) => 0u64,\n }\n}\n\n") + (string-append rust-file-header safe-prelude + "pub fn text_length(s: String) -> u64 {\n (s).len() as u64\n}\n\n#[unsafe(no_mangle)]\npub extern \"C\" fn jt_sample_typed_text_text_length(s_ptr: *const u8, s_len: usize) -> u64 {\n match std::panic::catch_unwind(std::panic::AssertUnwindSafe(|| {\n let s = {\n let bytes: &[u8] = if s_ptr.is_null() {\n &[]\n } else {\n // unsafe: pointer and length are produced by the generated Jerboa wrapper.\n unsafe { std::slice::from_raw_parts(s_ptr, s_len) }\n };\n String::from_utf8_lossy(bytes).into_owned()\n };\n text_length(s)\n })) {\n Ok(value) => value,\n Err(payload) => { jt_capture_panic(payload); 0u64 },\n }\n}\n\n")) (define bytes-form '(typed-library (sample typed bytes) @@ -81,7 +139,8 @@ (bytevector-length data)))) (define bytes-rust - "// Generated by Jerboa's typed Rust backend. Do not edit.\n#![deny(unsafe_op_in_unsafe_fn)]\n#![allow(unused_parens)]\n#![allow(unused_variables)]\n\npub fn bytes_length(data: Vec<u8>) -> u64 {\n (data).len() as u64\n}\n\n#[unsafe(no_mangle)]\npub extern \"C\" fn jt_sample_typed_bytes_bytes_length(data_ptr: *const u8, data_len: usize) -> u64 {\n match std::panic::catch_unwind(std::panic::AssertUnwindSafe(|| {\n let data = {\n let bytes: &[u8] = if data_ptr.is_null() {\n &[]\n } else {\n // unsafe: pointer and length are produced by the generated Jerboa wrapper.\n unsafe { std::slice::from_raw_parts(data_ptr, data_len) }\n };\n bytes.to_vec()\n };\n bytes_length(data)\n })) {\n Ok(value) => value,\n Err(_) => 0u64,\n }\n}\n\n") + (string-append rust-file-header safe-prelude + "pub fn bytes_length(data: Vec<u8>) -> u64 {\n (data).len() as u64\n}\n\n#[unsafe(no_mangle)]\npub extern \"C\" fn jt_sample_typed_bytes_bytes_length(data_ptr: *const u8, data_len: usize) -> u64 {\n match std::panic::catch_unwind(std::panic::AssertUnwindSafe(|| {\n let data = {\n let bytes: &[u8] = if data_ptr.is_null() {\n &[]\n } else {\n // unsafe: pointer and length are produced by the generated Jerboa wrapper.\n unsafe { std::slice::from_raw_parts(data_ptr, data_len) }\n };\n bytes.to_vec()\n };\n bytes_length(data)\n })) {\n Ok(value) => value,\n Err(payload) => { jt_capture_panic(payload); 0u64 },\n }\n}\n\n")) (define return-form '(typed-library (sample typed return-values) --- a/tests/test-typed-wrapper-e2e.ss +++ b/tests/test-typed-wrapper-e2e.ss @@ -196,6 +196,33 @@ (raises? (lambda () (token-size (make-box 7))))) (check "handle drop rejects non-handle" (raises? (lambda () (%typed-rust-handle-drop! "not a handle")))) + +(define (panic-message-of thunk) + (guard (exn [#t (and (condition? exn) + (find (lambda (irr) + (and (string? irr) (substring? irr "divide by zero"))) + (or (condition-irritants exn) '())))]) + (thunk) + #f)) + +(define (substring? haystack needle) + (let ([hlen (string-length haystack)] + [nlen (string-length needle)]) + (let loop ([i 0]) + (cond + [(> (+ i nlen) hlen) #f] + [(string=? (substring haystack i (+ i nlen)) needle) #t] + [else (loop (+ i 1))])))) + +(check "non-panic call succeeds" + (= (divide 10 2) 5)) +(check "panic in callee propagates as Scheme error" + (raises? (lambda () (divide 1 0)))) +(check "panic message surfaces in error irritants" + (string? (panic-message-of (lambda () (divide 1 0))))) +(check "subsequent call after panic still works" + (= (divide 9 3) 3)) + (let ([leaked-handle (make-box 101)]) (set! leaked-handle #f) (collect) --- a/tests/test-typed-wrappers.ss +++ b/tests/test-typed-wrappers.ss @@ -29,6 +29,84 @@ [(string=? (substring haystack i (+ i nlen)) needle) #t] [else (loop (+ i 1))])))) +(define wrapper-header-safe + (string-append + ";; Generated by Jerboa's typed wrapper backend. Do not edit.\n" + "(import (jerboa prelude)\n" + " (only (chezscheme) foreign-procedure getenv load-shared-object\n" + " foreign-alloc foreign-free foreign-ref foreign-set! foreign-sizeof))\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" + " (%typed-rust-check-panic! '%typed-rust-make-handle)\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" + " (equal? (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")) + +(define wrapper-byte-buffer-prelude + (string-append + "(def %typed-rust-byte-buffer-free\n" + " (foreign-procedure \"jt_byte_buffer_free\" (void* size_t) void))\n\n" + "(def (%typed-rust-copy-byte-buffer ptr len)\n" + " (let ([out (make-bytevector len)])\n" + " (let loop ([i 0])\n" + " (when (< i len)\n" + " (bytevector-u8-set! out i (foreign-ref 'unsigned-8 ptr i))\n" + " (loop (+ i 1))))\n" + " out))\n\n" + "(def (%typed-rust-take-byte-buffer ptr len)\n" + " (dynamic-wind\n" + " (lambda () #f)\n" + " (lambda () (%typed-rust-copy-byte-buffer ptr len))\n" + " (lambda () (%typed-rust-byte-buffer-free ptr len))))\n\n")) + +(define wrapper-panic-prelude + (string-append + "(def %typed-rust-has-panic\n" + " (foreign-procedure \"jt_has_panic\" () boolean))\n\n" + "(def %typed-rust-take-last-panic\n" + " (foreign-procedure \"jt_take_last_panic\" (void* void*) boolean))\n\n" + "(def (%typed-rust-check-panic! who)\n" + " (when (%typed-rust-has-panic)\n" + " (let ([ptr-box (foreign-alloc (foreign-sizeof 'void*))]\n" + " [len-box (foreign-alloc (foreign-sizeof 'size_t))])\n" + " (dynamic-wind\n" + " (lambda () #f)\n" + " (lambda ()\n" + " (foreign-set! 'void* ptr-box 0 0)\n" + " (foreign-set! 'size_t len-box 0 0)\n" + " (when (%typed-rust-take-last-panic ptr-box len-box)\n" + " (let ([msg (utf8->string (%typed-rust-take-byte-buffer\n" + " (foreign-ref 'void* ptr-box 0)\n" + " (foreign-ref 'size_t len-box 0)))])\n" + " (error who \"typed Rust panic\" msg))))\n" + " (lambda ()\n" + " (foreign-free ptr-box)\n" + " (foreign-free len-box))))))\n")) + (define calc-form '(typed-library (sample typed calc) (export zero add-one) @@ -40,7 +118,19 @@ (+ 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-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 (equal? (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") + (string-append wrapper-header-safe wrapper-byte-buffer-prelude wrapper-panic-prelude + "(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" + " (let ([%result (%zero)]) (%typed-rust-check-panic! 'zero) %result)\n" + ")\n\n" + "(def (add-one x)\n" + " (unless (%typed-rust-uint64? x)\n" + " (error 'add-one \"expected Nat for x\" x))\n" + " (let ([%result (%add_one x)]) (%typed-rust-check-panic! 'add-one) %result)\n" + ")\n\n")) (define string-form '(typed-library (sample typed text)