Compare typed split-tree with dynamic reference
ober
64b8b652f21645867059cda555b26687184fcbce
--- a/docs/jerboa-to-rust.md +++ b/docs/jerboa-to-rust.md @@ -559,8 +559,10 @@ Exports: `split-tree-size`, `split-tree-total-size`, `split-tree-valid?`, `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 +- The split-tree smoke test now compares generated typed/Rust results against a + small dynamic tagged-list reference implementation. +- Next split-tree work: richer validity checks and use from a small Jerboa + caller Why: @@ -620,7 +622,9 @@ Second module: typed `rope`. - 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. +- Run dynamic and typed implementations side by side. Initial smoke coverage now + compares flatten, total-size, parent lookup, and remove results against a + dynamic reference implementation. - Add property tests where practical. ### Milestone 5: Resource Types --- a/docs/typed-jerboa.md +++ b/docs/typed-jerboa.md @@ -853,7 +853,8 @@ Minimum excluded features: - 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 - the generated split-tree wrapper through Chez FFI. + the generated split-tree wrapper through Chez FFI and compares the typed + results with a small dynamic split-tree reference implementation. - Use it from a small part of Jerboa. ### Milestone 5: Effects and Resources --- a/tests/test-typed-split-tree-e2e.ss +++ b/tests/test-typed-split-tree-e2e.ss @@ -26,11 +26,66 @@ (thunk) #f)) +(define (dyn-leaf id text) + (list 'leaf id text)) + +(define (dyn-split id left right size) + (list 'split id left right size)) + +(define (dyn-size tree) + (case (car tree) + [(leaf) (string-length (caddr tree))] + [(split) (list-ref tree 4)] + [else 0])) + +(define (dyn-total-size tree) + (case (car tree) + [(leaf) (string-length (caddr tree))] + [(split) (+ (dyn-total-size (caddr tree)) + (dyn-total-size (cadddr tree)))] + [else 0])) + +(define (dyn-flatten tree) + (case (car tree) + [(leaf) (caddr tree)] + [(split) (string-append + (dyn-flatten (caddr tree)) + (dyn-flatten (cadddr tree)))] + [else ""])) + +(define (dyn-find-parent tree target parent) + (case (car tree) + [(leaf) (if (= (cadr tree) target) parent 0)] + [(split) + (let ([id (cadr tree)]) + (let ([left-parent (dyn-find-parent (caddr tree) target id)]) + (if (> left-parent 0) + left-parent + (dyn-find-parent (cadddr tree) target id))))] + [else 0])) + +(define (dyn-remove tree target) + (case (car tree) + [(leaf) + (if (= (cadr tree) target) + (dyn-leaf (cadr tree) "") + tree)] + [(split) + (dyn-split + (cadr tree) + (dyn-remove (caddr tree) target) + (dyn-remove (cadddr tree) target) + (list-ref tree 4))] + [else tree])) + (printf "--- Typed split-tree FFI smoke ---~%") (define left (make-leaf 1 "abc")) (define right (make-leaf 2 "de")) (define root (make-split 10 left right 5)) +(define dyn-left (dyn-leaf 1 "abc")) +(define dyn-right (dyn-leaf 2 "de")) +(define dyn-root (dyn-split 10 dyn-left dyn-right 5)) (check "leaf size" (= (split-tree-size left) 3)) @@ -46,8 +101,15 @@ (split-tree-valid? root)) (check "split flatten" (string=? (split-tree-flatten root) "abcde")) +(check "typed flatten matches dynamic" + (string=? (split-tree-flatten root) (dyn-flatten dyn-root))) +(check "typed total size matches dynamic" + (= (split-tree-total-size root) (dyn-total-size dyn-root))) (check "find left parent" (= (split-tree-find-parent root 1 0) 10)) +(check "typed parent lookup matches dynamic" + (= (split-tree-find-parent root 1 0) + (dyn-find-parent dyn-root 1 0))) (check "find root parent sentinel" (= (split-tree-find-parent root 10 0) 0)) (check "split id" @@ -62,8 +124,11 @@ (raises? (lambda () (make-split 10 left "not a tree" 5)))) (define removed (split-tree-remove root 1)) +(define dyn-removed (dyn-remove dyn-root 1)) (check "remove leaf" (string=? (split-tree-flatten removed) "de")) +(check "typed remove matches dynamic" + (string=? (split-tree-flatten removed) (dyn-flatten dyn-removed))) (check "drop split handle" (%typed-rust-handle-drop! root))