IsaacShoebottom/CS4613
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Add lab 6 skelton

Browse Source
This commit is contained in:
Isaac Shoebottom 2025-03-11 12:43:03 -03:00
parent 059a7c0c28
commit ca9e030f83
1 changed files with 95 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

95
Labs/06.rkt Normal file
View File

@ -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)))
)