naturals

natural numbers in Haskell
git clone git://git.rr3.xyz/naturals
Log | Files | Refs

commit 197dab3b229815a74a8098b672a1d2eb1a491806
parent db6d10b99f3a092cb6b2ddc16c0aa166bf5c083d
Author: Robert Russell <robert@rr3.xyz>
Date:   Sat,  5 Jul 2025 16:16:29 -0700

Hide unsafe constructors

Diffstat:
Msrc/Naturals/Finat.hs | 34++--------------------------------
Asrc/Naturals/Finat/Unsafe.hs | 35+++++++++++++++++++++++++++++++++++
Msrc/Naturals/Finatural.hs | 30++----------------------------
Asrc/Naturals/Finatural/Unsafe.hs | 31+++++++++++++++++++++++++++++++
Msrc/Naturals/Snat.hs | 32++------------------------------
Asrc/Naturals/Snat/Unsafe.hs | 33+++++++++++++++++++++++++++++++++
Msrc/Naturals/Snatural.hs | 27++-------------------------
Asrc/Naturals/Snatural/Unsafe.hs | 28++++++++++++++++++++++++++++
8 files changed, 135 insertions(+), 115 deletions(-)

diff --git a/src/Naturals/Finat.hs b/src/Naturals/Finat.hs @@ -1,35 +1,5 @@ module Naturals.Finat ( - Finat (..), - finatMirror, + module Naturals.Finat.Unsafe, ) where -import GHC.Natural -import Unsafe.Coerce - -import Naturals.IsFin -import Naturals.Nat -import Naturals.Natural -import Naturals.Peano -import Naturals.Snat - --- | Finite (@Peano@-indexed) prefixes of @Nat@. -newtype Finat (n :: Peano) = FinatUnsafe Nat deriving newtype (Show, Eq) - -instance ToNat (Finat n) where - toNat (FinatUnsafe n) = n - -instance ToNatural (Finat n) where - toNatural = wordToNatural . fromNat . toNat - -instance IsFin Finat where - finZero = FinatUnsafe 0 - - finSucc = FinatUnsafe . succ . toNat - - finPeel (FinatUnsafe 0) = unsafeCoerce FZeroOp - finPeel (FinatUnsafe n) = unsafeCoerce FSuccOp . FinatUnsafe . pred $ n - - finWeaken (FinatUnsafe n) = FinatUnsafe n - -finatMirror :: Snat n -> Finat n -> Finat n -finatMirror (SnatUnsafe n) (FinatUnsafe i) = FinatUnsafe (n - i - 1) +import Naturals.Finat.Unsafe hiding (FinatUnsafe) diff --git a/src/Naturals/Finat/Unsafe.hs b/src/Naturals/Finat/Unsafe.hs @@ -0,0 +1,35 @@ +module Naturals.Finat.Unsafe ( + Finat (..), + finatMirror, +) where + +import GHC.Natural +import Unsafe.Coerce + +import Naturals.IsFin +import Naturals.Nat +import Naturals.Natural +import Naturals.Peano +import Naturals.Snat.Unsafe + +-- | Finite (@Peano@-indexed) prefixes of @Nat@. +newtype Finat (n :: Peano) = FinatUnsafe Nat deriving newtype (Show, Eq) + +instance ToNat (Finat n) where + toNat (FinatUnsafe n) = n + +instance ToNatural (Finat n) where + toNatural = wordToNatural . fromNat . toNat + +instance IsFin Finat where + finZero = FinatUnsafe 0 + + finSucc = FinatUnsafe . succ . toNat + + finPeel (FinatUnsafe 0) = unsafeCoerce FZeroOp + finPeel (FinatUnsafe n) = unsafeCoerce FSuccOp . FinatUnsafe . pred $ n + + finWeaken (FinatUnsafe n) = FinatUnsafe n + +finatMirror :: Snat n -> Finat n -> Finat n +finatMirror (SnatUnsafe n) (FinatUnsafe i) = FinatUnsafe (n - i - 1) diff --git a/src/Naturals/Finatural.hs b/src/Naturals/Finatural.hs @@ -1,31 +1,5 @@ module Naturals.Finatural ( - Finatural (..), - finaturalMirror, + module Naturals.Finatural.Unsafe, ) where -import GHC.Natural -import Unsafe.Coerce - -import Naturals.IsFin -import Naturals.Natural -import Naturals.Peano -import Naturals.Snatural - --- | Finite (@Peano@-indexed) prefixes of @Natural@. -newtype Finatural (n :: Peano) = FinaturalUnsafe Natural deriving newtype (Show, Eq) - -instance ToNatural (Finatural n) where - toNatural (FinaturalUnsafe n) = n - -instance IsFin Finatural where - finZero = FinaturalUnsafe 0 - - finSucc = FinaturalUnsafe . succ . toNatural - - finPeel (FinaturalUnsafe 0) = unsafeCoerce FZeroOp - finPeel (FinaturalUnsafe n) = unsafeCoerce FSuccOp . FinaturalUnsafe . pred $ n - - finWeaken (FinaturalUnsafe n) = FinaturalUnsafe n - -finaturalMirror :: Snatural n -> Finatural n -> Finatural n -finaturalMirror (SnaturalUnsafe n) (FinaturalUnsafe i) = FinaturalUnsafe (n - i - 1) +import Naturals.Finatural.Unsafe hiding (FinaturalUnsafe) diff --git a/src/Naturals/Finatural/Unsafe.hs b/src/Naturals/Finatural/Unsafe.hs @@ -0,0 +1,31 @@ +module Naturals.Finatural.Unsafe ( + Finatural (..), + finaturalMirror, +) where + +import GHC.Natural +import Unsafe.Coerce + +import Naturals.IsFin +import Naturals.Natural +import Naturals.Peano +import Naturals.Snatural.Unsafe + +-- | Finite (@Peano@-indexed) prefixes of @Natural@. +newtype Finatural (n :: Peano) = FinaturalUnsafe Natural deriving newtype (Show, Eq) + +instance ToNatural (Finatural n) where + toNatural (FinaturalUnsafe n) = n + +instance IsFin Finatural where + finZero = FinaturalUnsafe 0 + + finSucc = FinaturalUnsafe . succ . toNatural + + finPeel (FinaturalUnsafe 0) = unsafeCoerce FZeroOp + finPeel (FinaturalUnsafe n) = unsafeCoerce FSuccOp . FinaturalUnsafe . pred $ n + + finWeaken (FinaturalUnsafe n) = FinaturalUnsafe n + +finaturalMirror :: Snatural n -> Finatural n -> Finatural n +finaturalMirror (SnaturalUnsafe n) (FinaturalUnsafe i) = FinaturalUnsafe (n - i - 1) diff --git a/src/Naturals/Snat.hs b/src/Naturals/Snat.hs @@ -1,33 +1,5 @@ module Naturals.Snat ( - Snat (..), + module Naturals.Snat.Unsafe, ) where -import GHC.Natural -import Unsafe.Coerce - -import Naturals.IsSpeano -import Naturals.Nat -import Naturals.Natural -import Naturals.Peano - --- | Singleton (@Peano@-indexed) natural numbers represented as a @Nat@. -newtype Snat (n :: Peano) = SnatUnsafe Nat deriving newtype (Show) - -instance Eq (Snat n) where - _ == _ = True - -instance ToNat (Snat n) where - toNat (SnatUnsafe n) = n - -instance ToNatural (Snat n) where - toNatural = wordToNatural . fromNat . toNat - -instance IsSpeano Snat where - speanoZero = SnatUnsafe 0 - - speanoSucc = SnatUnsafe . succ . toNat - - speanoPeel (SnatUnsafe 0) = unsafeCoerce ZeroOp - speanoPeel (SnatUnsafe n) = unsafeCoerce SuccOp . SnatUnsafe . pred $ n - - speanoAdd (SnatUnsafe m) (SnatUnsafe n) = SnatUnsafe (m + n) +import Naturals.Snat.Unsafe hiding (SnatUnsafe) diff --git a/src/Naturals/Snat/Unsafe.hs b/src/Naturals/Snat/Unsafe.hs @@ -0,0 +1,33 @@ +module Naturals.Snat.Unsafe ( + Snat (..), +) where + +import GHC.Natural +import Unsafe.Coerce + +import Naturals.IsSpeano +import Naturals.Nat +import Naturals.Natural +import Naturals.Peano + +-- | Singleton (@Peano@-indexed) natural numbers represented as a @Nat@. +newtype Snat (n :: Peano) = SnatUnsafe Nat deriving newtype (Show) + +instance Eq (Snat n) where + _ == _ = True + +instance ToNat (Snat n) where + toNat (SnatUnsafe n) = n + +instance ToNatural (Snat n) where + toNatural = wordToNatural . fromNat . toNat + +instance IsSpeano Snat where + speanoZero = SnatUnsafe 0 + + speanoSucc = SnatUnsafe . succ . toNat + + speanoPeel (SnatUnsafe 0) = unsafeCoerce ZeroOp + speanoPeel (SnatUnsafe n) = unsafeCoerce SuccOp . SnatUnsafe . pred $ n + + speanoAdd (SnatUnsafe m) (SnatUnsafe n) = SnatUnsafe (m + n) diff --git a/src/Naturals/Snatural.hs b/src/Naturals/Snatural.hs @@ -1,28 +1,5 @@ module Naturals.Snatural ( - Snatural (..), + module Naturals.Snatural.Unsafe, ) where -import Unsafe.Coerce - -import Naturals.IsSpeano -import Naturals.Natural -import Naturals.Peano - --- | Singleton (@Peano@-indexed) natural numbers represented as a @Natural@. -newtype Snatural (n :: Peano) = SnaturalUnsafe Natural deriving newtype (Show) - -instance Eq (Snatural n) where - _ == _ = True - -instance ToNatural (Snatural n) where - toNatural (SnaturalUnsafe n) = n - -instance IsSpeano Snatural where - speanoZero = SnaturalUnsafe 0 - - speanoSucc = SnaturalUnsafe . succ . toNatural - - speanoPeel (SnaturalUnsafe 0) = unsafeCoerce ZeroOp - speanoPeel (SnaturalUnsafe n) = unsafeCoerce SuccOp . SnaturalUnsafe . pred $ n - - speanoAdd (SnaturalUnsafe m) (SnaturalUnsafe n) = SnaturalUnsafe (m + n) +import Naturals.Snatural.Unsafe hiding (SnaturalUnsafe) diff --git a/src/Naturals/Snatural/Unsafe.hs b/src/Naturals/Snatural/Unsafe.hs @@ -0,0 +1,28 @@ +module Naturals.Snatural.Unsafe ( + Snatural (..), +) where + +import Unsafe.Coerce + +import Naturals.IsSpeano +import Naturals.Natural +import Naturals.Peano + +-- | Singleton (@Peano@-indexed) natural numbers represented as a @Natural@. +newtype Snatural (n :: Peano) = SnaturalUnsafe Natural deriving newtype (Show) + +instance Eq (Snatural n) where + _ == _ = True + +instance ToNatural (Snatural n) where + toNatural (SnaturalUnsafe n) = n + +instance IsSpeano Snatural where + speanoZero = SnaturalUnsafe 0 + + speanoSucc = SnaturalUnsafe . succ . toNatural + + speanoPeel (SnaturalUnsafe 0) = unsafeCoerce ZeroOp + speanoPeel (SnaturalUnsafe n) = unsafeCoerce SuccOp . SnaturalUnsafe . pred $ n + + speanoAdd (SnaturalUnsafe m) (SnaturalUnsafe n) = SnaturalUnsafe (m + n)