diff --git a/Labs/06.rkt b/Labs/06.rkt new file mode 100644 index 0000000..bae09ed --- /dev/null +++ b/Labs/06.rkt @@ -0,0 +1,95 @@ +#lang plait +(define-type BoxTree + [mt] + [node (b : (Boxof (Optionof Number))) (l : BoxTree) (r : BoxTree)]) + +(define (unify-trees! t1 t2) + (cond + [(and (mt? t1) (mt? t2)) (void)] + [(or (mt? t1) (mt? t2)) (error 'unify-trees! "shape mismatch")] + [( + +(module+ test + ;; Same shape, one "variable" in each + (let ([t1 (node (box (some 0)) + (node (box (some 1)) (mt) (mt)) + (node (box (none)) (mt) (mt)))] + [t2 (node (box (some 0)) + (node (box (none)) (mt) (mt)) + (node (box (some 2)) (mt) (mt)))] + [result (node (box (some 0)) + (node (box (some 1)) (mt) (mt)) + (node (box (some 2)) (mt) (mt)))]) + (begin + (unify-trees! t1 t2) + (test t1 result) + (test t2 result))) + + (test/exn (unify-trees! (node (box (some 1)) + (node (box (none)) (mt) (mt)) + (mt)) + (node (box (none)) (mt) (mt))) + "shape mismatch") + (test/exn (unify-trees! (node (box (some 1)) (mt) (mt)) + (node (box (some 2)) (mt) (mt))) "value mismatch") + + ;; Only variables + (let ([t1 (node (box (none)) (mt) (mt))] + [t2 (node (box (none)) (mt) (mt))] + [result (node (box (none)) (mt) (mt))]) + (begin + (unify-trees! t1 t2) + (test t1 result) + (test t2 result))) + + ;; compatible elements, different shape + (test/exn + (unify-trees! + (node (box (some 0)) + (node (box (some 1)) (mt) (node (box (none)) (mt) (mt))) + (mt)) + (node (box (some 0)) + (mt) + (node (box (some 1)) (node (box (none)) (mt) (mt)) (mt)))) + "shape mismatch") + + ;; deeper trees + (let ([result (node + (box (some 0)) + (node + (box (some 1)) + (node (box (some 2)) + (node (box (some 3)) + (node (box (some 4)) (mt) (mt)) + (mt)) + (mt)) + (mt)) + (mt))] + [t1 (node + (box (none)) + (node + (box (some 1)) + (node (box (none)) + (node (box (some 3)) + (node (box (some 4)) (mt) (mt)) + (mt)) + (mt)) + (mt)) + (mt))] + [t2 (node + (box (some 0)) + (node + (box (none)) + (node (box (some 2)) + (node (box (none)) + (node (box (some 4)) (mt) (mt)) + (mt)) + (mt)) + (mt)) + (mt))]) + (begin + (unify-trees! t1 t2) + (test t1 t2) + (test t1 result) + (test t2 result))) + ) \ No newline at end of file