Add lab 6 skelton

2025-03-11 12:43:03 -03:00 · 2025-03-11 12:43:03 -03:00 · ca9e030f83
commit ca9e030f83
parent 059a7c0c28
1 changed files with 95 additions and 0 deletions
--- a/Labs/06.rkt
+++ 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)))
+  )