Add Typed Jerboa split-tree flatten
ober
e6428d1d20790e6f7919fd4df0f7d37c7a69205b
--- a/docs/jerboa-to-rust.md +++ b/docs/jerboa-to-rust.md @@ -249,7 +249,9 @@ their own variant type are emitted as `std::boxed::Box<T>` fields, and constructors wrap those children when building Rust enum values. Match clauses that bind recursive child fields clone the boxed child back into an owned typed value before evaluating the branch body, which is enough for the first -recursive split-tree traversals. +recursive split-tree traversals. The first string-building helper, +`string-append`, lowers to Rust `format!` for two string arguments and supports +the initial recursive `split-tree-flatten`. ## Generics @@ -554,10 +556,10 @@ Recommended first module: typed `split-tree`. Exports: - Initial landed slice: `make-leaf`, `make-split`, `split-tree?`, - `split-tree-size`, `split-tree-total-size`, `split-tree-valid?`, `leaf-id`, - and `leaf-text` -- Next split-tree work: `split-tree-flatten`, `split-tree-find-parent`, - `split-tree-remove`, and `split-tree-valid?` + `split-tree-size`, `split-tree-total-size`, `split-tree-valid?`, + `split-tree-flatten`, `leaf-id`, and `leaf-text` +- Next split-tree work: `split-tree-find-parent`, `split-tree-remove`, and + richer validity checks Why: --- a/docs/typed-jerboa.md +++ b/docs/typed-jerboa.md @@ -181,9 +181,9 @@ Current landing: 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, recursive total-size and validity traversals, - leaf accessors, dynamic wrapper checks, string returns, opaque handles, and - explicit handle drops. + typed leaf/split constructors, recursive total-size, validity, and flatten + traversals, 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 @@ -197,9 +197,11 @@ Current landing: the same module, generated record/variant operations, and exhaustive `match` over same-module variants. The first builtin string primitive, `string-length`, is checked as `(String -> Nat)` and lowers to Rust - `.len()`; `bytevector-length` is checked as `(Bytes -> Nat)` and lowers the - same way. Imported calls and richer forms are reported as unsupported. It - does not yet resolve imports, lower to typed core IR, or emit LLVM. + `.len()`; `string-append` is checked as a two-argument `(String String -> + String)` builtin and lowers to Rust `format!`; `bytevector-length` is checked + as `(Bytes -> Nat)` and lowers the same way. Imported calls and richer forms + are reported as unsupported. It does not yet resolve imports, lower to typed + core IR, or emit LLVM. ## Surface Syntax --- a/lib/jerboa/typed/checker.ss +++ b/lib/jerboa/typed/checker.ss @@ -205,6 +205,8 @@ (list (cons 'string-length (make-typed-call-sig (list 'String) 'Nat)) + (cons 'string-append + (make-typed-call-sig (list 'String 'String) 'String)) (cons 'bytevector-length (make-typed-call-sig (list 'Bytes) 'Nat)))) --- a/lib/jerboa/typed/rust.ss +++ b/lib/jerboa/typed/rust.ss @@ -890,6 +890,16 @@ (emit-expression (car args)) ").len() as u64")) + (def (emit-string-append args) + (unless (= (length args) 2) + (error 'typed-rust "string-append expects two operands" args)) + (string-append + "format!(\"{}{}\", " + (emit-expression (car args)) + ", " + (emit-expression (cadr args)) + ")")) + (def (emit-bytevector-length args) (unless (= (length args) 1) (error 'typed-rust "bytevector-length expects one operand" args)) @@ -915,6 +925,8 @@ [variant-predicate "true"] [(eq? name 'string-length) (emit-string-length args)] + [(eq? name 'string-append) + (emit-string-append args)] [(eq? name 'bytevector-length) (emit-bytevector-length args)] [else --- a/tests/fixtures/typed/valid-split-tree.ss +++ b/tests/fixtures/typed/valid-split-tree.ss @@ -1,6 +1,6 @@ (typed-library (sample typed split-tree) (export make-leaf make-split split-tree? split-tree-size split-tree-total-size - split-tree-valid? leaf-id leaf-text) + split-tree-valid? split-tree-flatten leaf-id leaf-text) (variant SplitTree (Leaf (id : Nat) (text : String)) @@ -32,6 +32,12 @@ ((Split left right _) (and (split-tree-valid? left) (split-tree-valid? right))))) + (def (split-tree-flatten (tree : SplitTree)) : String + (match tree + ((Leaf _ text) text) + ((Split left right _) (string-append (split-tree-flatten left) + (split-tree-flatten right))))) + (def (leaf-id (tree : SplitTree)) : Nat (match tree ((Leaf id _) id) --- a/tests/test-typed-checker.ss +++ b/tests/test-typed-checker.ss @@ -287,6 +287,22 @@ (string-length x)))) '(argument-type-mismatch)) +(test "builtin string-append returns String" + (error-kinds + '(typed-library (body string-append-ok) + (export f) + (def (f (x : String) (y : String)) : String + (string-append x y)))) + '()) + +(test "builtin string-append rejects non-String" + (error-kinds + '(typed-library (body string-append-bad) + (export f) + (def (f (x : String) (y : Nat)) : String + (string-append x y)))) + '(argument-type-mismatch)) + (test "builtin bytevector-length returns Nat" (error-kinds '(typed-library (body bytevector-length-ok) --- a/tests/test-typed-rust.ss +++ b/tests/test-typed-rust.ss @@ -98,7 +98,7 @@ (define recursive-form '(typed-library (sample typed recursive) - (export make-leaf make-split split-tree-size split-tree-total-size) + (export make-leaf make-split split-tree-size split-tree-total-size split-tree-flatten) (variant SplitTree (Leaf (id : Nat) (text : String)) (Split (left : SplitTree) (right : SplitTree) (size : Nat))) @@ -114,7 +114,12 @@ (match tree ((Leaf _ text) (string-length text)) ((Split left right _) (+ (split-tree-total-size left) - (split-tree-total-size right))))))) + (split-tree-total-size right))))) + (def (split-tree-flatten (tree : SplitTree)) : String + (match tree + ((Leaf _ text) text) + ((Split left right _) (string-append (split-tree-flatten left) + (split-tree-flatten right))))))) (define recursive-rust (typed-library-form->rust-string recursive-form)) @@ -231,6 +236,11 @@ "SplitTree::Split { left: left_box, right: right_box, size: _ } => { let left = (*left_box).clone(); let right = (*right_box).clone(); (split_tree_total_size(left) + split_tree_total_size(right)) },")) #t) +(test "rust lowers string-append" + (substring? recursive-rust + "format!(\"{}{}\", split_tree_flatten(left), split_tree_flatten(right))") + #t) + (test "rust lowers record and variant operations" (typed-library-form->rust-string ops-form) ops-rust) --- a/tests/test-typed-split-tree-e2e.ss +++ b/tests/test-typed-split-tree-e2e.ss @@ -44,6 +44,8 @@ (= (split-tree-total-size root) 5)) (check "split valid" (split-tree-valid? root)) +(check "split flatten" + (string=? (split-tree-flatten root) "abcde")) (check "split leaf fallback id" (= (leaf-id root) 0)) (check "split leaf fallback text"