naturals

commit 809f6e44c7f4e2b23aca3d4fd606e1e7dd4132b2
parent d749985de2efd24f0d2e892e4a51a8575078aa53
Author: Robert Russell <robert@rr3.xyz>
Date:   Sat,  5 Jul 2025 18:00:44 -0700

Add NatMap

Diffstat:
M
TODO
 | 
4
++++
M
src/Naturals/FinatSeq/Unsafe.hs
 | 
10
+++++-----
M
src/Naturals/Nat.hs
 | 
9
+++++++++
A
src/Naturals/NatMap.hs
 | 
51
+++++++++++++++++++++++++++++++++++++++++++++++++++

4 files changed, 69 insertions(+), 5 deletions(-)
diff --git a/TODO b/TODO
@@ -1 +1,5 @@
+Document FinatSeq
+
 FinaturalSeq, or somehow generalize FinatSeq to support other IsFin types
+
+Add version number
diff --git a/src/Naturals/FinatSeq/Unsafe.hs b/src/Naturals/FinatSeq/Unsafe.hs
@@ -7,8 +7,8 @@ module Naturals.FinatSeq.Unsafe (
     showl,
     showsPrecr,
     showr,
-    singleton,
     length,
+    singleton,
     lookup,
     adjust,
     replace,
@@ -82,12 +82,12 @@ instance (Show a) => Show (FinatSeq n a) where
 --------------------------------------------------------------------------------
 -- Common operations
 
-singleton :: a -> FinatSeq SZ a
-singleton = FinatSeqUnsafe . Seq.singleton
-
 length :: FinatSeq n a -> Snat n
 length (FinatSeqUnsafe s) = SnatUnsafe . fromIntegral . Seq.length $ s
 
+singleton :: a -> FinatSeq SZ a
+singleton = FinatSeqUnsafe . Seq.singleton
+
 lookup :: Finat n -> FinatSeq n a -> a
 lookup (FinatUnsafe i) (FinatSeqUnsafe s) = Seq.index s (fromIntegral i)
 
@@ -95,4 +95,4 @@ adjust :: (a -> a) -> Finat n -> FinatSeq n a -> FinatSeq n a
 adjust f (FinatUnsafe i) = coerce $ Seq.adjust' f (fromIntegral i)
 
 replace :: Finat n -> a -> FinatSeq n a -> FinatSeq n a
-replace k v = adjust (const v) k
+replace i v = adjust (const v) i
diff --git a/src/Naturals/Nat.hs b/src/Naturals/Nat.hs
@@ -32,3 +32,12 @@ instance ToNat Word where
 
 instance FromNat Word where
     fromNat (Nat n) = n
+
+-- As per the notes in Data.Int and Data.Word, conversions between Int and Word
+-- preserve representation, not sign.
+
+instance FromNat Int where
+    fromNat = fromIntegral
+
+instance ToNat Int where
+    toNat = fromIntegral
diff --git a/src/Naturals/NatMap.hs b/src/Naturals/NatMap.hs
@@ -0,0 +1,51 @@
+module Naturals.NatMap where
+
+import Data.Bifunctor (first)
+import Data.IntMap.Strict (IntMap)
+import Data.IntMap.Strict qualified as IntMap
+
+import Naturals.Nat
+
+-- | A wrapper around @IntMap@ that uses @Nat@s instead of @Int@s.
+--
+-- Only an subset of the @IntMap@ API is provided, but that subset shall grow
+-- as needed.
+newtype NatMap a = NatMap {unNatMap :: IntMap a}
+    deriving (Eq, Functor, Foldable, Traversable)
+    deriving newtype (Show)
+
+empty :: NatMap a
+empty = NatMap IntMap.empty
+
+singleton :: Nat -> a -> NatMap a
+singleton k = NatMap . IntMap.singleton (fromNat k)
+
+fromList :: [(Nat, a)] -> NatMap a
+fromList = NatMap . IntMap.fromList . map (first fromNat)
+
+insert :: Nat -> a -> NatMap a -> NatMap a
+insert k v = NatMap . IntMap.insert (fromNat k) v . unNatMap
+
+delete :: Nat -> NatMap a -> NatMap a
+delete k = NatMap . IntMap.delete (fromNat k) . unNatMap
+
+adjust :: (a -> a) -> Nat -> NatMap a -> NatMap a
+adjust f k = NatMap . IntMap.adjust f (fromNat k) . unNatMap
+
+update :: (a -> Maybe a) -> Nat -> NatMap a -> NatMap a
+update f k = NatMap . IntMap.update f (fromNat k) . unNatMap
+
+alter :: (Maybe a -> Maybe a) -> Nat -> NatMap a -> NatMap a
+alter f k = NatMap . IntMap.alter f (fromNat k) . unNatMap
+
+lookup :: Nat -> NatMap a -> Maybe a
+lookup k = IntMap.lookup (fromNat k) . unNatMap
+
+member :: Nat -> NatMap a -> Bool
+member k = IntMap.member (fromNat k) . unNatMap
+
+null :: NatMap a -> Bool
+null = IntMap.null . unNatMap
+
+size :: NatMap a -> Nat
+size = toNat . IntMap.size . unNatMap