diff options
Diffstat (limited to 'src/Nats.hs')
-rw-r--r-- | src/Nats.hs | 54 |
1 files changed, 54 insertions, 0 deletions
diff --git a/src/Nats.hs b/src/Nats.hs new file mode 100644 index 0000000..a9ad47c --- /dev/null +++ b/src/Nats.hs @@ -0,0 +1,54 @@ +{-# 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 Nats where + +import Data.Proxy +import Numeric.Natural +import qualified GHC.TypeLits as G + + +data Dict c a where + Dict :: c a => Dict c a + +data Nat = Z | S Nat + deriving (Show) + +data SNat n where + SZ :: SNat Z + SS :: SNat n -> SNat (S n) +deriving instance Show (SNat n) + +class KnownNat n where knownNat :: SNat n +instance KnownNat Z where knownNat = SZ +instance KnownNat n => KnownNat (S n) where knownNat = SS knownNat + +unSNat :: SNat n -> Natural +unSNat SZ = 0 +unSNat (SS n) = 1 + unSNat n + +unNat :: Nat -> Natural +unNat Z = 0 +unNat (S n) = 1 + unNat n + +snatKnown :: SNat n -> Dict KnownNat n +snatKnown SZ = Dict +snatKnown (SS n) | Dict <- snatKnown n = Dict + +type family GNat n where + GNat Z = 0 + GNat (S n) = 1 G.+ GNat n + +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 |