[Git][ghc/ghc][wip/T23478] Move definitions of SNat, SChar and SSymbol to ghc-internal
Oleg Grenrus (@phadej)
gitlab at gitlab.haskell.org
Wed Dec 6 17:39:38 UTC 2023
Oleg Grenrus pushed to branch wip/T23478 at Glasgow Haskell Compiler / GHC
Commits:
f0d4e2c7 by Oleg Grenrus at 2023-12-06T19:39:30+02:00
Move definitions of SNat, SChar and SSymbol to ghc-internal
... and expose their constructors there
- - - - -
5 changed files:
- libraries/base/src/GHC/TypeLits.hs
- libraries/base/src/GHC/TypeNats.hs
- libraries/ghc-internal/ghc-internal.cabal
- + libraries/ghc-internal/src/GHC/TypeLits/Internal.hs
- + libraries/ghc-internal/src/GHC/TypeNats/Internal.hs
Changes:
=====================================
libraries/base/src/GHC/TypeLits.hs
=====================================
@@ -12,11 +12,15 @@
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE GADTs #-}
+{-# LANGUAGE PackageImports #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE RoleAnnotations #-}
+-- orphan instances for SChar and SSymbol
+{-# OPTIONS_GHC -Wno-orphans #-}
+
{-|
GHC's @DataKinds@ language extension lifts data constructors, natural
numbers, and strings to the type level. This module provides the
@@ -69,7 +73,7 @@ module GHC.TypeLits
) where
-import GHC.Base ( Bool(..), Eq(..), Functor(..), Ord(..), Ordering(..), String
+import GHC.Base ( Eq(..), Functor(..), Ord(..), Ordering(..), String
, (.), otherwise, withDict, Void, (++)
, errorWithoutStackTrace)
import GHC.Types(Symbol, Char, TYPE)
@@ -90,6 +94,8 @@ import Unsafe.Coerce(unsafeCoerce)
import GHC.TypeLits.Internal(CmpSymbol, CmpChar)
import qualified GHC.TypeNats as N
+import "ghc-internal" GHC.TypeLits.Internal
+
--------------------------------------------------------------------------------
-- | This class gives the string associated with a type-level symbol.
@@ -325,24 +331,6 @@ withSomeSNat n k
| n >= 0 = N.withSomeSNat (fromInteger n) (\sn -> k (Just sn))
| otherwise = k Nothing
--- | A value-level witness for a type-level symbol. This is commonly referred
--- to as a /singleton/ type, as for each @s@, there is a single value that
--- inhabits the type @'SSymbol' s@ (aside from bottom).
---
--- The definition of 'SSymbol' is intentionally left abstract. To obtain an
--- 'SSymbol' value, use one of the following:
---
--- 1. The 'symbolSing' method of 'KnownSymbol'.
---
--- 2. The @SSymbol@ pattern synonym.
---
--- 3. The 'withSomeSSymbol' function, which creates an 'SSymbol' from a
--- 'String'.
---
--- @since 4.18.0.0
-newtype SSymbol (s :: Symbol) = UnsafeSSymbol String
-type role SSymbol nominal
-
-- | A explicitly bidirectional pattern synonym relating an 'SSymbol' to a
-- 'KnownSymbol' constraint.
--
@@ -377,14 +365,6 @@ data KnownSymbolInstance (s :: Symbol) where
knownSymbolInstance :: SSymbol s -> KnownSymbolInstance s
knownSymbolInstance ss = withKnownSymbol ss KnownSymbolInstance
--- | @since 4.19.0.0
-instance Eq (SSymbol s) where
- _ == _ = True
-
--- | @since 4.19.0.0
-instance Ord (SSymbol s) where
- compare _ _ = EQ
-
-- | @since 4.18.0.0
instance Show (SSymbol s) where
showsPrec p (UnsafeSSymbol s)
@@ -429,22 +409,7 @@ withSomeSSymbol s k = k (UnsafeSSymbol s)
-- For details see Note [NOINLINE withSomeSNat] in "GHC.TypeNats"
-- The issue described there applies to `withSomeSSymbol` as well.
--- | A value-level witness for a type-level character. This is commonly referred
--- to as a /singleton/ type, as for each @c@, there is a single value that
--- inhabits the type @'SChar' c@ (aside from bottom).
---
--- The definition of 'SChar' is intentionally left abstract. To obtain an
--- 'SChar' value, use one of the following:
---
--- 1. The 'charSing' method of 'KnownChar'.
---
--- 2. The @SChar@ pattern synonym.
---
--- 3. The 'withSomeSChar' function, which creates an 'SChar' from a 'Char'.
---
--- @since 4.18.0.0
-newtype SChar (s :: Char) = UnsafeSChar Char
-type role SChar nominal
+
-- | A explicitly bidirectional pattern synonym relating an 'SChar' to a
-- 'KnownChar' constraint.
@@ -480,14 +445,6 @@ data KnownCharInstance (n :: Char) where
knownCharInstance :: SChar c -> KnownCharInstance c
knownCharInstance sc = withKnownChar sc KnownCharInstance
--- | @since 4.19.0.0
-instance Eq (SChar c) where
- _ == _ = True
-
--- | @since 4.19.0.0
-instance Ord (SChar c) where
- compare _ _ = EQ
-
-- | @since 4.18.0.0
instance Show (SChar c) where
showsPrec p (UnsafeSChar c)
=====================================
libraries/base/src/GHC/TypeNats.hs
=====================================
@@ -14,10 +14,14 @@
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE GADTs #-}
+{-# LANGUAGE PackageImports #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE RoleAnnotations #-}
+-- orphan instances for SNat
+{-# OPTIONS_GHC -Wno-orphans #-}
+
{-| This module is an internal GHC module. It declares the constants used
in the implementation of type-level natural numbers. The programmer interface
for working with type-level naturals should be defined in a separate library.
@@ -67,6 +71,8 @@ import Unsafe.Coerce(unsafeCoerce)
import GHC.TypeNats.Internal(CmpNat)
+import "ghc-internal" GHC.TypeNats.Internal
+
-- | A type synonym for 'Natural'.
--
-- Previously, this was an opaque data type, but it was changed to a type
@@ -329,23 +335,7 @@ cmpNat x y = case compare (natVal x) (natVal y) of
--------------------------------------------------------------------------------
-- Singleton values
--- | A value-level witness for a type-level natural number. This is commonly
--- referred to as a /singleton/ type, as for each @n@, there is a single value
--- that inhabits the type @'SNat' n@ (aside from bottom).
---
--- The definition of 'SNat' is intentionally left abstract. To obtain an 'SNat'
--- value, use one of the following:
---
--- 1. The 'natSing' method of 'KnownNat'.
---
--- 2. The @SNat@ pattern synonym.
---
--- 3. The 'withSomeSNat' function, which creates an 'SNat' from a 'Natural'
--- number.
---
--- @since 4.18.0.0
-newtype SNat (n :: Nat) = UnsafeSNat Natural
-type role SNat nominal
+
-- | A explicitly bidirectional pattern synonym relating an 'SNat' to a
-- 'KnownNat' constraint.
@@ -381,14 +371,6 @@ data KnownNatInstance (n :: Nat) where
knownNatInstance :: SNat n -> KnownNatInstance n
knownNatInstance sn = withKnownNat sn KnownNatInstance
--- | @since 4.19.0.0
-instance Eq (SNat n) where
- _ == _ = True
-
--- | @since 4.19.0.0
-instance Ord (SNat n) where
- compare _ _ = EQ
-
-- | @since 4.18.0.0
instance Show (SNat n) where
showsPrec p (UnsafeSNat n)
=====================================
libraries/ghc-internal/ghc-internal.cabal
=====================================
@@ -23,9 +23,10 @@ common warnings
library
import: warnings
+
exposed-modules:
- other-modules: Dummy
- other-extensions:
+ GHC.TypeLits.Internal
+ GHC.TypeNats.Internal
build-depends: rts == 1.0.*,
ghc-prim >= 0.5.1.0 && < 0.11,
ghc-bignum >= 1.0 && < 2.0
=====================================
libraries/ghc-internal/src/GHC/TypeLits/Internal.hs
=====================================
@@ -0,0 +1,62 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE RoleAnnotations #-}
+module GHC.TypeLits.Internal (
+ SChar (..),
+ SSymbol (..),
+) where
+
+import GHC.Types (Char, Symbol, Bool (..), Ordering (..))
+import GHC.Classes (Eq (..), Ord (..))
+
+-- | A value-level witness for a type-level character. This is commonly referred
+-- to as a /singleton/ type, as for each @c@, there is a single value that
+-- inhabits the type @'SChar' c@ (aside from bottom).
+--
+-- The definition of 'SChar' is intentionally left abstract. To obtain an
+-- 'SChar' value, use one of the following:
+--
+-- 1. The 'charSing' method of 'KnownChar'.
+--
+-- 2. The @SChar@ pattern synonym.
+--
+-- 3. The 'withSomeSChar' function, which creates an 'SChar' from a 'Char'.
+--
+-- /since base-4.18.0.0/
+newtype SChar (s :: Char) = UnsafeSChar Char
+type role SChar nominal
+
+-- | /since base-4.19.0.0/
+instance Eq (SChar c) where
+ _ == _ = True
+
+-- | /since base-4.19.0.0/
+instance Ord (SChar c) where
+ compare _ _ = EQ
+
+-- | A value-level witness for a type-level symbol. This is commonly referred
+-- to as a /singleton/ type, as for each @s@, there is a single value that
+-- inhabits the type @'SSymbol' s@ (aside from bottom).
+--
+-- The definition of 'SSymbol' is intentionally left abstract. To obtain an
+-- 'SSymbol' value, use one of the following:
+--
+-- 1. The 'symbolSing' method of 'KnownSymbol'.
+--
+-- 2. The @SSymbol@ pattern synonym.
+--
+-- 3. The 'withSomeSSymbol' function, which creates an 'SSymbol' from a
+-- 'String'.
+--
+-- /since base-4.18.0.0/
+newtype SSymbol (s :: Symbol) = UnsafeSSymbol [Char]
+type role SSymbol nominal
+
+-- | /since base-4.19.0.0/
+instance Eq (SSymbol s) where
+ _ == _ = True
+
+-- | /since base-4.19.0.0/
+instance Ord (SSymbol s) where
+ compare _ _ = EQ
=====================================
libraries/ghc-internal/src/GHC/TypeNats/Internal.hs
=====================================
@@ -0,0 +1,38 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE RoleAnnotations #-}
+module GHC.TypeNats.Internal (
+ SNat (..),
+)where
+
+import GHC.Num.Natural(Natural)
+import GHC.Types (Bool (..), Ordering (..))
+import GHC.Classes (Eq (..), Ord (..))
+
+-- | A value-level witness for a type-level natural number. This is commonly
+-- referred to as a /singleton/ type, as for each @n@, there is a single value
+-- that inhabits the type @'SNat' n@ (aside from bottom).
+--
+-- The definition of 'SNat' is intentionally left abstract. To obtain an 'SNat'
+-- value, use one of the following:
+--
+-- 1. The 'natSing' method of 'KnownNat'.
+--
+-- 2. The @SNat@ pattern synonym.
+--
+-- 3. The 'withSomeSNat' function, which creates an 'SNat' from a 'Natural'
+-- number.
+--
+-- /since base-4.18.0.0/
+--
+newtype SNat (n :: Natural) = UnsafeSNat Natural
+type role SNat nominal
+
+-- | /since base-4.19.0.0/
+instance Eq (SNat n) where
+ _ == _ = True
+
+-- | /since 4.19.0.0/
+instance Ord (SNat n) where
+ compare _ _ = EQ
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f0d4e2c799840220559974e63b9f884e4bba9aa4
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f0d4e2c799840220559974e63b9f884e4bba9aa4
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20231206/fcff7f14/attachment-0001.html>
More information about the ghc-commits
mailing list