Add Typed Jerboa split-tree smoke
ober
34e1f4a9476ad6fa59f273b9b4e3ff0077245607
--- a/Makefile +++ b/Makefile @@ -31,7 +31,7 @@ TYPED_RUST_SOURCES ?= $(TYPED_SOURCES) TYPED_RUST_DIR ?= build/typed/rust TYPED_WRAPPER_DIR ?= build/typed/jerboa -.PHONY: help chez chez-cross build binary binary-cross native-cross pure-audit typecheck typed-rust typed-wrappers typed-build typed-wrapper-smoke typed-test typed-clean test test-reader test-core test-runtime test-stdlib test-ffi test-modules test-expanded test-contract test-ergo test-typed-parser test-typed-checker test-typed-rust test-typed-wrappers test-pure-audit test-features test-wrappers test-phase4a test-phase4b test-phase4c test-phase4d test-phase4e test-phase4f test-phase5 test-phase5e test-phase6 test-phase7 test-phase8 test-functional test-repl test-security test-security-profile test-native test-gaps native clean-native audit-native clean security security-production security-profile fuzz fuzz-smoke fuzz-deep fuzz-reader-fuzz fuzz-json-fuzz fuzz-http2-fuzz fuzz-dns-fuzz fuzz-pregexp-fuzz fuzz-csv-fuzz fuzz-base64-fuzz fuzz-hex-fuzz fuzz-uri-fuzz fuzz-format-fuzz fuzz-router-fuzz fuzz-sandbox-fuzz test-rawstring test-regex test-rx test-peg test-regex-all check-docs check-docs-strict docker-build docker-push +.PHONY: help chez chez-cross build binary binary-cross native-cross pure-audit typecheck typed-rust typed-wrappers typed-build typed-wrapper-smoke typed-split-tree-smoke typed-test typed-clean test test-reader test-core test-runtime test-stdlib test-ffi test-modules test-expanded test-contract test-ergo test-typed-parser test-typed-checker test-typed-rust test-typed-wrappers test-pure-audit test-features test-wrappers test-phase4a test-phase4b test-phase4c test-phase4d test-phase4e test-phase4f test-phase5 test-phase5e test-phase6 test-phase7 test-phase8 test-functional test-repl test-security test-security-profile test-native test-gaps native clean-native audit-native clean security security-production security-profile fuzz fuzz-smoke fuzz-deep fuzz-reader-fuzz fuzz-json-fuzz fuzz-http2-fuzz fuzz-dns-fuzz fuzz-pregexp-fuzz fuzz-csv-fuzz fuzz-base64-fuzz fuzz-hex-fuzz fuzz-uri-fuzz fuzz-format-fuzz fuzz-router-fuzz fuzz-sandbox-fuzz test-rawstring test-regex test-rx test-peg test-regex-all check-docs check-docs-strict docker-build docker-push help: @echo "Usage: make <target>" @@ -50,6 +50,7 @@ help: @echo " typed-wrappers Generate Jerboa wrappers for typed Rust exports" @echo " typed-build Generate Rust crate sources/wrappers and run cargo build" @echo " typed-wrapper-smoke Build and call generated typed wrappers through FFI" + @echo " typed-split-tree-smoke Build and call the typed split-tree fixture" @echo " typed-test Run Typed Jerboa front-end tests" @echo " typed-clean Remove generated typed build artifacts" @echo " native Build Rust native library" @@ -329,6 +330,14 @@ typed-wrapper-smoke: TYPED_WRAPPER_FILE="build/typed/jerboa-smoke/sample_typed_rust_basic.ss" \ $(SCHEME) --libdirs $(LIBDIRS) --script tests/test-typed-wrapper-e2e.ss +typed-split-tree-smoke: + @$(MAKE) --no-print-directory typed-build TYPED_RUST_SOURCES=tests/fixtures/typed/valid-split-tree.ss TYPED_WRAPPER_DIR=build/typed/split-tree-smoke + @lib="$$(find $(TYPED_RUST_DIR)/target/debug -maxdepth 1 \( -name 'libjerboa_typed_generated.dylib' -o -name 'libjerboa_typed_generated.so' \) -print | head -n 1)"; \ + test -n "$$lib" || { echo "ERROR: generated typed Rust dynamic library not found" >&2; exit 1; }; \ + JERBOA_TYPED_RUST_LIB="$$lib" \ + TYPED_WRAPPER_FILE="build/typed/split-tree-smoke/sample_typed_split_tree.ss" \ + $(SCHEME) --libdirs $(LIBDIRS) --script tests/test-typed-split-tree-e2e.ss + typed-test: test-typed-parser test-typed-checker test-typed-rust test-typed-wrappers typecheck typed-clean: --- a/docs/jerboa-to-rust.md +++ b/docs/jerboa-to-rust.md @@ -244,6 +244,10 @@ and conversion records remain future work. ABI wrappers catch Rust panics before they cross Chez FFI and currently return conservative default values; structured error returns are still future work. +The first recursive data lowering has also landed: variant fields that refer to +their own variant type are emitted as `std::boxed::Box<T>` fields, and +constructors wrap those children when building Rust enum values. + ## Generics The first Rust backend should monomorphize generics. @@ -546,12 +550,10 @@ Recommended first module: typed `split-tree`. Exports: -- `make-leaf` -- `make-split` -- `split-tree-flatten` -- `split-tree-find-parent` -- `split-tree-remove` -- `split-tree-valid?` +- Initial landed slice: `make-leaf`, `make-split`, `split-tree?`, + `split-tree-size`, `leaf-id`, and `leaf-text` +- Next split-tree work: `split-tree-flatten`, `split-tree-find-parent`, + `split-tree-remove`, and `split-tree-valid?` Why: @@ -603,11 +605,13 @@ Second module: typed `rope`. - Support pattern matching. - Pass same-module records and variants through exported typed function boundaries as opaque handles. +- Box self-recursive variant fields in generated Rust. - Support equality and debug output. ### Milestone 4: First Real Module -- Port split-tree or rope subset. +- Port split-tree or rope subset. An initial recursive split-tree fixture now + builds and runs through generated FFI wrappers. - Run dynamic and typed implementations side by side. - Add property tests where practical. --- a/docs/typed-jerboa.md +++ b/docs/typed-jerboa.md @@ -150,7 +150,9 @@ Current landing: modules. The first emitter covers Rust identifiers, primitive types, records, variants, primitive function bodies, record accessors/constructors, variant constructors, variant predicates, and exhaustive variant `match`; - native artifact builds now land through the generated Cargo crate. + recursive variant fields are boxed in generated Rust so the first recursive + data shapes have finite size. Native artifact builds now land through the + generated Cargo crate. - Scalar-only exported functions get initial `extern "C"` Rust wrappers. Rust requires the symbol export marker to be written as `#[unsafe(no_mangle)]`, so generated crates deny unsafe operations rather than claiming a blanket @@ -178,6 +180,9 @@ Current landing: 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. +- `make typed-split-tree-smoke` builds the first recursive split-tree slice: + typed leaf/split constructors, size and leaf accessors, dynamic wrapper + checks, string returns, opaque handles, and explicit handle drops. - `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 @@ -838,9 +843,11 @@ Minimum excluded features: ### Milestone 4: First Real Module -- Implement typed `split-tree` or `rope`. -- Add unit tests. -- Add dynamic boundary tests. +- Implement typed `split-tree` or `rope`. An initial recursive split-tree slice + now lands in `tests/fixtures/typed/valid-split-tree.ss`. +- Add unit tests. Recursive variant lowering is covered by Rust emitter tests. +- Add dynamic boundary tests. `make typed-split-tree-smoke` builds and calls + the generated split-tree wrapper through Chez FFI. - Use it from a small part of Jerboa. ### Milestone 5: Effects and Resources --- a/lib/jerboa/typed/rust.ss +++ b/lib/jerboa/typed/rust.ss @@ -165,6 +165,17 @@ [else (error 'typed-rust "unsupported compound type" type)])] [else (error 'typed-rust "unsupported type" type)])) + (def (rust-owned-field-type owner-type field-type) + (if (and owner-type (equal? owner-type field-type)) + (string-append "std::boxed::Box<" (rust-type field-type) ">") + (rust-type field-type))) + + (def (emit-owned-field-expression owner-type field-type expr) + (let ([out (emit-expression expr)]) + (if (and owner-type (equal? owner-type field-type)) + (string-append "std::boxed::Box::new(" out ")") + out))) + (def (append-map f xs) (let loop ([rest xs] [out '()]) (if (null? rest) @@ -264,14 +275,18 @@ "pub " (rust-symbol-name (typed-field-name field)) ": " - (rust-type (typed-field-type field)) - ","))) + (rust-type (typed-field-type field)) + ","))) (typed-record-fields record)) (write-line port 0 "}") (newline port)) (def (emit-variant-case case port) - (let ([fields (typed-variant-case-fields case)]) + (error 'typed-rust "emit-variant-case requires variant context" case)) + + (def (emit-variant-case* variant case port) + (let ([fields (typed-variant-case-fields case)] + [variant-name (typed-variant-name variant)]) (cond [(null? fields) (write-line port 1 @@ -285,7 +300,7 @@ (string-append (rust-symbol-name (typed-field-name field)) ": " - (rust-type (typed-field-type field)) + (rust-owned-field-type variant-name (typed-field-type field)) ","))) fields) (write-line port 1 "},")]))) @@ -296,7 +311,7 @@ (string-append "pub enum " (rust-symbol-name (typed-variant-name variant)) " {")) (for-each (lambda (case) - (emit-variant-case case port)) + (emit-variant-case* variant case port)) (typed-variant-cases variant)) (write-line port 0 "}") (newline port)) @@ -749,7 +764,10 @@ (string-append (rust-symbol-name (typed-field-name field)) ": " - (emit-expression arg))) + (emit-owned-field-expression + (typed-variant-name variant) + (typed-field-type field) + arg))) fields args) ", ") --- a/tests/fixtures/typed/valid-split-tree.ss +++ b/tests/fixtures/typed/valid-split-tree.ss @@ -1,29 +1,30 @@ (typed-library (sample typed split-tree) - (export make-Pane Pane? Pane-id Pane-focused? Pane-focused?-set! - split-size make-insert make-noop edit-op? edit-size - EditOp? Insert Noop) + (export make-leaf make-split split-tree? split-tree-size leaf-id leaf-text) - (record Pane - ((id : Nat) - (mut focused? : Bool))) + (variant SplitTree + (Leaf (id : Nat) (text : String)) + (Split (left : SplitTree) (right : SplitTree) (size : Nat))) - (variant EditOp - (Insert (at : Nat) (text : String)) - (Noop)) + (def (make-leaf (id : Nat) (text : String)) : SplitTree + (Leaf id text)) - (def (split-size (pane : Pane)) : Nat - (Pane-id pane)) + (def (make-split (left : SplitTree) (right : SplitTree) (size : Nat)) : SplitTree + (Split left right size)) - (def (make-insert (at : Nat) (text : String)) : EditOp - (Insert at text)) + (def (split-tree? (tree : SplitTree)) : Bool + (SplitTree? tree)) - (def (make-noop) : EditOp - (Noop)) + (def (split-tree-size (tree : SplitTree)) : Nat + (match tree + ((Leaf _ text) (string-length text)) + ((Split _ _ size) size))) - (def (edit-op? (op : EditOp)) : Bool - (EditOp? op)) + (def (leaf-id (tree : SplitTree)) : Nat + (match tree + ((Leaf id _) id) + ((Split _ _ _) 0))) - (def (edit-size (op : EditOp)) : Nat - (match op - ((Insert at text) at) - ((Noop) 0)))) + (def (leaf-text (tree : SplitTree)) : String + (match tree + ((Leaf _ text) text) + ((Split _ _ _) "")))) --- a/tests/test-typed-rust.ss +++ b/tests/test-typed-rust.ss @@ -96,6 +96,24 @@ (define return-rust (typed-library-form->rust-string return-form)) +(define recursive-form + '(typed-library (sample typed recursive) + (export make-leaf make-split split-tree-size) + (variant SplitTree + (Leaf (id : Nat) (text : String)) + (Split (left : SplitTree) (right : SplitTree) (size : Nat))) + (def (make-leaf (id : Nat) (text : String)) : SplitTree + (Leaf id text)) + (def (make-split (left : SplitTree) (right : SplitTree) (size : Nat)) : SplitTree + (Split left right size)) + (def (split-tree-size (tree : SplitTree)) : Nat + (match tree + ((Leaf _ text) (string-length text)) + ((Split _ _ size) size))))) + +(define recursive-rust + (typed-library-form->rust-string recursive-form)) + (define ops-form '(typed-library (sample typed ops) (export) @@ -194,6 +212,15 @@ "jt_return_bytes(echo_bytes(data), out_ptr, out_len)")) #t) +(test "rust boxes recursive variant fields" + (and (substring? recursive-rust + "left: std::boxed::Box<SplitTree>,") + (substring? recursive-rust + "right: std::boxed::Box<SplitTree>,") + (substring? recursive-rust + "SplitTree::Split { left: std::boxed::Box::new(left), right: std::boxed::Box::new(right), size: size }")) + #t) + (test "rust lowers record and variant operations" (typed-library-form->rust-string ops-form) ops-rust) new file mode 100644 --- /dev/null +++ b/tests/test-typed-split-tree-e2e.ss @@ -0,0 +1,61 @@ +#!chezscheme +;;; End-to-end smoke test for the first Typed Jerboa split-tree slice. + +(import (chezscheme)) + +(define wrapper-file + (or (getenv "TYPED_WRAPPER_FILE") + "build/typed/split-tree-smoke/sample_typed_split_tree.ss")) + +(load wrapper-file) + +(define pass 0) +(define fail 0) + +(define (check name ok?) + (if ok? + (begin + (set! pass (+ pass 1)) + (printf " ok ~a~%" name)) + (begin + (set! fail (+ fail 1)) + (printf "FAIL ~a~%" name)))) + +(define (raises? thunk) + (guard (exn [#t #t]) + (thunk) + #f)) + +(printf "--- Typed split-tree FFI smoke ---~%") + +(define left (make-leaf 1 "abc")) +(define right (make-leaf 2 "de")) +(define root (make-split left right 5)) + +(check "leaf size" + (= (split-tree-size left) 3)) +(check "leaf id" + (= (leaf-id right) 2)) +(check "leaf text" + (string=? (leaf-text left) "abc")) +(check "split size" + (= (split-tree-size root) 5)) +(check "split leaf fallback id" + (= (leaf-id root) 0)) +(check "split leaf fallback text" + (string=? (leaf-text root) "")) +(check "split-tree predicate" + (split-tree? root)) +(check "make-leaf rejects bad id" + (raises? (lambda () (make-leaf "bad" "abc")))) +(check "make-split rejects wrong handle" + (raises? (lambda () (make-split left "not a tree" 5)))) + +(check "drop split handle" + (%typed-rust-handle-drop! root)) +(check "dropped split handle rejected" + (raises? (lambda () (split-tree-size root)))) + +(printf "~%Typed split-tree FFI smoke: ~a passed, ~a failed~%" pass fail) +(when (> fail 0) + (exit 1))