Expand Typed Jerboa split-tree operations
ober
f0a5303c5ba43aceaeb4708ac182b0ba153026bc
--- a/docs/jerboa-to-rust.md +++ b/docs/jerboa-to-rust.md @@ -557,9 +557,10 @@ Exports: - Initial landed slice: `make-leaf`, `make-split`, `split-tree?`, `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 + `split-tree-flatten`, `split-tree-find-parent`, `split-tree-remove`, + `leaf-id`, and `leaf-text` +- Next split-tree work: richer validity checks and side-by-side comparison with + a dynamic implementation Why: --- a/docs/typed-jerboa.md +++ b/docs/typed-jerboa.md @@ -182,8 +182,8 @@ Current landing: FFI boundary. - `make typed-split-tree-smoke` builds the first recursive split-tree slice: typed leaf/split constructors, recursive total-size, validity, and flatten - traversals, leaf accessors, dynamic wrapper checks, string returns, opaque - handles, and explicit handle drops. + traversals, parent lookup, remove-by-leaf-id, 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 @@ -848,7 +848,8 @@ Minimum excluded features: - Implement typed `split-tree` or `rope`. An initial recursive split-tree slice now lands in `tests/fixtures/typed/valid-split-tree.ss`, including recursive - child traversal through boxed Rust variant fields. + child traversal, parent lookup, and remove-by-leaf-id through boxed Rust + variant fields. - Add unit tests. Recursive variant lowering and recursive match child rebinding are covered by Rust emitter tests. - Add dynamic boundary tests. `make typed-split-tree-smoke` builds and calls --- a/tests/fixtures/typed/valid-split-tree.ss +++ b/tests/fixtures/typed/valid-split-tree.ss @@ -1,16 +1,17 @@ (typed-library (sample typed split-tree) (export make-leaf make-split split-tree? split-tree-size split-tree-total-size - split-tree-valid? split-tree-flatten leaf-id leaf-text) + split-tree-valid? split-tree-flatten split-tree-find-parent + split-tree-remove leaf-id leaf-text) (variant SplitTree (Leaf (id : Nat) (text : String)) - (Split (left : SplitTree) (right : SplitTree) (size : Nat))) + (Split (id : Nat) (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 (make-split (id : Nat) (left : SplitTree) (right : SplitTree) (size : Nat)) : SplitTree + (Split id left right size)) (def (split-tree? (tree : SplitTree)) : Bool (SplitTree? tree)) @@ -18,32 +19,49 @@ (def (split-tree-size (tree : SplitTree)) : Nat (match tree ((Leaf _ text) (string-length text)) - ((Split _ _ size) size))) + ((Split _ _ _ size) size))) (def (split-tree-total-size (tree : SplitTree)) : Nat (match tree ((Leaf _ text) (string-length text)) - ((Split left right _) (+ (split-tree-total-size left) - (split-tree-total-size right))))) + ((Split _ left right _) (+ (split-tree-total-size left) + (split-tree-total-size right))))) (def (split-tree-valid? (tree : SplitTree)) : Bool (match tree ((Leaf _ _) #t) - ((Split left right _) (and (split-tree-valid? left) - (split-tree-valid? right))))) + ((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))))) + ((Split _ left right _) (string-append (split-tree-flatten left) + (split-tree-flatten right))))) + + (def (split-tree-find-parent (tree : SplitTree) (target : Nat) (parent : Nat)) : Nat + (match tree + ((Leaf id _) (if (= id target) parent 0)) + ((Split id left right _) + (let ((left-parent (split-tree-find-parent left target id))) + (if (> left-parent 0) + left-parent + (split-tree-find-parent right target id)))))) + + (def (split-tree-remove (tree : SplitTree) (target : Nat)) : SplitTree + (match tree + ((Leaf id text) (if (= id target) (Leaf id "") (Leaf id text))) + ((Split id left right size) (Split id + (split-tree-remove left target) + (split-tree-remove right target) + size)))) (def (leaf-id (tree : SplitTree)) : Nat (match tree ((Leaf id _) id) - ((Split _ _ _) 0))) + ((Split id _ _ _) id))) (def (leaf-text (tree : SplitTree)) : String (match tree ((Leaf _ text) text) - ((Split _ _ _) "")))) + ((Split _ _ _ _) "")))) --- a/tests/test-typed-rust.ss +++ b/tests/test-typed-rust.ss @@ -101,25 +101,25 @@ (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))) + (Split (id : Nat) (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 (make-split (id : Nat) (left : SplitTree) (right : SplitTree) (size : Nat)) : SplitTree + (Split id left right size)) (def (split-tree-size (tree : SplitTree)) : Nat (match tree ((Leaf _ text) (string-length text)) - ((Split _ _ size) size))) + ((Split _ _ _ size) size))) (def (split-tree-total-size (tree : SplitTree)) : Nat (match tree ((Leaf _ text) (string-length text)) - ((Split left right _) (+ (split-tree-total-size left) - (split-tree-total-size right))))) + ((Split _ left right _) (+ (split-tree-total-size left) + (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))))))) + ((Split _ left right _) (string-append (split-tree-flatten left) + (split-tree-flatten right))))))) (define recursive-rust (typed-library-form->rust-string recursive-form)) @@ -228,12 +228,12 @@ (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 }")) + "SplitTree::Split { id: id, left: std::boxed::Box::new(left), right: std::boxed::Box::new(right), size: size }")) #t) (test "rust unboxes recursive match bindings" (and (substring? recursive-rust - "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)) },")) + "SplitTree::Split { id: _, 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" --- a/tests/test-typed-split-tree-e2e.ss +++ b/tests/test-typed-split-tree-e2e.ss @@ -30,7 +30,7 @@ (define left (make-leaf 1 "abc")) (define right (make-leaf 2 "de")) -(define root (make-split left right 5)) +(define root (make-split 10 left right 5)) (check "leaf size" (= (split-tree-size left) 3)) @@ -46,8 +46,12 @@ (split-tree-valid? root)) (check "split flatten" (string=? (split-tree-flatten root) "abcde")) -(check "split leaf fallback id" - (= (leaf-id root) 0)) +(check "find left parent" + (= (split-tree-find-parent root 1 0) 10)) +(check "find root parent sentinel" + (= (split-tree-find-parent root 10 0) 0)) +(check "split id" + (= (leaf-id root) 10)) (check "split leaf fallback text" (string=? (leaf-text root) "")) (check "split-tree predicate" @@ -55,7 +59,11 @@ (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)))) + (raises? (lambda () (make-split 10 left "not a tree" 5)))) + +(define removed (split-tree-remove root 1)) +(check "remove leaf" + (string=? (split-tree-flatten removed) "de")) (check "drop split handle" (%typed-rust-handle-drop! root))