Some kind of implementations

This commit is contained in:
Isaac Shoebottom 2025-03-11 23:22:26 -03:00
parent ca9e030f83
commit 7a6aadd187

View File

@ -3,11 +3,58 @@
[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")]
[else
(let* ([t1-l (node-l t1)]
[t1-r (node-r t1)]
[t2-l (node-l t2)]
[t2-r (node-r t2)])
(begin
(type-case BoxTree t1-l
[(node b l r) (type-case (Optionof Number) (unbox b)
[(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)))])]
[else (void)])
(type-case BoxTree t2-l
[(node b l r) (type-case (Optionof Number) (unbox b)
[(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)))])]
[else (unify-trees! )])))]))
#;(define (unify-trees! t1 t2)
(cond
[(and (mt? t1) (mt? t2)) (void)]
[(or (mt? t1) (mt? t2)) (error 'unify-trees! "shape mismatch")]
[else
(let* ([t1-l (node-l t1)]
[t1-r (node-r t1)]
[t2-l (node-l t2)]
[t2-r (node-r t2)])
(begin
(type-case BoxTree t1-l
[(node b l r) (type-case (Optionof Number) (unbox b)
[(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)))])]
[else (void)])
(type-case BoxTree t2-l
[(node b l r) (type-case (Optionof Number) (unbox b)
[(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)))])]
[else (void)])
(unify-trees! t1-l t1-r)
(unify-trees! t2-l t2-r)))]))
(define (unify-trees! t1 t2)
(cond
[(and (mt? t1) (mt? t2)) (void)]
[(or (mt? t1) (mt? t2)) (error 'unify-trees! "shape mismatch")]
[(
[else
(module+ test
;; Same shape, one "variable" in each