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

Add another implementation

Browse Source
This commit is contained in:
Isaac Shoebottom 2025-03-12 11:49:41 -03:00
parent 7a6aadd187
commit 1cd7811780
1 changed files with 25 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
Labs/06.rkt
View File

@ -38,20 +38,41 @@
[(node b l r) (type-case (Optionof Number) (unbox b) [(node b l r) (type-case (Optionof Number) (unbox b)
[(some b) (set-box! (node-b t1-r) (unbox (node-b t2-r)))] [(some b) (set-box! (node-b t1-r) (unbox (node-b t2-r)))]
[(none) (set-box! (node-b t1-l) (unbox (node-b t2-l)))])] [(none) (set-box! (node-b t1-l) (unbox (node-b t2-l)))])]
[else (void)]) [else (unify-trees! t1-l t1-r)])
(type-case BoxTree t2-l (type-case BoxTree t2-l
[(node b l r) (type-case (Optionof Number) (unbox b) [(node b l r) (type-case (Optionof Number) (unbox b)
[(some b) (set-box! (node-b t2-r) (unbox (node-b t1-r)))] [(some b) (set-box! (node-b t2-r) (unbox (node-b t1-r)))]
[(none) (set-box! (node-b t2-l) (unbox (node-b t1-l)))])] [(none) (set-box! (node-b t2-l) (unbox (node-b t1-l)))])]
[else (void)]) [else (unify-trees! t2-l t2-r)])))]))
(unify-trees! t1-l t1-r)
(unify-trees! t2-l t2-r)))])) ; should only call set box once per branch
; should probably call unify trees after calling set box
;
(define (unify-trees! t1 t2) (define (unify-trees! t1 t2)
(cond (cond
[(and (mt? t1) (mt? t2)) (void)] [(and (mt? t1) (mt? t2)) (void)]
[(or (mt? t1) (mt? t2)) (error 'unify-trees! "shape mismatch")] [(or (mt? t1) (mt? t2)) (error 'unify-trees! "shape mismatch")]
[else [else
(begin
(type-case (Optionof Number) (unbox (node-b t1))
[(some v1)
(type-case (Optionof Number) (unbox (node-b t2))
[(some v2) (if (eq? v1 v2)
(type-case BoxTree (node-l t1)
[(node b l r) (begin
(set-box! (node-b (node-r t1)) (unbox (node-b (node-r t2))))
(set-box! (node-b (node-l t2)) (unbox (node-b (node-l t1)))))]
[(mt) (begin
(set-box! (node-b (node-l t1)) (unbox (node-b (node-l t2))))
(set-box! (node-b (node-r t2)) (unbox (node-b (node-r t1)))))])
(error 'unify-trees! "value mismatch"))]
[(none) (begin
(set-box! (node-b (node-l t1)) (unbox (node-b (node-l t2))))
(set-box! (node-b (node-r t2)) (unbox (node-b (node-r t1)))))])]
[(none) (begin
(unify-trees! (node-l t1) (node-r t1))
(unify-trees! (node-l t2) (node-r t2)))]))]))