From 180b9009bf02a4c6f18b237e2f1c1e8fe63bbe8a Mon Sep 17 00:00:00 2001
From: giles <giles.bradshaw@rose-ash.com>
Date: Thu, 7 May 2026 09:02:47 +0000
Subject: [PATCH] =?UTF-8?q?haskell:=20Phase=2011=20=E2=80=94=20Data.Map=20?=
 =?UTF-8?q?core=20operations=20(singleton/insert/lookup/delete/member/null?=
 =?UTF-8?q?)?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
---
 lib/haskell/map.sx            | 142 ++++++++++++++++++++++++++++++++++
 plans/haskell-completeness.md |  11 ++-
 2 files changed, 152 insertions(+), 1 deletion(-)

diff --git a/lib/haskell/map.sx b/lib/haskell/map.sx
index 3bec9ec9..cc30f288 100644
--- a/lib/haskell/map.sx
+++ b/lib/haskell/map.sx
@@ -132,3 +132,145 @@
                 (hk-map-single-r k v l r))
               (:else (hk-map-double-r k v l r)))))
         (:else (hk-map-node k v l r))))))
+
+(define
+  hk-map-singleton
+  (fn (k v) (hk-map-node k v hk-map-empty hk-map-empty)))
+
+(define
+  hk-map-insert
+  (fn
+    (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 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 k v (hk-map-right m))))
+            (:else (hk-map-node k v (hk-map-left m) (hk-map-right m)))))))))
+
+(define
+  hk-map-lookup
+  (fn
+    (k m)
+    (cond
+      ((hk-map-empty? m) (list "Nothing"))
+      (:else
+        (let
+          ((mk (hk-map-key m)))
+          (cond
+            ((< k mk) (hk-map-lookup k (hk-map-left m)))
+            ((> k mk) (hk-map-lookup k (hk-map-right m)))
+            (:else (list "Just" (hk-map-val m)))))))))
+
+(define
+  hk-map-member
+  (fn
+    (k m)
+    (cond
+      ((hk-map-empty? m) false)
+      (:else
+        (let
+          ((mk (hk-map-key m)))
+          (cond
+            ((< k mk) (hk-map-member k (hk-map-left m)))
+            ((> k mk) (hk-map-member k (hk-map-right m)))
+            (:else true)))))))
+
+(define hk-map-null hk-map-empty?)
+
+(define
+  hk-map-find-min
+  (fn
+    (m)
+    (cond
+      ((hk-map-empty? (hk-map-left m))
+        (list (hk-map-key m) (hk-map-val m)))
+      (:else (hk-map-find-min (hk-map-left m))))))
+
+(define
+  hk-map-delete-min
+  (fn
+    (m)
+    (cond
+      ((hk-map-empty? (hk-map-left m)) (hk-map-right m))
+      (:else
+        (hk-map-balance
+          (hk-map-key m)
+          (hk-map-val m)
+          (hk-map-delete-min (hk-map-left m))
+          (hk-map-right m))))))
+
+(define
+  hk-map-find-max
+  (fn
+    (m)
+    (cond
+      ((hk-map-empty? (hk-map-right m))
+        (list (hk-map-key m) (hk-map-val m)))
+      (:else (hk-map-find-max (hk-map-right m))))))
+
+(define
+  hk-map-delete-max
+  (fn
+    (m)
+    (cond
+      ((hk-map-empty? (hk-map-right m)) (hk-map-left m))
+      (:else
+        (hk-map-balance
+          (hk-map-key m)
+          (hk-map-val m)
+          (hk-map-left m)
+          (hk-map-delete-max (hk-map-right m)))))))
+
+(define
+  hk-map-glue
+  (fn
+    (l r)
+    (cond
+      ((hk-map-empty? l) r)
+      ((hk-map-empty? r) l)
+      ((> (hk-map-size l) (hk-map-size r))
+        (let
+          ((mp (hk-map-find-max l)))
+          (hk-map-balance (first mp) (nth mp 1) (hk-map-delete-max l) r)))
+      (:else
+        (let
+          ((mp (hk-map-find-min r)))
+          (hk-map-balance (first mp) (nth mp 1) l (hk-map-delete-min r)))))))
+
+(define
+  hk-map-delete
+  (fn
+    (k m)
+    (cond
+      ((hk-map-empty? m) m)
+      (:else
+        (let
+          ((mk (hk-map-key m)))
+          (cond
+            ((< k mk)
+              (hk-map-balance
+                mk
+                (hk-map-val m)
+                (hk-map-delete k (hk-map-left m))
+                (hk-map-right m)))
+            ((> k mk)
+              (hk-map-balance
+                mk
+                (hk-map-val m)
+                (hk-map-left m)
+                (hk-map-delete k (hk-map-right m))))
+            (:else (hk-map-glue (hk-map-left m) (hk-map-right m)))))))))
diff --git a/plans/haskell-completeness.md b/plans/haskell-completeness.md
index 42238018..ea524e0d 100644
--- a/plans/haskell-completeness.md
+++ b/plans/haskell-completeness.md
@@ -182,7 +182,7 @@ No OCaml changes are needed. The view type is fully representable as an SX dict.
 - [x] Implement a weight-balanced BST in pure SX in `lib/haskell/map.sx`.
   Internal node representation: `("Map-Node" key val left right size)`.
   Leaf: `("Map-Empty")`.
-- [ ] Core operations: `empty`, `singleton`, `insert`, `lookup`, `delete`,
+- [x] Core operations: `empty`, `singleton`, `insert`, `lookup`, `delete`,
   `member`, `size`, `null`.
 - [ ] Bulk operations: `fromList`, `toList`, `toAscList`, `keys`, `elems`.
 - [ ] Combining: `unionWith`, `intersectionWith`, `difference`.
@@ -304,6 +304,15 @@ No OCaml changes are needed. The view type is fully representable as an SX dict.
 
 _Newest first._
 
+**2026-05-07** — Phase 11 core operations on `Data.Map` BST:
+- Added `hk-map-singleton`, `hk-map-insert`, `hk-map-lookup`, `hk-map-delete`,
+  `hk-map-member`, `hk-map-null`. Insert recurses with `hk-map-balance` to
+  maintain weight invariants. Lookup returns `("Just" v)` / `("Nothing")` —
+  matches Haskell ADT layout. Delete uses a `hk-map-glue` helper that picks
+  the larger subtree and pulls its extreme element to the root, preserving
+  balance without imperative state. Spot-checked: insert+lookup hit/miss,
+  member, delete root with successor pulled from right.
+
 **2026-05-07** — Phase 11 BST skeleton in `lib/haskell/map.sx`:
 - Adams-style weight-balanced tree: node = `("Map-Node" k v l r size)`,
   empty = `("Map-Empty")`. delta=3 / gamma=2 ratios. Implemented constructors