mirror of
https://github.com/HigherOrderCO/Kind.git
synced 2024-09-11 17:56:48 +03:00
34 lines
1.3 KiB
Plaintext
34 lines
1.3 KiB
Plaintext
BBT.set
|
|
: ∀(K: *)
|
|
∀(V: *)
|
|
∀(cmp: ∀(a: K) ∀(b: K) Cmp)
|
|
∀(key: K)
|
|
∀(val: V)
|
|
∀(map: (BBT K V))
|
|
(BBT K V)
|
|
= λK λV λcmp λkey λval λmap
|
|
let P = λx ∀(key: K) ∀(val: V) (BBT K V)
|
|
let bin = λsize λnext.key λnext.val λnext.lft λnext.rgt λkey λval
|
|
let P = λx ∀(key: K) ∀(next.key: K) ∀(next.val: V) ∀(next.lft: (BBT K V)) ∀(next.rgt: (BBT K V)) ∀(key: K) ∀(val: V) (BBT K V)
|
|
|
|
// Go left
|
|
let ltn = λkey λnext.key λnext.val λnext.lft λnext.rgt λkey λval
|
|
let new_lft = (BBT.set K V cmp key val next.lft)
|
|
(BBT.balance K V cmp key next.key next.val new_lft next.rgt)
|
|
|
|
// Same key, update value
|
|
// Should we update the value or return the same tree?
|
|
let eql = λkey λnext.key λnext.val λnext.lft λnext.rgt λkey λval
|
|
(BBT.bin K V size next.key val next.lft next.rgt)
|
|
|
|
// Go right
|
|
let gtn = λkey λnext.key λnext.val λnext.lft λnext.rgt λkey λval
|
|
let new_rgt = (BBT.set K V cmp key val next.rgt)
|
|
(BBT.balance K V cmp key next.key next.val next.lft new_rgt)
|
|
((~(cmp key next.key) P ltn eql gtn) key next.key next.val next.lft next.rgt key val)
|
|
|
|
// Empty tree, create new node
|
|
let tip = λkey λval
|
|
(BBT.singleton K V key val)
|
|
((~map P bin tip) key val)
|