coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions 1 Packages Projects Releases Wiki Activity

haskell: Phase 11 — Data.Map updating (adjust/insertWith/insertWithKey/alter)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 1m21s
Details

Browse Source 
Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
giles
2026-05-07 10:55:39 +00:00
parent 6620c0ac06
commit b0974b58c0
2 changed files with 106 additions and 1 deletions
Download Patch File Download Diff File Expand all files Collapse all files

99
lib/haskell/map.sx
View File

@@ -419,3 +419,102 @@
(fn (k v acc) (cond ((p k v) (hk-map-insert k v acc)) (:else acc)))
hk-map-empty
m)))
(define
hk-map-adjust
(fn
(f k m)
(cond
((hk-map-empty? m) m)
(:else
(let
((mk (hk-map-key m)))
(cond
((< k mk)
(hk-map-node
mk
(hk-map-val m)
(hk-map-adjust f k (hk-map-left m))
(hk-map-right m)))
((> k mk)
(hk-map-node
mk
(hk-map-val m)
(hk-map-left m)
(hk-map-adjust f k (hk-map-right m))))
(:else
(hk-map-node
mk
(f (hk-map-val m))
(hk-map-left m)
(hk-map-right m)))))))))
(define
hk-map-insert-with
(fn
(f k v m)
(cond
((hk-map-empty? m) (hk-map-singleton k v))
(:else
(let
((mk (hk-map-key m)))
(cond
((< k mk)
(hk-map-balance
mk
(hk-map-val m)
(hk-map-insert-with f k v (hk-map-left m))
(hk-map-right m)))
((> k mk)
(hk-map-balance
mk
(hk-map-val m)
(hk-map-left m)
(hk-map-insert-with f k v (hk-map-right m))))
(:else
(hk-map-node
mk
(f v (hk-map-val m))
(hk-map-left m)
(hk-map-right m)))))))))
(define
hk-map-insert-with-key
(fn
(f k v m)
(cond
((hk-map-empty? m) (hk-map-singleton k v))
(:else
(let
((mk (hk-map-key m)))
(cond
((< k mk)
(hk-map-balance
mk
(hk-map-val m)
(hk-map-insert-with-key f k v (hk-map-left m))
(hk-map-right m)))
((> k mk)
(hk-map-balance
mk
(hk-map-val m)
(hk-map-left m)
(hk-map-insert-with-key f k v (hk-map-right m))))
(:else
(hk-map-node
mk
(f k v (hk-map-val m))
(hk-map-left m)
(hk-map-right m)))))))))
(define
hk-map-alter
(fn
(f k m)
(let
((look (hk-map-lookup k m)))
(let
((res (f look)))
(cond
((= (first res) "Nothing") (hk-map-delete k m))
(:else (hk-map-insert k (nth res 1) m)))))))