diff options
author | Tom Smeding <tom@tomsmeding.com> | 2024-04-14 10:31:46 +0200 |
---|---|---|
committer | Tom Smeding <tom@tomsmeding.com> | 2024-04-14 10:33:54 +0200 |
commit | 018ebecade82009a3410f19982dd435b6e0715d8 (patch) | |
tree | 286688dcba6963211705c135a032ddd82df4cf88 /src/Data/Nat.hs | |
parent | 3e74b0673caba7c04353c0cedb1d6e02de1fd007 (diff) |
Rename inductive naturals to INat
Diffstat (limited to 'src/Data/Nat.hs')
-rw-r--r-- | src/Data/Nat.hs | 87 |
1 files changed, 0 insertions, 87 deletions
diff --git a/src/Data/Nat.hs b/src/Data/Nat.hs deleted file mode 100644 index b154f67..0000000 --- a/src/Data/Nat.hs +++ /dev/null @@ -1,87 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE PolyKinds #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE UndecidableInstances #-} -{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-} -module Data.Nat where - -import Data.Proxy -import Numeric.Natural -import qualified GHC.TypeLits as G - - --- | Evidence for the constraint @c a@. -data Dict c a where - Dict :: c a => Dict c a - --- | A peano natural number. Intended to be used at the type level. -data Nat = Z | S Nat - deriving (Show) - --- | Singleton for a 'Nat'. -data SNat n where - SZ :: SNat Z - SS :: SNat n -> SNat (S n) -deriving instance Show (SNat n) - --- | A singleton 'SNat' corresponding to @n@. -class KnownNat n where knownNat :: SNat n -instance KnownNat Z where knownNat = SZ -instance KnownNat n => KnownNat (S n) where knownNat = SS knownNat - --- | Convert a 'Nat' to a normal number. -unNat :: Nat -> Natural -unNat Z = 0 -unNat (S n) = 1 + unNat n - --- | Convert an 'SNat' to a normal number. -unSNat :: SNat n -> Natural -unSNat SZ = 0 -unSNat (SS n) = 1 + unSNat n - --- | Convert an 'SNat' to an integer. -unSNat' :: SNat n -> Int -unSNat' = fromIntegral . unSNat - --- | A 'KnownNat' dictionary is just a singleton natural, so we can create --- evidence of 'KnownNat' given an 'SNat'. -snatKnown :: SNat n -> Dict KnownNat n -snatKnown SZ = Dict -snatKnown (SS n) | Dict <- snatKnown n = Dict - --- | Add two 'Nat's -type family n + m where - Z + m = m - S n + m = S (n + m) - --- | Convert a 'Nat' to a "GHC.TypeLits" 'G.Nat'. -type family GNat n where - GNat Z = 0 - GNat (S n) = 1 G.+ GNat n - --- | If an inductive 'Nat' is known, then the corresponding "GHC.TypeLits" --- 'G.Nat' is also known. -gknownNat :: KnownNat n => Proxy n -> Dict G.KnownNat (GNat n) -gknownNat (Proxy @n) = go (knownNat @n) - where - go :: SNat m -> Dict G.KnownNat (GNat m) - go SZ = Dict - go (SS n) | Dict <- go n = Dict - --- * Some type-level naturals - -type N0 = Z -type N1 = S N0 -type N2 = S N1 -type N3 = S N2 -type N4 = S N3 -type N5 = S N4 -type N6 = S N5 -type N7 = S N6 -type N8 = S N7 -type N9 = S N8 |