[Git][ghc/ghc][wip/ci-interface-stability] Don't use OccSet
Ben Gamari (@bgamari)
gitlab at gitlab.haskell.org
Tue May 16 11:59:03 UTC 2023
Ben Gamari pushed to branch wip/ci-interface-stability at Glasgow Haskell Compiler / GHC
Commits:
dc7ca88b by Ben Gamari at 2023-05-16T07:58:47-04:00
Don't use OccSet
OccSet appears not to behave as one would expect.
- - - - -
2 changed files:
- testsuite/tests/interface-stability/base-exports.stdout
- utils/dump-decls/Main.hs
Changes:
=====================================
testsuite/tests/interface-stability/base-exports.stdout
=====================================
@@ -19,7 +19,6 @@ module Control.Applicative where
(*>) :: forall a b. f a -> f b -> f b
(<*) :: forall a b. f a -> f b -> f a
{-# MINIMAL pure, ((<*>) | liftA2) #-}
- Const :: forall {k} a (b :: k). a -> Const a b
type role Const representational phantom
type Const :: forall {k}. * -> k -> *
newtype Const a b = Const {getConst :: a}
@@ -29,12 +28,9 @@ module Control.Applicative where
type role WrappedMonad representational nominal
type WrappedMonad :: (* -> *) -> * -> *
newtype WrappedMonad m a = WrapMonad {unwrapMonad :: m a}
- ZipList :: forall a. [a] -> ZipList a
type ZipList :: * -> *
newtype ZipList a = ZipList {getZipList :: [a]}
asum :: forall (t :: * -> *) (f :: * -> *) a. (Data.Foldable.Foldable t, Alternative f) => t (f a) -> f a
- getConst :: forall {k} a (b :: k). Const a b -> a
- getZipList :: forall a. ZipList a -> [a]
liftA :: forall (f :: * -> *) a b. Applicative f => (a -> b) -> f a -> f b
liftA3 :: forall (f :: * -> *) a b c d. Applicative f => (a -> b -> c -> d) -> f a -> f b -> f c -> f d
optional :: forall (f :: * -> *) a. Alternative f => f a -> f (GHC.Maybe.Maybe a)
@@ -68,7 +64,6 @@ module Control.Arrow where
class Arrow a => ArrowLoop a where
loop :: forall b d c. a (b, d) (c, d) -> a b c
{-# MINIMAL loop #-}
- ArrowMonad :: forall (a :: * -> * -> *) b. a () b -> ArrowMonad a b
type role ArrowMonad representational nominal
type ArrowMonad :: (* -> * -> *) -> * -> *
newtype ArrowMonad a b = ArrowMonad (a () b)
@@ -80,7 +75,6 @@ module Control.Arrow where
class Arrow a => ArrowZero a where
zeroArrow :: forall b c. a b c
{-# MINIMAL zeroArrow #-}
- Kleisli :: forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b
type role Kleisli representational representational nominal
type Kleisli :: (* -> *) -> * -> * -> *
newtype Kleisli m a b = Kleisli {runKleisli :: a -> m b}
@@ -88,7 +82,6 @@ module Control.Arrow where
(^>>) :: forall (a :: * -> * -> *) b c d. Arrow a => (b -> c) -> a c d -> a b d
leftApp :: forall (a :: * -> * -> *) b c d. ArrowApply a => a b c -> a (Data.Either.Either b d) (Data.Either.Either c d)
returnA :: forall (a :: * -> * -> *) b. Arrow a => a b b
- runKleisli :: forall (m :: * -> *) a b. Kleisli m a b -> a -> m b
module Control.Category where
-- Safety: Trustworthy
@@ -219,74 +212,56 @@ module Control.Concurrent.QSemN where
module Control.Exception where
-- Safety: Trustworthy
- AllocationLimitExceeded :: AllocationLimitExceeded
type AllocationLimitExceeded :: *
data AllocationLimitExceeded = AllocationLimitExceeded
type ArithException :: *
data ArithException = Overflow | Underflow | LossOfPrecision | DivideByZero | Denormal | RatioZeroDenominator
type ArrayException :: *
data ArrayException = IndexOutOfBounds GHC.Base.String | UndefinedElement GHC.Base.String
- AssertionFailed :: GHC.Base.String -> AssertionFailed
type AssertionFailed :: *
newtype AssertionFailed = AssertionFailed GHC.Base.String
type AsyncException :: *
data AsyncException = StackOverflow | HeapOverflow | ThreadKilled | UserInterrupt
- BlockedIndefinitelyOnMVar :: BlockedIndefinitelyOnMVar
type BlockedIndefinitelyOnMVar :: *
data BlockedIndefinitelyOnMVar = BlockedIndefinitelyOnMVar
- BlockedIndefinitelyOnSTM :: BlockedIndefinitelyOnSTM
type BlockedIndefinitelyOnSTM :: *
data BlockedIndefinitelyOnSTM = BlockedIndefinitelyOnSTM
- CompactionFailed :: GHC.Base.String -> CompactionFailed
type CompactionFailed :: *
newtype CompactionFailed = CompactionFailed GHC.Base.String
- Deadlock :: Deadlock
type Deadlock :: *
data Deadlock = Deadlock
pattern ErrorCall :: GHC.Base.String -> ErrorCall
type ErrorCall :: *
data ErrorCall = ErrorCallWithLocation GHC.Base.String GHC.Base.String
- ErrorCallWithLocation :: GHC.Base.String -> GHC.Base.String -> ErrorCall
type Exception :: * -> Constraint
class (base-4.18.0.0:Data.Typeable.Internal.Typeable e, GHC.Show.Show e) => Exception e where
toException :: e -> SomeException
fromException :: SomeException -> GHC.Maybe.Maybe e
displayException :: e -> GHC.Base.String
- Handler :: forall a e. Exception e => (e -> GHC.Types.IO a) -> Handler a
type Handler :: * -> *
data Handler a = forall e. Exception e => Handler (e -> GHC.Types.IO a)
type IOException :: *
data IOException = ...
type MaskingState :: *
data MaskingState = Unmasked | MaskedInterruptible | MaskedUninterruptible
- NestedAtomically :: NestedAtomically
type NestedAtomically :: *
data NestedAtomically = NestedAtomically
- NoMethodError :: GHC.Base.String -> NoMethodError
type NoMethodError :: *
newtype NoMethodError = NoMethodError GHC.Base.String
- NonTermination :: NonTermination
type NonTermination :: *
data NonTermination = NonTermination
- PatternMatchFail :: GHC.Base.String -> PatternMatchFail
type PatternMatchFail :: *
newtype PatternMatchFail = PatternMatchFail GHC.Base.String
- RecConError :: GHC.Base.String -> RecConError
type RecConError :: *
newtype RecConError = RecConError GHC.Base.String
- RecSelError :: GHC.Base.String -> RecSelError
type RecSelError :: *
newtype RecSelError = RecSelError GHC.Base.String
- RecUpdError :: GHC.Base.String -> RecUpdError
type RecUpdError :: *
newtype RecUpdError = RecUpdError GHC.Base.String
- SomeAsyncException :: forall e. Exception e => e -> SomeAsyncException
type SomeAsyncException :: *
data SomeAsyncException = forall e. Exception e => SomeAsyncException e
- SomeException :: forall e. Exception e => e -> SomeException
type SomeException :: *
data SomeException = forall e. Exception e => SomeException e
- TypeError :: GHC.Base.String -> TypeError
type TypeError :: *
newtype TypeError = TypeError GHC.Base.String
allowInterrupt :: GHC.Types.IO ()
@@ -320,77 +295,58 @@ module Control.Exception where
module Control.Exception.Base where
-- Safety: Trustworthy
- AllocationLimitExceeded :: AllocationLimitExceeded
type AllocationLimitExceeded :: *
data AllocationLimitExceeded = AllocationLimitExceeded
type ArithException :: *
data ArithException = Overflow | Underflow | LossOfPrecision | DivideByZero | Denormal | RatioZeroDenominator
type ArrayException :: *
data ArrayException = IndexOutOfBounds GHC.Base.String | UndefinedElement GHC.Base.String
- AssertionFailed :: GHC.Base.String -> AssertionFailed
type AssertionFailed :: *
newtype AssertionFailed = AssertionFailed GHC.Base.String
type AsyncException :: *
data AsyncException = StackOverflow | HeapOverflow | ThreadKilled | UserInterrupt
- BlockedIndefinitelyOnMVar :: BlockedIndefinitelyOnMVar
type BlockedIndefinitelyOnMVar :: *
data BlockedIndefinitelyOnMVar = BlockedIndefinitelyOnMVar
- BlockedIndefinitelyOnSTM :: BlockedIndefinitelyOnSTM
type BlockedIndefinitelyOnSTM :: *
data BlockedIndefinitelyOnSTM = BlockedIndefinitelyOnSTM
- CompactionFailed :: GHC.Base.String -> CompactionFailed
type CompactionFailed :: *
newtype CompactionFailed = CompactionFailed GHC.Base.String
- Deadlock :: Deadlock
type Deadlock :: *
data Deadlock = Deadlock
pattern ErrorCall :: GHC.Base.String -> ErrorCall
type ErrorCall :: *
data ErrorCall = ErrorCallWithLocation GHC.Base.String GHC.Base.String
- ErrorCallWithLocation :: GHC.Base.String -> GHC.Base.String -> ErrorCall
type Exception :: * -> Constraint
class (base-4.18.0.0:Data.Typeable.Internal.Typeable e, GHC.Show.Show e) => Exception e where
toException :: e -> SomeException
fromException :: SomeException -> GHC.Maybe.Maybe e
displayException :: e -> GHC.Base.String
- FixIOException :: FixIOException
type FixIOException :: *
data FixIOException = FixIOException
type IOException :: *
data IOException = ...
type MaskingState :: *
data MaskingState = Unmasked | MaskedInterruptible | MaskedUninterruptible
- NestedAtomically :: NestedAtomically
type NestedAtomically :: *
data NestedAtomically = NestedAtomically
- NoMatchingContinuationPrompt :: NoMatchingContinuationPrompt
type NoMatchingContinuationPrompt :: *
data NoMatchingContinuationPrompt = NoMatchingContinuationPrompt
- NoMethodError :: GHC.Base.String -> NoMethodError
type NoMethodError :: *
newtype NoMethodError = NoMethodError GHC.Base.String
- NonTermination :: NonTermination
type NonTermination :: *
data NonTermination = NonTermination
- PatternMatchFail :: GHC.Base.String -> PatternMatchFail
type PatternMatchFail :: *
newtype PatternMatchFail = PatternMatchFail GHC.Base.String
- RecConError :: GHC.Base.String -> RecConError
type RecConError :: *
newtype RecConError = RecConError GHC.Base.String
- RecSelError :: GHC.Base.String -> RecSelError
type RecSelError :: *
newtype RecSelError = RecSelError GHC.Base.String
- RecUpdError :: GHC.Base.String -> RecUpdError
type RecUpdError :: *
newtype RecUpdError = RecUpdError GHC.Base.String
- SomeAsyncException :: forall e. Exception e => e -> SomeAsyncException
type SomeAsyncException :: *
data SomeAsyncException = forall e. Exception e => SomeAsyncException e
- SomeException :: forall e. Exception e => e -> SomeException
type SomeException :: *
data SomeException = forall e. Exception e => SomeException e
- TypeError :: GHC.Base.String -> TypeError
type TypeError :: *
newtype TypeError = TypeError GHC.Base.String
assert :: forall a. GHC.Types.Bool -> a -> a
@@ -602,10 +558,8 @@ module Control.Monad.Zip where
module Data.Array.Byte where
-- Safety: Trustworthy
- ByteArray :: GHC.Prim.ByteArray# -> ByteArray
type ByteArray :: *
data ByteArray = ByteArray GHC.Prim.ByteArray#
- MutableByteArray :: forall s. GHC.Prim.MutableByteArray# s -> MutableByteArray s
type role MutableByteArray nominal
type MutableByteArray :: * -> *
data MutableByteArray s = MutableByteArray (GHC.Prim.MutableByteArray# s)
@@ -692,7 +646,6 @@ module Data.Bits where
(.<<.) :: forall a. Bits a => a -> GHC.Types.Int -> a
(.>>.) :: forall a. Bits a => a -> GHC.Types.Int -> a
(.^.) :: forall a. Bits a => a -> a -> a
- And :: forall a. a -> And a
type And :: * -> *
newtype And a = And {getAnd :: a}
type Bits :: * -> Constraint
@@ -726,20 +679,13 @@ module Data.Bits where
countLeadingZeros :: b -> GHC.Types.Int
countTrailingZeros :: b -> GHC.Types.Int
{-# MINIMAL finiteBitSize #-}
- Iff :: forall a. a -> Iff a
type Iff :: * -> *
newtype Iff a = Iff {getIff :: a}
- Ior :: forall a. a -> Ior a
type Ior :: * -> *
newtype Ior a = Ior {getIor :: a}
- Xor :: forall a. a -> Xor a
type Xor :: * -> *
newtype Xor a = Xor {getXor :: a}
bitDefault :: forall a. (Bits a, GHC.Num.Num a) => GHC.Types.Int -> a
- getAnd :: forall a. And a -> a
- getIff :: forall a. Iff a -> a
- getIor :: forall a. Ior a -> a
- getXor :: forall a. Xor a -> a
oneBits :: forall a. FiniteBits a => a
popCountDefault :: forall a. (Bits a, GHC.Num.Num a) => a -> GHC.Types.Int
testBitDefault :: forall a. (Bits a, GHC.Num.Num a) => a -> GHC.Types.Int -> GHC.Types.Bool
@@ -854,7 +800,6 @@ module Data.Data where
data DataType = ...
type Fixity :: *
data Fixity = Prefix | Infix
- Proxy :: forall {k} (t :: k). Proxy t
type role Proxy phantom
type Proxy :: forall {k}. k -> *
data Proxy t = Proxy
@@ -930,7 +875,6 @@ module Data.Data where
module Data.Dynamic where
-- Safety: Trustworthy
- Dynamic :: forall a. base-4.18.0.0:Data.Typeable.Internal.TypeRep a -> a -> Dynamic
type Dynamic :: *
data Dynamic where
Dynamic :: forall a. base-4.18.0.0:Data.Typeable.Internal.TypeRep a -> a -> Dynamic
@@ -1178,26 +1122,21 @@ module Data.Functor.Classes where
module Data.Functor.Compose where
-- Safety: Trustworthy
- Compose :: forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1). f (g a) -> Compose f g a
type role Compose representational nominal nominal
type Compose :: forall {k} {k1}. (k -> *) -> (k1 -> k) -> k1 -> *
newtype Compose f g a = Compose {getCompose :: f (g a)}
- getCompose :: forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2). Compose f g a -> f (g a)
module Data.Functor.Const where
-- Safety: Trustworthy
- Const :: forall {k} a (b :: k). a -> Const a b
type role Const representational phantom
type Const :: forall {k}. * -> k -> *
newtype Const a b = Const {getConst :: a}
- getConst :: forall {k} a (b :: k). Const a b -> a
module Data.Functor.Contravariant where
-- Safety: Trustworthy
($<) :: forall (f :: * -> *) b a. Contravariant f => f b -> b -> f a
(>$$<) :: forall (f :: * -> *) b a. Contravariant f => f b -> (a -> b) -> f a
(>$<) :: forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
- Comparison :: forall a. (a -> a -> GHC.Types.Ordering) -> Comparison a
type Comparison :: * -> *
newtype Comparison a = Comparison {getComparison :: a -> a -> GHC.Types.Ordering}
type Contravariant :: (* -> *) -> Constraint
@@ -1205,30 +1144,21 @@ module Data.Functor.Contravariant where
contramap :: forall a' a. (a' -> a) -> f a -> f a'
(>$) :: forall b a. b -> f b -> f a
{-# MINIMAL contramap #-}
- Equivalence :: forall a. (a -> a -> GHC.Types.Bool) -> Equivalence a
type Equivalence :: * -> *
newtype Equivalence a = Equivalence {getEquivalence :: a -> a -> GHC.Types.Bool}
- Op :: forall a b. (b -> a) -> Op a b
type Op :: * -> * -> *
newtype Op a b = Op {getOp :: b -> a}
- Predicate :: forall a. (a -> GHC.Types.Bool) -> Predicate a
type Predicate :: * -> *
newtype Predicate a = Predicate {getPredicate :: a -> GHC.Types.Bool}
comparisonEquivalence :: forall a. Comparison a -> Equivalence a
defaultComparison :: forall a. GHC.Classes.Ord a => Comparison a
defaultEquivalence :: forall a. GHC.Classes.Eq a => Equivalence a
- getComparison :: forall a. Comparison a -> a -> a -> GHC.Types.Ordering
- getEquivalence :: forall a. Equivalence a -> a -> a -> GHC.Types.Bool
- getOp :: forall a b. Op a b -> b -> a
- getPredicate :: forall a. Predicate a -> a -> GHC.Types.Bool
phantom :: forall (f :: * -> *) a b. (GHC.Base.Functor f, Contravariant f) => f a -> f b
module Data.Functor.Identity where
-- Safety: Trustworthy
- Identity :: forall a. a -> Identity a
type Identity :: * -> *
newtype Identity a = Identity {runIdentity :: a}
- runIdentity :: forall a. Identity a -> a
module Data.Functor.Product where
-- Safety: Safe
@@ -1497,30 +1427,22 @@ module Data.Maybe where
module Data.Monoid where
-- Safety: Trustworthy
(<>) :: forall a. GHC.Base.Semigroup a => a -> a -> a
- All :: GHC.Types.Bool -> All
type All :: *
newtype All = All {getAll :: GHC.Types.Bool}
- Alt :: forall {k} (f :: k -> *) (a :: k). f a -> Alt f a
type role Alt representational nominal
type Alt :: forall {k}. (k -> *) -> k -> *
newtype Alt f a = Alt {getAlt :: f a}
- Any :: GHC.Types.Bool -> Any
type Any :: *
newtype Any = Any {getAny :: GHC.Types.Bool}
- Ap :: forall {k} (f :: k -> *) (a :: k). f a -> Ap f a
type role Ap representational nominal
type Ap :: forall {k}. (k -> *) -> k -> *
newtype Ap f a = Ap {getAp :: f a}
- Dual :: forall a. a -> Dual a
type Dual :: * -> *
newtype Dual a = Dual {getDual :: a}
- Endo :: forall a. (a -> a) -> Endo a
type Endo :: * -> *
newtype Endo a = Endo {appEndo :: a -> a}
- First :: forall a. GHC.Maybe.Maybe a -> First a
type First :: * -> *
newtype First a = First {getFirst :: GHC.Maybe.Maybe a}
- Last :: forall a. GHC.Maybe.Maybe a -> Last a
type Last :: * -> *
newtype Last a = Last {getLast :: GHC.Maybe.Maybe a}
type Monoid :: * -> Constraint
@@ -1529,26 +1451,13 @@ module Data.Monoid where
mappend :: a -> a -> a
mconcat :: [a] -> a
{-# MINIMAL mempty | mconcat #-}
- Product :: forall a. a -> Product a
type Product :: * -> *
newtype Product a = Product {getProduct :: a}
- Sum :: forall a. a -> Sum a
type Sum :: * -> *
newtype Sum a = Sum {getSum :: a}
- appEndo :: forall a. Endo a -> a -> a
- getAll :: All -> GHC.Types.Bool
- getAlt :: forall {k} (f :: k -> *) (a :: k). Alt f a -> f a
- getAny :: Any -> GHC.Types.Bool
- getAp :: forall {k} (f :: k -> *) (a :: k). Ap f a -> f a
- getDual :: forall a. Dual a -> a
- getFirst :: forall a. First a -> GHC.Maybe.Maybe a
- getLast :: forall a. Last a -> GHC.Maybe.Maybe a
- getProduct :: forall a. Product a -> a
- getSum :: forall a. Sum a -> a
module Data.Ord where
-- Safety: Trustworthy
- Down :: forall a. a -> Down a
type Down :: * -> *
newtype Down a = Down {getDown :: a}
type Ord :: * -> Constraint
@@ -1565,15 +1474,12 @@ module Data.Ord where
data Ordering = LT | EQ | GT
clamp :: forall a. Ord a => (a, a) -> a -> a
comparing :: forall a b. Ord a => (b -> a) -> b -> b -> Ordering
- getDown :: forall a. Down a -> a
module Data.Proxy where
-- Safety: Trustworthy
- KProxy :: forall t. KProxy t
type role KProxy phantom
type KProxy :: * -> *
data KProxy t = KProxy
- Proxy :: forall {k} (t :: k). Proxy t
type role Proxy phantom
type Proxy :: forall {k}. k -> *
data Proxy t = Proxy
@@ -1624,38 +1530,28 @@ module Data.STRef.Strict where
module Data.Semigroup where
-- Safety: Trustworthy
- All :: GHC.Types.Bool -> All
type All :: *
newtype All = All {getAll :: GHC.Types.Bool}
- Any :: GHC.Types.Bool -> Any
type Any :: *
newtype Any = Any {getAny :: GHC.Types.Bool}
- Arg :: forall a b. a -> b -> Arg a b
type Arg :: * -> * -> *
data Arg a b = Arg a b
type ArgMax :: * -> * -> *
type ArgMax a b = Max (Arg a b)
type ArgMin :: * -> * -> *
type ArgMin a b = Min (Arg a b)
- Dual :: forall a. a -> Dual a
type Dual :: * -> *
newtype Dual a = Dual {getDual :: a}
- Endo :: forall a. (a -> a) -> Endo a
type Endo :: * -> *
newtype Endo a = Endo {appEndo :: a -> a}
- First :: forall a. a -> First a
type First :: * -> *
newtype First a = First {getFirst :: a}
- Last :: forall a. a -> Last a
type Last :: * -> *
newtype Last a = Last {getLast :: a}
- Max :: forall a. a -> Max a
type Max :: * -> *
newtype Max a = Max {getMax :: a}
- Min :: forall a. a -> Min a
type Min :: * -> *
newtype Min a = Min {getMin :: a}
- Product :: forall a. a -> Product a
type Product :: * -> *
newtype Product a = Product {getProduct :: a}
type Semigroup :: * -> Constraint
@@ -1664,23 +1560,12 @@ module Data.Semigroup where
sconcat :: GHC.Base.NonEmpty a -> a
stimes :: forall b. GHC.Real.Integral b => b -> a -> a
{-# MINIMAL (<>) | sconcat #-}
- Sum :: forall a. a -> Sum a
type Sum :: * -> *
newtype Sum a = Sum {getSum :: a}
type WrappedMonoid :: * -> *
newtype WrappedMonoid m = WrapMonoid {unwrapMonoid :: m}
- appEndo :: forall a. Endo a -> a -> a
cycle1 :: forall m. Semigroup m => m -> m
diff :: forall m. Semigroup m => m -> Endo m
- getAll :: All -> GHC.Types.Bool
- getAny :: Any -> GHC.Types.Bool
- getDual :: forall a. Dual a -> a
- getFirst :: forall a. First a -> a
- getLast :: forall a. Last a -> a
- getMax :: forall a. Max a -> a
- getMin :: forall a. Min a -> a
- getProduct :: forall a. Product a -> a
- getSum :: forall a. Sum a -> a
mtimesDefault :: forall b a. (GHC.Real.Integral b, GHC.Base.Monoid a) => b -> a -> a
stimesIdempotent :: forall b a. GHC.Real.Integral b => b -> a -> a
stimesIdempotentMonoid :: forall b a. (GHC.Real.Integral b, GHC.Base.Monoid a) => b -> a -> a
@@ -1719,7 +1604,6 @@ module Data.Traversable where
module Data.Tuple where
-- Safety: Trustworthy
- MkSolo :: forall a. a -> Solo a
pattern Solo :: forall a. a -> Solo a
type Solo :: * -> *
data Solo a = MkSolo a
@@ -1757,7 +1641,6 @@ module Data.Type.Bool where
module Data.Type.Coercion where
-- Safety: None
- Coercion :: forall {k} (a :: k) (b :: k). Coercible a b => Coercion a b
type Coercion :: forall {k}. k -> k -> *
data Coercion a b where
Coercion :: forall {k} (a :: k) (b :: k). Coercible a b => Coercion a b
@@ -1848,7 +1731,6 @@ module Data.Typeable where
type (:~~:) :: forall k1 k2. k1 -> k2 -> *
data (:~~:) a b where
HRefl :: forall {k1} (a :: k1). (:~~:) a a
- Proxy :: forall {k} (t :: k). Proxy t
type role Proxy phantom
type Proxy :: forall {k}. k -> *
data Proxy t = Proxy
@@ -1901,14 +1783,11 @@ module Data.Unique where
module Data.Version where
-- Safety: Safe
- Version :: [GHC.Types.Int] -> [GHC.Base.String] -> Version
type Version :: *
data Version = Version {versionBranch :: [GHC.Types.Int], versionTags :: [GHC.Base.String]}
makeVersion :: [GHC.Types.Int] -> Version
parseVersion :: Text.ParserCombinators.ReadP.ReadP Version
showVersion :: Version -> GHC.Base.String
- versionBranch :: Version -> [GHC.Types.Int]
- versionTags :: Version -> [GHC.Base.String]
module Data.Void where
-- Safety: Trustworthy
@@ -1964,7 +1843,6 @@ module Foreign where
(.<<.) :: forall a. Bits a => a -> Int -> a
(.>>.) :: forall a. Bits a => a -> Int -> a
(.^.) :: forall a. Bits a => a -> a -> a
- And :: forall a. a -> And a
type And :: * -> *
newtype And a = And {getAnd :: a}
type Bits :: * -> Constraint
@@ -2008,7 +1886,6 @@ module Foreign where
type role FunPtr phantom
type FunPtr :: * -> *
data FunPtr a = ...
- Iff :: forall a. a -> Iff a
type Iff :: * -> *
newtype Iff a = Iff {getIff :: a}
type Int :: *
@@ -2021,10 +1898,8 @@ module Foreign where
data Int64 = ...
type Int8 :: *
data Int8 = ...
- IntPtr :: Int -> IntPtr
type IntPtr :: *
newtype IntPtr = IntPtr Int
- Ior :: forall a. a -> Ior a
type Ior :: * -> *
newtype Ior a = Ior {getIor :: a}
type Pool :: *
@@ -2055,10 +1930,8 @@ module Foreign where
data Word64 = ...
type Word8 :: *
data Word8 = ...
- WordPtr :: Word -> WordPtr
type WordPtr :: *
newtype WordPtr = WordPtr Word
- Xor :: forall a. a -> Xor a
type Xor :: * -> *
newtype Xor a = Xor {getXor :: a}
addForeignPtrFinalizer :: forall a. FinalizerPtr a -> ForeignPtr a -> GHC.Types.IO ()
@@ -2100,10 +1973,6 @@ module Foreign where
freePool :: Pool -> GHC.Types.IO ()
freeStablePtr :: forall a. StablePtr a -> GHC.Types.IO ()
fromBool :: forall a. GHC.Num.Num a => GHC.Types.Bool -> a
- getAnd :: forall a. And a -> a
- getIff :: forall a. Iff a -> a
- getIor :: forall a. Ior a -> a
- getXor :: forall a. Xor a -> a
intPtrToPtr :: forall a. IntPtr -> Ptr a
lengthArray0 :: forall a. (Storable a, GHC.Classes.Eq a) => a -> Ptr a -> GHC.Types.IO Int
malloc :: forall a. Storable a => GHC.Types.IO (Ptr a)
@@ -2177,99 +2046,72 @@ module Foreign where
module Foreign.C where
-- Safety: Safe
- CBool :: GHC.Word.Word8 -> CBool
type CBool :: *
newtype CBool = CBool GHC.Word.Word8
- CChar :: GHC.Int.Int8 -> CChar
type CChar :: *
newtype CChar = CChar GHC.Int.Int8
- CClock :: GHC.Int.Int64 -> CClock
type CClock :: *
newtype CClock = CClock GHC.Int.Int64
- CDouble :: GHC.Types.Double -> CDouble
type CDouble :: *
newtype CDouble = CDouble GHC.Types.Double
type CFile :: *
data CFile = ...
- CFloat :: GHC.Types.Float -> CFloat
type CFloat :: *
newtype CFloat = CFloat GHC.Types.Float
type CFpos :: *
data CFpos = ...
- CInt :: GHC.Int.Int32 -> CInt
type CInt :: *
newtype CInt = CInt GHC.Int.Int32
- CIntMax :: GHC.Int.Int64 -> CIntMax
type CIntMax :: *
newtype CIntMax = CIntMax GHC.Int.Int64
- CIntPtr :: GHC.Int.Int64 -> CIntPtr
type CIntPtr :: *
newtype CIntPtr = CIntPtr GHC.Int.Int64
type CJmpBuf :: *
data CJmpBuf = ...
- CLLong :: GHC.Int.Int64 -> CLLong
type CLLong :: *
newtype CLLong = CLLong GHC.Int.Int64
- CLong :: GHC.Int.Int64 -> CLong
type CLong :: *
newtype CLong = CLong GHC.Int.Int64
- CPtrdiff :: GHC.Int.Int64 -> CPtrdiff
type CPtrdiff :: *
newtype CPtrdiff = CPtrdiff GHC.Int.Int64
- CSChar :: GHC.Int.Int8 -> CSChar
type CSChar :: *
newtype CSChar = CSChar GHC.Int.Int8
- CSUSeconds :: GHC.Int.Int64 -> CSUSeconds
type CSUSeconds :: *
newtype CSUSeconds = CSUSeconds GHC.Int.Int64
- CShort :: GHC.Int.Int16 -> CShort
type CShort :: *
newtype CShort = CShort GHC.Int.Int16
- CSigAtomic :: GHC.Int.Int32 -> CSigAtomic
type CSigAtomic :: *
newtype CSigAtomic = CSigAtomic GHC.Int.Int32
- CSize :: GHC.Word.Word64 -> CSize
type CSize :: *
newtype CSize = CSize GHC.Word.Word64
type CString :: *
type CString = GHC.Ptr.Ptr CChar
type CStringLen :: *
type CStringLen = (GHC.Ptr.Ptr CChar, GHC.Types.Int)
- CTime :: GHC.Int.Int64 -> CTime
type CTime :: *
newtype CTime = CTime GHC.Int.Int64
- CUChar :: GHC.Word.Word8 -> CUChar
type CUChar :: *
newtype CUChar = CUChar GHC.Word.Word8
- CUInt :: GHC.Word.Word32 -> CUInt
type CUInt :: *
newtype CUInt = CUInt GHC.Word.Word32
- CUIntMax :: GHC.Word.Word64 -> CUIntMax
type CUIntMax :: *
newtype CUIntMax = CUIntMax GHC.Word.Word64
- CUIntPtr :: GHC.Word.Word64 -> CUIntPtr
type CUIntPtr :: *
newtype CUIntPtr = CUIntPtr GHC.Word.Word64
- CULLong :: GHC.Word.Word64 -> CULLong
type CULLong :: *
newtype CULLong = CULLong GHC.Word.Word64
- CULong :: GHC.Word.Word64 -> CULong
type CULong :: *
newtype CULong = CULong GHC.Word.Word64
- CUSeconds :: GHC.Word.Word32 -> CUSeconds
type CUSeconds :: *
newtype CUSeconds = CUSeconds GHC.Word.Word32
- CUShort :: GHC.Word.Word16 -> CUShort
type CUShort :: *
newtype CUShort = CUShort GHC.Word.Word16
type CWString :: *
type CWString = GHC.Ptr.Ptr CWchar
type CWStringLen :: *
type CWStringLen = (GHC.Ptr.Ptr CWchar, GHC.Types.Int)
- CWchar :: GHC.Int.Int32 -> CWchar
type CWchar :: *
newtype CWchar = CWchar GHC.Int.Int32
- Errno :: CInt -> Errno
type Errno :: *
newtype Errno = Errno CInt
castCCharToChar :: CChar -> GHC.Types.Char
@@ -2426,15 +2268,12 @@ module Foreign.C where
module Foreign.C.ConstPtr where
-- Safety: Trustworthy
- ConstPtr :: forall a. GHC.Ptr.Ptr a -> ConstPtr a
type role ConstPtr phantom
type ConstPtr :: * -> *
newtype ConstPtr a = ConstPtr {unConstPtr :: GHC.Ptr.Ptr a}
- unConstPtr :: forall a. ConstPtr a -> GHC.Ptr.Ptr a
module Foreign.C.Error where
-- Safety: Trustworthy
- Errno :: Foreign.C.Types.CInt -> Errno
type Errno :: *
newtype Errno = Errno Foreign.C.Types.CInt
e2BIG :: Errno
@@ -2889,13 +2728,11 @@ module Foreign.Ptr where
type role FunPtr phantom
type FunPtr :: * -> *
data FunPtr a = ...
- IntPtr :: GHC.Types.Int -> IntPtr
type IntPtr :: *
newtype IntPtr = IntPtr GHC.Types.Int
type role Ptr phantom
type Ptr :: * -> *
data Ptr a = ...
- WordPtr :: GHC.Types.Word -> WordPtr
type WordPtr :: *
newtype WordPtr = WordPtr GHC.Types.Word
alignPtr :: forall a. Ptr a -> GHC.Types.Int -> Ptr a
@@ -2920,7 +2757,6 @@ module Foreign.Safe where
(.<<.) :: forall a. Bits a => a -> Int -> a
(.>>.) :: forall a. Bits a => a -> Int -> a
(.^.) :: forall a. Bits a => a -> a -> a
- And :: forall a. a -> And a
type And :: * -> *
newtype And a = And {getAnd :: a}
type Bits :: * -> Constraint
@@ -2964,7 +2800,6 @@ module Foreign.Safe where
type role FunPtr phantom
type FunPtr :: * -> *
data FunPtr a = ...
- Iff :: forall a. a -> Iff a
type Iff :: * -> *
newtype Iff a = Iff {getIff :: a}
type Int :: *
@@ -2977,10 +2812,8 @@ module Foreign.Safe where
data Int64 = ...
type Int8 :: *
data Int8 = ...
- IntPtr :: Int -> IntPtr
type IntPtr :: *
newtype IntPtr = IntPtr Int
- Ior :: forall a. a -> Ior a
type Ior :: * -> *
newtype Ior a = Ior {getIor :: a}
type Pool :: *
@@ -3011,10 +2844,8 @@ module Foreign.Safe where
data Word64 = ...
type Word8 :: *
data Word8 = ...
- WordPtr :: Word -> WordPtr
type WordPtr :: *
newtype WordPtr = WordPtr Word
- Xor :: forall a. a -> Xor a
type Xor :: * -> *
newtype Xor a = Xor {getXor :: a}
addForeignPtrFinalizer :: forall a. FinalizerPtr a -> ForeignPtr a -> GHC.Types.IO ()
@@ -3056,10 +2887,6 @@ module Foreign.Safe where
freePool :: Pool -> GHC.Types.IO ()
freeStablePtr :: forall a. StablePtr a -> GHC.Types.IO ()
fromBool :: forall a. GHC.Num.Num a => GHC.Types.Bool -> a
- getAnd :: forall a. And a -> a
- getIff :: forall a. Iff a -> a
- getIor :: forall a. Ior a -> a
- getXor :: forall a. Xor a -> a
intPtrToPtr :: forall a. IntPtr -> Ptr a
lengthArray0 :: forall a. (Storable a, GHC.Classes.Eq a) => a -> Ptr a -> GHC.Types.IO Int
malloc :: forall a. Storable a => GHC.Types.IO (Ptr a)
@@ -3159,7 +2986,6 @@ module GHC.Arr where
-- Safety: Unsafe
(!) :: forall i e. Ix i => Array i e -> i -> e
(//) :: forall i e. Ix i => Array i e -> [(i, e)] -> Array i e
- Array :: forall i e. i -> i -> GHC.Types.Int -> GHC.Prim.Array# e -> Array i e
type role Array nominal representational
type Array :: * -> * -> *
data Array i e = Array !i !i {-# UNPACK #-}GHC.Types.Int (GHC.Prim.Array# e)
@@ -3172,7 +2998,6 @@ module GHC.Arr where
rangeSize :: (a, a) -> GHC.Types.Int
unsafeRangeSize :: (a, a) -> GHC.Types.Int
{-# MINIMAL range, (index | unsafeIndex), inRange #-}
- STArray :: forall s i e. i -> i -> GHC.Types.Int -> GHC.Prim.MutableArray# s e -> STArray s i e
type role STArray nominal nominal representational
type STArray :: * -> * -> * -> *
data STArray s i e = STArray !i !i {-# UNPACK #-}GHC.Types.Int (GHC.Prim.MutableArray# s e)
@@ -3226,10 +3051,8 @@ module GHC.Arr where
module GHC.ArrayArray where
-- Safety: Trustworthy
- ArrayArray# :: GHC.Prim.Array# GHC.Prim.ByteArray# -> ArrayArray#
type ArrayArray# :: GHC.Types.UnliftedType
newtype ArrayArray# = ArrayArray# (GHC.Prim.Array# GHC.Prim.ByteArray#)
- MutableArrayArray# :: forall s. GHC.Prim.MutableArray# s GHC.Prim.ByteArray# -> MutableArrayArray# s
type role MutableArrayArray# nominal
type MutableArrayArray# :: * -> GHC.Types.UnliftedType
newtype MutableArrayArray# s = MutableArrayArray# (GHC.Prim.MutableArray# s GHC.Prim.ByteArray#)
@@ -3361,7 +3184,6 @@ module GHC.Base where
fmap :: forall a b. (a -> b) -> f a -> f b
(<$) :: forall a b. a -> f b -> f a
{-# MINIMAL fmap #-}
- IO :: forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
type IO :: * -> *
newtype IO a = IO (State# RealWorld -> (# State# RealWorld, a #))
type role IOPort# nominal representational
@@ -3424,7 +3246,6 @@ module GHC.Base where
data MVar# a b
type Maybe :: * -> *
data Maybe a = Nothing | Just a
- Module :: TrName -> TrName -> Module
type Module :: *
data Module = Module TrName TrName
type Monad :: (* -> *) -> Constraint
@@ -3485,10 +3306,8 @@ module GHC.Base where
data RealWorld
type RuntimeRep :: *
data RuntimeRep = VecRep VecCount VecElem | TupleRep [RuntimeRep] | SumRep [RuntimeRep] | BoxedRep Levity | IntRep | Int8Rep | Int16Rep | Int32Rep | Int64Rep | WordRep | Word8Rep | Word16Rep | Word32Rep | Word64Rep | AddrRep | FloatRep | DoubleRep
- SPEC :: SPEC
type SPEC :: *
data SPEC = SPEC | SPEC2
- SPEC2 :: SPEC
type Semigroup :: * -> Constraint
class Semigroup a where
(<>) :: a -> a -> a
@@ -3524,7 +3343,6 @@ module GHC.Base where
data ThreadId#
type TrName :: *
data TrName = TrNameS Addr# | TrNameD [Char]
- TyCon :: Word64# -> Word64# -> Module -> TrName -> Int# -> KindRep -> TyCon
type TyCon :: *
data TyCon = TyCon Word64# Word64# Module TrName Int# KindRep
type Type :: *
@@ -5090,15 +4908,12 @@ module GHC.Conc where
type HandlerFun = GHC.ForeignPtr.ForeignPtr GHC.Word.Word8 -> GHC.Types.IO ()
type PrimMVar :: *
data PrimMVar
- STM :: forall a. (GHC.Prim.State# GHC.Prim.RealWorld -> (# GHC.Prim.State# GHC.Prim.RealWorld, a #)) -> STM a
type STM :: * -> *
newtype STM a = STM (GHC.Prim.State# GHC.Prim.RealWorld -> (# GHC.Prim.State# GHC.Prim.RealWorld, a #))
type Signal :: *
type Signal = Foreign.C.Types.CInt
- TVar :: forall a. GHC.Prim.TVar# GHC.Prim.RealWorld a -> TVar a
type TVar :: * -> *
data TVar a = TVar (GHC.Prim.TVar# GHC.Prim.RealWorld a)
- ThreadId :: GHC.Prim.ThreadId# -> ThreadId
type ThreadId :: *
data ThreadId = ThreadId GHC.Prim.ThreadId#
type ThreadStatus :: *
@@ -5180,13 +4995,10 @@ module GHC.Conc.Sync where
data BlockReason = BlockedOnMVar | BlockedOnBlackHole | BlockedOnException | BlockedOnSTM | BlockedOnForeignCall | BlockedOnOther
type PrimMVar :: *
data PrimMVar
- STM :: forall a. (GHC.Prim.State# GHC.Prim.RealWorld -> (# GHC.Prim.State# GHC.Prim.RealWorld, a #)) -> STM a
type STM :: * -> *
newtype STM a = STM (GHC.Prim.State# GHC.Prim.RealWorld -> (# GHC.Prim.State# GHC.Prim.RealWorld, a #))
- TVar :: forall a. GHC.Prim.TVar# GHC.Prim.RealWorld a -> TVar a
type TVar :: * -> *
data TVar a = TVar (GHC.Prim.TVar# GHC.Prim.RealWorld a)
- ThreadId :: GHC.Prim.ThreadId# -> ThreadId
type ThreadId :: *
data ThreadId = ThreadId GHC.Prim.ThreadId#
type ThreadStatus :: *
@@ -5251,7 +5063,6 @@ module GHC.Constants where
module GHC.Desugar where
-- Safety: Trustworthy
(>>>) :: forall (arr :: * -> * -> *) a b c. Control.Arrow.Arrow arr => arr a b -> arr b c -> arr a c
- AnnotationWrapper :: forall a. Data.Data.Data a => a -> AnnotationWrapper
type AnnotationWrapper :: *
data AnnotationWrapper = forall a. Data.Data.Data a => AnnotationWrapper a
toAnnotationWrapper :: forall a. Data.Data.Data a => a -> AnnotationWrapper
@@ -5359,16 +5170,13 @@ module GHC.Exception where
pattern ErrorCall :: GHC.Base.String -> ErrorCall
type ErrorCall :: *
data ErrorCall = ErrorCallWithLocation GHC.Base.String GHC.Base.String
- ErrorCallWithLocation :: GHC.Base.String -> GHC.Base.String -> ErrorCall
type Exception :: * -> Constraint
class (base-4.18.0.0:Data.Typeable.Internal.Typeable e, GHC.Show.Show e) => Exception e where
toException :: e -> SomeException
fromException :: SomeException -> GHC.Maybe.Maybe e
displayException :: e -> GHC.Base.String
- SomeException :: forall e. Exception e => e -> SomeException
type SomeException :: *
data SomeException = forall e. Exception e => SomeException e
- SrcLoc :: [GHC.Types.Char] -> [GHC.Types.Char] -> [GHC.Types.Char] -> GHC.Types.Int -> GHC.Types.Int -> GHC.Types.Int -> GHC.Types.Int -> SrcLoc
type SrcLoc :: *
data SrcLoc = SrcLoc {srcLocPackage :: [GHC.Types.Char], srcLocModule :: [GHC.Types.Char], srcLocFile :: [GHC.Types.Char], srcLocStartLine :: GHC.Types.Int, srcLocStartCol :: GHC.Types.Int, srcLocEndLine :: GHC.Types.Int, srcLocEndCol :: GHC.Types.Int}
divZeroException :: SomeException
@@ -5382,13 +5190,6 @@ module GHC.Exception where
prettySrcLoc :: SrcLoc -> GHC.Base.String
ratioZeroDenomException :: SomeException
showCCSStack :: [GHC.Base.String] -> [GHC.Base.String]
- srcLocEndCol :: SrcLoc -> GHC.Types.Int
- srcLocEndLine :: SrcLoc -> GHC.Types.Int
- srcLocFile :: SrcLoc -> [GHC.Types.Char]
- srcLocModule :: SrcLoc -> [GHC.Types.Char]
- srcLocPackage :: SrcLoc -> [GHC.Types.Char]
- srcLocStartCol :: SrcLoc -> GHC.Types.Int
- srcLocStartLine :: SrcLoc -> GHC.Types.Int
throw :: forall (r :: GHC.Types.RuntimeRep) (a :: TYPE r) e. Exception e => e -> a
underflowException :: SomeException
@@ -5401,7 +5202,6 @@ module GHC.Exception.Type where
toException :: e -> SomeException
fromException :: SomeException -> GHC.Maybe.Maybe e
displayException :: e -> GHC.Base.String
- SomeException :: forall e. Exception e => e -> SomeException
type SomeException :: *
data SomeException = forall e. Exception e => SomeException e
divZeroException :: SomeException
@@ -5411,40 +5211,24 @@ module GHC.Exception.Type where
module GHC.ExecutionStack where
-- Safety: None
- Location :: GHC.Base.String -> GHC.Base.String -> GHC.Maybe.Maybe SrcLoc -> Location
type Location :: *
data Location = Location {objectName :: GHC.Base.String, functionName :: GHC.Base.String, srcLoc :: GHC.Maybe.Maybe SrcLoc}
- SrcLoc :: GHC.Base.String -> GHC.Types.Int -> GHC.Types.Int -> SrcLoc
type SrcLoc :: *
data SrcLoc = SrcLoc {sourceFile :: GHC.Base.String, sourceLine :: GHC.Types.Int, sourceColumn :: GHC.Types.Int}
- functionName :: Location -> GHC.Base.String
getStackTrace :: GHC.Types.IO (GHC.Maybe.Maybe [Location])
- objectName :: Location -> GHC.Base.String
showStackTrace :: GHC.Types.IO (GHC.Maybe.Maybe GHC.Base.String)
- sourceColumn :: SrcLoc -> GHC.Types.Int
- sourceFile :: SrcLoc -> GHC.Base.String
- sourceLine :: SrcLoc -> GHC.Types.Int
- srcLoc :: Location -> GHC.Maybe.Maybe SrcLoc
module GHC.ExecutionStack.Internal where
-- Safety: None
- Location :: GHC.Base.String -> GHC.Base.String -> GHC.Maybe.Maybe SrcLoc -> Location
type Location :: *
data Location = Location {objectName :: GHC.Base.String, functionName :: GHC.Base.String, srcLoc :: GHC.Maybe.Maybe SrcLoc}
- SrcLoc :: GHC.Base.String -> GHC.Types.Int -> GHC.Types.Int -> SrcLoc
type SrcLoc :: *
data SrcLoc = SrcLoc {sourceFile :: GHC.Base.String, sourceLine :: GHC.Types.Int, sourceColumn :: GHC.Types.Int}
type StackTrace :: *
newtype StackTrace = ...
collectStackTrace :: GHC.Types.IO (GHC.Maybe.Maybe StackTrace)
- functionName :: Location -> GHC.Base.String
invalidateDebugCache :: GHC.Types.IO ()
- objectName :: Location -> GHC.Base.String
showStackFrames :: [Location] -> GHC.Show.ShowS
- sourceColumn :: SrcLoc -> GHC.Types.Int
- sourceFile :: SrcLoc -> GHC.Base.String
- sourceLine :: SrcLoc -> GHC.Types.Int
- srcLoc :: Location -> GHC.Maybe.Maybe SrcLoc
stackDepth :: StackTrace -> GHC.Types.Int
stackFrames :: StackTrace -> GHC.Maybe.Maybe [Location]
@@ -5476,7 +5260,6 @@ module GHC.Exts where
type family Any where
type Array# :: forall {l :: Levity}. TYPE (BoxedRep l) -> UnliftedType
data Array# a
- ArrayArray# :: Array# ByteArray# -> ArrayArray#
type ArrayArray# :: UnliftedType
newtype ArrayArray# = ArrayArray# (Array# ByteArray#)
type BCO :: *
@@ -5513,7 +5296,6 @@ module GHC.Exts where
data DoubleX4#
type DoubleX8# :: TYPE (VecRep Vec8 DoubleElemRep)
data DoubleX8#
- Down :: forall a. a -> Down a
type Down :: * -> *
newtype Down a = Down {getDown :: a}
type role FUN nominal representational representational
@@ -5531,7 +5313,6 @@ module GHC.Exts where
data FloatX4#
type FloatX8# :: TYPE (VecRep Vec8 FloatElemRep)
data FloatX8#
- FunPtr :: forall a. Addr# -> FunPtr a
type role FunPtr phantom
type FunPtr :: * -> *
data FunPtr a = FunPtr Addr#
@@ -5618,7 +5399,6 @@ module GHC.Exts where
type role MutableArray# nominal representational
type MutableArray# :: forall {l :: Levity}. * -> TYPE (BoxedRep l) -> UnliftedType
data MutableArray# a b
- MutableArrayArray# :: forall s. MutableArray# s ByteArray# -> MutableArrayArray# s
type role MutableArrayArray# nominal
type MutableArrayArray# :: * -> UnliftedType
newtype MutableArrayArray# s = MutableArrayArray# (MutableArray# s ByteArray#)
@@ -5632,7 +5412,6 @@ module GHC.Exts where
type role Proxy# phantom
type Proxy# :: forall k. k -> ZeroBitType
data Proxy# a
- Ptr :: forall a. Addr# -> Ptr a
type role Ptr phantom
type Ptr :: * -> *
data Ptr a = Ptr Addr#
@@ -5640,10 +5419,8 @@ module GHC.Exts where
data RealWorld
type RuntimeRep :: *
data RuntimeRep = VecRep VecCount VecElem | TupleRep [RuntimeRep] | SumRep [RuntimeRep] | BoxedRep Levity | IntRep | Int8Rep | Int16Rep | Int32Rep | Int64Rep | WordRep | Word8Rep | Word16Rep | Word32Rep | Word64Rep | AddrRep | FloatRep | DoubleRep
- SPEC :: SPEC
type SPEC :: *
data SPEC = SPEC | SPEC2
- SPEC2 :: SPEC
type SmallArray# :: forall {l :: Levity}. TYPE (BoxedRep l) -> UnliftedType
data SmallArray# a
type role SmallMutableArray# nominal representational
@@ -5960,7 +5737,6 @@ module GHC.Exts where
getApStackVal# :: forall a b. a -> Int# -> (# Int#, b #)
getCCSOf# :: forall a d. a -> State# d -> (# State# d, Addr# #)
getCurrentCCS# :: forall a d. a -> State# d -> (# State# d, Addr# #)
- getDown :: forall a. Down a -> a
getMaskingState# :: State# RealWorld -> (# State# RealWorld, Int# #)
getSizeofMutableByteArray# :: forall d. MutableByteArray# d -> State# d -> (# State# d, Int# #)
getSizeofSmallMutableArray# :: forall {l :: Levity} d (a :: TYPE (BoxedRep l)). SmallMutableArray# d a -> State# d -> (# State# d, Int# #)
@@ -7119,7 +6895,6 @@ module GHC.Exts where
module GHC.Fingerprint where
-- Safety: Trustworthy
- Fingerprint :: GHC.Word.Word64 -> GHC.Word.Word64 -> Fingerprint
type Fingerprint :: *
data Fingerprint = Fingerprint {-# UNPACK #-}GHC.Word.Word64 {-# UNPACK #-}GHC.Word.Word64
fingerprint0 :: Fingerprint
@@ -7130,7 +6905,6 @@ module GHC.Fingerprint where
module GHC.Fingerprint.Type where
-- Safety: Trustworthy
- Fingerprint :: GHC.Word.Word64 -> GHC.Word.Word64 -> Fingerprint
type Fingerprint :: *
data Fingerprint = Fingerprint {-# UNPACK #-}GHC.Word.Word64 {-# UNPACK #-}GHC.Word.Word64
@@ -7361,7 +7135,6 @@ module GHC.ForeignPtr where
type FinalizerPtr a = GHC.Ptr.FunPtr (GHC.Ptr.Ptr a -> GHC.Types.IO ())
type Finalizers :: *
data Finalizers = NoFinalizers | CFinalizers (GHC.Prim.Weak# ()) | HaskellFinalizers [GHC.Types.IO ()]
- ForeignPtr :: forall a. GHC.Prim.Addr# -> ForeignPtrContents -> ForeignPtr a
type role ForeignPtr phantom
type ForeignPtr :: * -> *
data ForeignPtr a = ForeignPtr GHC.Prim.Addr# ForeignPtrContents
@@ -7403,7 +7176,6 @@ module GHC.GHCi.Helpers where
module GHC.Generics where
-- Safety: Trustworthy
- (:*:) :: forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> g p -> (:*:) f g p
type role (:*:) representational representational nominal
type (:*:) :: forall k. (k -> *) -> (k -> *) -> k -> *
data (:*:) f g p = (f p) :*: (g p)
@@ -7456,32 +7228,26 @@ module GHC.Generics where
from1 :: forall (a :: k). f a -> Rep1 f a
to1 :: forall (a :: k). Rep1 f a -> f a
{-# MINIMAL from1, to1 #-}
- Generically :: forall a. a -> Generically a
type Generically :: * -> *
newtype Generically a = Generically a
- Generically1 :: forall {k} (f :: k -> *) (a :: k). f a -> Generically1 f a
type role Generically1 representational nominal
type Generically1 :: forall k. (k -> *) -> k -> *
newtype Generically1 f a where
Generically1 :: forall {k} (f :: k -> *) (a :: k). f a -> Generically1 f a
- K1 :: forall k i c (p :: k). c -> K1 i c p
type role K1 phantom representational phantom
type K1 :: forall k. * -> * -> k -> *
newtype K1 i c p = K1 {unK1 :: c}
- M1 :: forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
type role M1 phantom phantom representational nominal
type M1 :: forall k. * -> Meta -> (k -> *) -> k -> *
newtype M1 i c f p = M1 {unM1 :: f p}
type Meta :: *
data Meta = MetaData GHC.Types.Symbol GHC.Types.Symbol GHC.Types.Symbol GHC.Types.Bool | MetaCons GHC.Types.Symbol FixityI GHC.Types.Bool | MetaSel (GHC.Maybe.Maybe GHC.Types.Symbol) SourceUnpackedness SourceStrictness DecidedStrictness
- Par1 :: forall p. p -> Par1 p
type Par1 :: * -> *
newtype Par1 p = Par1 {unPar1 :: p}
type R :: *
data R
type Rec0 :: forall {k}. * -> k -> *
type Rec0 = K1 R :: * -> k -> *
- Rec1 :: forall k (f :: k -> *) (p :: k). f p -> Rec1 f p
type role Rec1 representational nominal
type Rec1 :: forall k. (k -> *) -> k -> *
newtype Rec1 f p = Rec1 {unRec1 :: f p}
@@ -7500,7 +7266,6 @@ module GHC.Generics where
data SourceStrictness = NoSourceStrictness | SourceLazy | SourceStrict
type SourceUnpackedness :: *
data SourceUnpackedness = NoSourceUnpackedness | SourceNoUnpack | SourceUnpack
- U1 :: forall k (p :: k). U1 p
type role U1 phantom
type U1 :: forall k. k -> *
data U1 p = U1
@@ -7534,16 +7299,11 @@ module GHC.Generics where
uFloat# :: forall k (p :: k). URec GHC.Types.Float p -> GHC.Prim.Float#
uInt# :: forall k (p :: k). URec GHC.Types.Int p -> GHC.Prim.Int#
uWord# :: forall k (p :: k). URec GHC.Types.Word p -> GHC.Prim.Word#
- unK1 :: forall k i c (p :: k). K1 i c p -> c
- unM1 :: forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
- unPar1 :: forall p. Par1 p -> p
- unRec1 :: forall k (f :: k -> *) (p :: k). Rec1 f p -> f p
module GHC.IO where
-- Safety: Unsafe
type FilePath :: *
type FilePath = GHC.Base.String
- IO :: forall a. (GHC.Prim.State# GHC.Prim.RealWorld -> (# GHC.Prim.State# GHC.Prim.RealWorld, a #)) -> IO a
type IO :: * -> *
newtype IO a = IO (GHC.Prim.State# GHC.Prim.RealWorld -> (# GHC.Prim.State# GHC.Prim.RealWorld, a #))
type MaskingState :: *
@@ -7579,7 +7339,6 @@ module GHC.IO where
module GHC.IO.Buffer where
-- Safety: Trustworthy
- Buffer :: forall e. RawBuffer e -> BufferState -> GHC.Types.Int -> GHC.Word.Word64 -> GHC.Types.Int -> GHC.Types.Int -> Buffer e
type role Buffer phantom
type Buffer :: * -> *
data Buffer e = Buffer {bufRaw :: {-# UNPACK #-}(RawBuffer e), bufState :: BufferState, bufSize :: {-# UNPACK #-}GHC.Types.Int, bufOffset :: {-# UNPACK #-}GHC.Word.Word64, bufL :: {-# UNPACK #-}GHC.Types.Int, bufR :: {-# UNPACK #-}GHC.Types.Int}
@@ -7593,12 +7352,6 @@ module GHC.IO.Buffer where
type RawBuffer e = GHC.ForeignPtr.ForeignPtr e
type RawCharBuffer :: *
type RawCharBuffer = RawBuffer CharBufElem
- bufL :: forall e. Buffer e -> GHC.Types.Int
- bufOffset :: forall e. Buffer e -> GHC.Word.Word64
- bufR :: forall e. Buffer e -> GHC.Types.Int
- bufRaw :: forall e. Buffer e -> RawBuffer e
- bufSize :: forall e. Buffer e -> GHC.Types.Int
- bufState :: forall e. Buffer e -> BufferState
bufferAdd :: forall e. GHC.Types.Int -> Buffer e -> Buffer e
bufferAddOffset :: forall e. GHC.Types.Int -> Buffer e -> Buffer e
bufferAdjustL :: forall e. GHC.Types.Int -> Buffer e -> Buffer e
@@ -7678,7 +7431,6 @@ module GHC.IO.Device where
module GHC.IO.Encoding where
-- Safety: Trustworthy
- BufferCodec :: forall from to state. GHC.IO.Encoding.Types.CodeBuffer from to -> (GHC.IO.Buffer.Buffer from -> GHC.IO.Buffer.Buffer to -> GHC.Types.IO (GHC.IO.Buffer.Buffer from, GHC.IO.Buffer.Buffer to)) -> GHC.Types.IO () -> GHC.Types.IO state -> (state -> GHC.Types.IO ()) -> BufferCodec from to state
type role BufferCodec phantom phantom representational
type BufferCodec :: * -> * -> * -> *
data BufferCodec from to state = BufferCodec {encode :: GHC.IO.Encoding.Types.CodeBuffer from to, recover :: GHC.IO.Buffer.Buffer from -> GHC.IO.Buffer.Buffer to -> GHC.Types.IO (GHC.IO.Buffer.Buffer from, GHC.IO.Buffer.Buffer to), close :: GHC.Types.IO (), getState :: GHC.Types.IO state, setState :: state -> GHC.Types.IO ()}
@@ -7688,30 +7440,21 @@ module GHC.IO.Encoding where
type TextDecoder state = BufferCodec GHC.Word.Word8 GHC.IO.Buffer.CharBufElem state
type TextEncoder :: * -> *
type TextEncoder state = BufferCodec GHC.IO.Buffer.CharBufElem GHC.Word.Word8 state
- TextEncoding :: forall dstate estate. GHC.Base.String -> GHC.Types.IO (TextDecoder dstate) -> GHC.Types.IO (TextEncoder estate) -> TextEncoding
type TextEncoding :: *
data TextEncoding = forall dstate estate. TextEncoding {textEncodingName :: GHC.Base.String, mkTextDecoder :: GHC.Types.IO (TextDecoder dstate), mkTextEncoder :: GHC.Types.IO (TextEncoder estate)}
argvEncoding :: GHC.Types.IO TextEncoding
char8 :: TextEncoding
- close :: forall from to state. BufferCodec from to state -> GHC.Types.IO ()
- encode :: forall from to state. BufferCodec from to state -> GHC.IO.Encoding.Types.CodeBuffer from to
getFileSystemEncoding :: GHC.Types.IO TextEncoding
getForeignEncoding :: GHC.Types.IO TextEncoding
getLocaleEncoding :: GHC.Types.IO TextEncoding
- getState :: forall from to state. BufferCodec from to state -> GHC.Types.IO state
initLocaleEncoding :: TextEncoding
latin1 :: TextEncoding
latin1_decode :: GHC.IO.Buffer.Buffer GHC.Word.Word8 -> GHC.IO.Buffer.CharBuffer -> GHC.Types.IO (GHC.IO.Buffer.Buffer GHC.Word.Word8, GHC.IO.Buffer.CharBuffer)
latin1_encode :: GHC.IO.Buffer.CharBuffer -> GHC.IO.Buffer.Buffer GHC.Word.Word8 -> GHC.Types.IO (GHC.IO.Buffer.CharBuffer, GHC.IO.Buffer.Buffer GHC.Word.Word8)
- mkTextDecoder :: ()
- mkTextEncoder :: ()
mkTextEncoding :: GHC.Base.String -> GHC.Types.IO TextEncoding
- recover :: forall from to state. BufferCodec from to state -> GHC.IO.Buffer.Buffer from -> GHC.IO.Buffer.Buffer to -> GHC.Types.IO (GHC.IO.Buffer.Buffer from, GHC.IO.Buffer.Buffer to)
setFileSystemEncoding :: TextEncoding -> GHC.Types.IO ()
setForeignEncoding :: TextEncoding -> GHC.Types.IO ()
setLocaleEncoding :: TextEncoding -> GHC.Types.IO ()
- setState :: forall from to state. BufferCodec from to state -> state -> GHC.Types.IO ()
- textEncodingName :: TextEncoding -> GHC.Base.String
utf16 :: TextEncoding
utf16be :: TextEncoding
utf16le :: TextEncoding
@@ -7755,7 +7498,6 @@ module GHC.IO.Encoding.Latin1 where
module GHC.IO.Encoding.Types where
-- Safety: Trustworthy
- BufferCodec :: forall from to state. CodeBuffer from to -> (GHC.IO.Buffer.Buffer from -> GHC.IO.Buffer.Buffer to -> GHC.Types.IO (GHC.IO.Buffer.Buffer from, GHC.IO.Buffer.Buffer to)) -> GHC.Types.IO () -> GHC.Types.IO state -> (state -> GHC.Types.IO ()) -> BufferCodec from to state
type role BufferCodec phantom phantom representational
type BufferCodec :: * -> * -> * -> *
data BufferCodec from to state = BufferCodec {encode :: CodeBuffer from to, recover :: GHC.IO.Buffer.Buffer from -> GHC.IO.Buffer.Buffer to -> GHC.Types.IO (GHC.IO.Buffer.Buffer from, GHC.IO.Buffer.Buffer to), close :: GHC.Types.IO (), getState :: GHC.Types.IO state, setState :: state -> GHC.Types.IO ()}
@@ -7771,17 +7513,8 @@ module GHC.IO.Encoding.Types where
type TextDecoder state = BufferCodec GHC.Word.Word8 GHC.IO.Buffer.CharBufElem state
type TextEncoder :: * -> *
type TextEncoder state = BufferCodec GHC.IO.Buffer.CharBufElem GHC.Word.Word8 state
- TextEncoding :: forall dstate estate. GHC.Base.String -> GHC.Types.IO (TextDecoder dstate) -> GHC.Types.IO (TextEncoder estate) -> TextEncoding
type TextEncoding :: *
data TextEncoding = forall dstate estate. TextEncoding {textEncodingName :: GHC.Base.String, mkTextDecoder :: GHC.Types.IO (TextDecoder dstate), mkTextEncoder :: GHC.Types.IO (TextEncoder estate)}
- close :: forall from to state. BufferCodec from to state -> GHC.Types.IO ()
- encode :: forall from to state. BufferCodec from to state -> CodeBuffer from to
- getState :: forall from to state. BufferCodec from to state -> GHC.Types.IO state
- mkTextDecoder :: ()
- mkTextEncoder :: ()
- recover :: forall from to state. BufferCodec from to state -> GHC.IO.Buffer.Buffer from -> GHC.IO.Buffer.Buffer to -> GHC.Types.IO (GHC.IO.Buffer.Buffer from, GHC.IO.Buffer.Buffer to)
- setState :: forall from to state. BufferCodec from to state -> state -> GHC.Types.IO ()
- textEncodingName :: TextEncoding -> GHC.Base.String
module GHC.IO.Encoding.UTF16 where
-- Safety: Trustworthy
@@ -7822,31 +7555,24 @@ module GHC.IO.Encoding.UTF8 where
module GHC.IO.Exception where
-- Safety: Trustworthy
- AllocationLimitExceeded :: AllocationLimitExceeded
type AllocationLimitExceeded :: *
data AllocationLimitExceeded = AllocationLimitExceeded
type ArrayException :: *
data ArrayException = IndexOutOfBounds GHC.Base.String | UndefinedElement GHC.Base.String
- AssertionFailed :: GHC.Base.String -> AssertionFailed
type AssertionFailed :: *
newtype AssertionFailed = AssertionFailed GHC.Base.String
type AsyncException :: *
data AsyncException = StackOverflow | HeapOverflow | ThreadKilled | UserInterrupt
- BlockedIndefinitelyOnMVar :: BlockedIndefinitelyOnMVar
type BlockedIndefinitelyOnMVar :: *
data BlockedIndefinitelyOnMVar = BlockedIndefinitelyOnMVar
- BlockedIndefinitelyOnSTM :: BlockedIndefinitelyOnSTM
type BlockedIndefinitelyOnSTM :: *
data BlockedIndefinitelyOnSTM = BlockedIndefinitelyOnSTM
- CompactionFailed :: GHC.Base.String -> CompactionFailed
type CompactionFailed :: *
newtype CompactionFailed = CompactionFailed GHC.Base.String
- Deadlock :: Deadlock
type Deadlock :: *
data Deadlock = Deadlock
type ExitCode :: *
data ExitCode = ExitSuccess | ExitFailure GHC.Types.Int
- FixIOException :: FixIOException
type FixIOException :: *
data FixIOException = FixIOException
type IOError :: *
@@ -7855,7 +7581,6 @@ module GHC.IO.Exception where
data IOErrorType = AlreadyExists | NoSuchThing | ResourceBusy | ResourceExhausted | EOF | IllegalOperation | PermissionDenied | UserError | UnsatisfiedConstraints | SystemError | ProtocolError | OtherError | InvalidArgument | InappropriateType | HardwareFault | UnsupportedOperation | TimeExpired | ResourceVanished | Interrupted
type IOException :: *
data IOException = IOError {ioe_handle :: GHC.Maybe.Maybe GHC.IO.Handle.Types.Handle, ioe_type :: IOErrorType, ioe_location :: GHC.Base.String, ioe_description :: GHC.Base.String, ioe_errno :: GHC.Maybe.Maybe Foreign.C.Types.CInt, ioe_filename :: GHC.Maybe.Maybe GHC.IO.FilePath}
- SomeAsyncException :: forall e. GHC.Exception.Type.Exception e => e -> SomeAsyncException
type SomeAsyncException :: *
data SomeAsyncException = forall e. GHC.Exception.Type.Exception e => SomeAsyncException e
allocationLimitExceeded :: GHC.Exception.Type.SomeException
@@ -7877,11 +7602,8 @@ module GHC.IO.Exception where
module GHC.IO.FD where
-- Safety: Trustworthy
- FD :: Foreign.C.Types.CInt -> GHC.Types.Int -> FD
type FD :: *
data FD = FD {fdFD :: ! {-# UNPACK #-}(Foreign.C.Types.N:CInt[0])Foreign.C.Types.CInt, fdIsNonBlocking :: {-# UNPACK #-}GHC.Types.Int}
- fdFD :: FD -> Foreign.C.Types.CInt
- fdIsNonBlocking :: FD -> GHC.Types.Int
mkFD :: Foreign.C.Types.CInt -> GHC.IO.IOMode.IOMode -> GHC.Maybe.Maybe (GHC.IO.Device.IODeviceType, System.Posix.Types.CDev, System.Posix.Types.CIno) -> GHC.Types.Bool -> GHC.Types.Bool -> GHC.Types.IO (FD, GHC.IO.Device.IODeviceType)
openFile :: GHC.IO.FilePath -> GHC.IO.IOMode.IOMode -> GHC.Types.Bool -> GHC.Types.IO (FD, GHC.IO.Device.IODeviceType)
openFileWith :: forall r s. GHC.IO.FilePath -> GHC.IO.IOMode.IOMode -> GHC.Types.Bool -> (FD -> GHC.IO.Device.IODeviceType -> GHC.Types.IO r) -> ((forall x. GHC.Types.IO x -> GHC.Types.IO x) -> r -> GHC.Types.IO s) -> GHC.Types.IO s
@@ -7902,14 +7624,12 @@ module GHC.IO.Handle where
data Handle = ...
type HandlePosition :: *
type HandlePosition = GHC.Num.Integer.Integer
- HandlePosn :: Handle -> HandlePosition -> HandlePosn
type HandlePosn :: *
data HandlePosn = HandlePosn Handle HandlePosition
type LockMode :: *
data LockMode = SharedLock | ExclusiveLock
type Newline :: *
data Newline = LF | CRLF
- NewlineMode :: Newline -> Newline -> NewlineMode
type NewlineMode :: *
data NewlineMode = NewlineMode {inputNL :: Newline, outputNL :: Newline}
type SeekMode :: *
@@ -7956,14 +7676,12 @@ module GHC.IO.Handle where
hTell :: Handle -> GHC.Types.IO GHC.Num.Integer.Integer
hTryLock :: Handle -> LockMode -> GHC.Types.IO GHC.Types.Bool
hWaitForInput :: Handle -> GHC.Types.Int -> GHC.Types.IO GHC.Types.Bool
- inputNL :: NewlineMode -> Newline
isEOF :: GHC.Types.IO GHC.Types.Bool
mkDuplexHandle :: forall dev. (GHC.IO.Device.RawIO dev, GHC.IO.Device.IODevice dev, GHC.IO.BufferedIO.BufferedIO dev, base-4.18.0.0:Data.Typeable.Internal.Typeable dev) => dev -> GHC.IO.FilePath -> GHC.Maybe.Maybe GHC.IO.Encoding.Types.TextEncoding -> NewlineMode -> GHC.Types.IO Handle
mkFileHandle :: forall dev. (GHC.IO.Device.RawIO dev, GHC.IO.Device.IODevice dev, GHC.IO.BufferedIO.BufferedIO dev, base-4.18.0.0:Data.Typeable.Internal.Typeable dev) => dev -> GHC.IO.FilePath -> GHC.IO.IOMode.IOMode -> GHC.Maybe.Maybe GHC.IO.Encoding.Types.TextEncoding -> NewlineMode -> GHC.Types.IO Handle
nativeNewline :: Newline
nativeNewlineMode :: NewlineMode
noNewlineTranslation :: NewlineMode
- outputNL :: NewlineMode -> Newline
universalNewlineMode :: NewlineMode
module GHC.IO.Handle.FD where
@@ -8033,7 +7751,6 @@ module GHC.IO.Handle.Internals where
module GHC.IO.Handle.Lock where
-- Safety: None
- FileLockingNotSupported :: FileLockingNotSupported
type FileLockingNotSupported :: *
data FileLockingNotSupported = FileLockingNotSupported
type LockMode :: *
@@ -8062,7 +7779,6 @@ module GHC.IO.Handle.Text where
module GHC.IO.Handle.Types where
-- Safety: Trustworthy
- BufferCodec :: forall from to state. GHC.IO.Encoding.Types.CodeBuffer from to -> (GHC.IO.Buffer.Buffer from -> GHC.IO.Buffer.Buffer to -> GHC.Types.IO (GHC.IO.Buffer.Buffer from, GHC.IO.Buffer.Buffer to)) -> GHC.Types.IO () -> GHC.Types.IO state -> (state -> GHC.Types.IO ()) -> BufferCodec from to state
type role BufferCodec phantom phantom representational
type BufferCodec :: * -> * -> * -> *
data BufferCodec from to state = BufferCodec {encode :: GHC.IO.Encoding.Types.CodeBuffer from to, recover :: GHC.IO.Buffer.Buffer from -> GHC.IO.Buffer.Buffer to -> GHC.Types.IO (GHC.IO.Buffer.Buffer from, GHC.IO.Buffer.Buffer to), close :: GHC.Types.IO (), getState :: GHC.Types.IO state, setState :: state -> GHC.Types.IO ()}
@@ -8075,10 +7791,6 @@ module GHC.IO.Handle.Types where
data Handle = FileHandle GHC.IO.FilePath {-# UNPACK #-}(GHC.MVar.MVar Handle__) | DuplexHandle GHC.IO.FilePath {-# UNPACK #-}(GHC.MVar.MVar Handle__) {-# UNPACK #-}(GHC.MVar.MVar Handle__)
type HandleType :: *
data HandleType = ClosedHandle | SemiClosedHandle | ReadHandle | WriteHandle | AppendHandle | ReadWriteHandle
- Handle__ ::
- forall dev enc_state dec_state.
- (GHC.IO.Device.RawIO dev, GHC.IO.Device.IODevice dev, GHC.IO.BufferedIO.BufferedIO dev, base-4.18.0.0:Data.Typeable.Internal.Typeable dev) =>
- dev -> HandleType -> GHC.IORef.IORef (GHC.IO.Buffer.Buffer GHC.Word.Word8) -> BufferMode -> GHC.IORef.IORef (dec_state, GHC.IO.Buffer.Buffer GHC.Word.Word8) -> GHC.IORef.IORef (GHC.IO.Buffer.Buffer GHC.IO.Buffer.CharBufElem) -> GHC.IORef.IORef (BufferList GHC.IO.Buffer.CharBufElem) -> GHC.Maybe.Maybe (GHC.IO.Encoding.Types.TextEncoder enc_state) -> GHC.Maybe.Maybe (GHC.IO.Encoding.Types.TextDecoder dec_state) -> GHC.Maybe.Maybe GHC.IO.Encoding.Types.TextEncoding -> Newline -> Newline -> GHC.Maybe.Maybe (GHC.MVar.MVar Handle__) -> Handle__
type Handle__ :: *
data Handle__
= forall dev enc_state dec_state.
@@ -8098,27 +7810,9 @@ module GHC.IO.Handle.Types where
haOtherSide :: GHC.Maybe.Maybe (GHC.MVar.MVar Handle__)}
type Newline :: *
data Newline = LF | CRLF
- NewlineMode :: Newline -> Newline -> NewlineMode
type NewlineMode :: *
data NewlineMode = NewlineMode {inputNL :: Newline, outputNL :: Newline}
checkHandleInvariants :: Handle__ -> GHC.Types.IO ()
- close :: forall from to state. BufferCodec from to state -> GHC.Types.IO ()
- encode :: forall from to state. BufferCodec from to state -> GHC.IO.Encoding.Types.CodeBuffer from to
- getState :: forall from to state. BufferCodec from to state -> GHC.Types.IO state
- haBufferMode :: Handle__ -> BufferMode
- haBuffers :: Handle__ -> GHC.IORef.IORef (BufferList GHC.IO.Buffer.CharBufElem)
- haByteBuffer :: Handle__ -> GHC.IORef.IORef (GHC.IO.Buffer.Buffer GHC.Word.Word8)
- haCharBuffer :: Handle__ -> GHC.IORef.IORef (GHC.IO.Buffer.Buffer GHC.IO.Buffer.CharBufElem)
- haCodec :: Handle__ -> GHC.Maybe.Maybe GHC.IO.Encoding.Types.TextEncoding
- haDecoder :: ()
- haDevice :: ()
- haEncoder :: ()
- haInputNL :: Handle__ -> Newline
- haLastDecode :: ()
- haOtherSide :: Handle__ -> GHC.Maybe.Maybe (GHC.MVar.MVar Handle__)
- haOutputNL :: Handle__ -> Newline
- haType :: Handle__ -> HandleType
- inputNL :: NewlineMode -> Newline
isAppendHandleType :: HandleType -> GHC.Types.Bool
isReadWriteHandleType :: HandleType -> GHC.Types.Bool
isReadableHandleType :: HandleType -> GHC.Types.Bool
@@ -8126,9 +7820,6 @@ module GHC.IO.Handle.Types where
nativeNewline :: Newline
nativeNewlineMode :: NewlineMode
noNewlineTranslation :: NewlineMode
- outputNL :: NewlineMode -> Newline
- recover :: forall from to state. BufferCodec from to state -> GHC.IO.Buffer.Buffer from -> GHC.IO.Buffer.Buffer to -> GHC.Types.IO (GHC.IO.Buffer.Buffer from, GHC.IO.Buffer.Buffer to)
- setState :: forall from to state. BufferCodec from to state -> state -> GHC.Types.IO ()
showHandle :: GHC.IO.FilePath -> GHC.Base.String -> GHC.Base.String
universalNewlineMode :: NewlineMode
@@ -8171,7 +7862,6 @@ module GHC.IO.Unsafe where
module GHC.IOArray where
-- Safety: Unsafe
- IOArray :: forall i e. GHC.Arr.STArray GHC.Prim.RealWorld i e -> IOArray i e
type role IOArray nominal representational
type IOArray :: * -> * -> *
newtype IOArray i e = IOArray (GHC.Arr.STArray GHC.Prim.RealWorld i e)
@@ -8184,7 +7874,6 @@ module GHC.IOArray where
module GHC.IOPort where
-- Safety: Unsafe
- IOPort :: forall a. GHC.Prim.IOPort# GHC.Prim.RealWorld a -> IOPort a
type IOPort :: * -> *
data IOPort a = IOPort (GHC.Prim.IOPort# GHC.Prim.RealWorld a)
doubleReadException :: GHC.Exception.Type.SomeException
@@ -8195,7 +7884,6 @@ module GHC.IOPort where
module GHC.IORef where
-- Safety: Unsafe
- IORef :: forall a. GHC.STRef.STRef GHC.Prim.RealWorld a -> IORef a
type IORef :: * -> *
newtype IORef a = IORef (GHC.STRef.STRef GHC.Prim.RealWorld a)
atomicModifyIORef' :: forall a b. IORef a -> (a -> (a, b)) -> GHC.Types.IO b
@@ -8211,19 +7899,11 @@ module GHC.IORef where
module GHC.InfoProv where
-- Safety: Trustworthy
- InfoProv :: GHC.Base.String -> GHC.Base.String -> GHC.Base.String -> GHC.Base.String -> GHC.Base.String -> GHC.Base.String -> GHC.Base.String -> InfoProv
type InfoProv :: *
data InfoProv = InfoProv {ipName :: GHC.Base.String, ipDesc :: GHC.Base.String, ipTyDesc :: GHC.Base.String, ipLabel :: GHC.Base.String, ipMod :: GHC.Base.String, ipSrcFile :: GHC.Base.String, ipSrcSpan :: GHC.Base.String}
type InfoProvEnt :: *
data InfoProvEnt
- ipDesc :: InfoProv -> GHC.Base.String
- ipLabel :: InfoProv -> GHC.Base.String
ipLoc :: InfoProv -> GHC.Base.String
- ipMod :: InfoProv -> GHC.Base.String
- ipName :: InfoProv -> GHC.Base.String
- ipSrcFile :: InfoProv -> GHC.Base.String
- ipSrcSpan :: InfoProv -> GHC.Base.String
- ipTyDesc :: InfoProv -> GHC.Base.String
ipeProv :: GHC.Ptr.Ptr InfoProvEnt -> GHC.Ptr.Ptr InfoProv
peekInfoProv :: GHC.Ptr.Ptr InfoProv -> GHC.Types.IO InfoProv
whereFrom :: forall a. a -> GHC.Types.IO (GHC.Maybe.Maybe InfoProv)
@@ -8419,7 +8099,6 @@ module GHC.List where
module GHC.MVar where
-- Safety: Unsafe
- MVar :: forall a. GHC.Prim.MVar# GHC.Prim.RealWorld a -> MVar a
type MVar :: * -> *
data MVar a = MVar (GHC.Prim.MVar# GHC.Prim.RealWorld a)
addMVarFinalizer :: forall a. MVar a -> GHC.Types.IO () -> GHC.Types.IO ()
@@ -9156,11 +8835,9 @@ module GHC.Profiling where
module GHC.Ptr where
-- Safety: Unsafe
- FunPtr :: forall a. GHC.Prim.Addr# -> FunPtr a
type role FunPtr phantom
type FunPtr :: * -> *
data FunPtr a = FunPtr GHC.Prim.Addr#
- Ptr :: forall a. GHC.Prim.Addr# -> Ptr a
type role Ptr phantom
type Ptr :: * -> *
data Ptr a = Ptr GHC.Prim.Addr#
@@ -9176,13 +8853,10 @@ module GHC.Ptr where
module GHC.RTS.Flags where
-- Safety: None
- CCFlags :: DoCostCentres -> GHC.Types.Int -> GHC.Types.Int -> CCFlags
type CCFlags :: *
data CCFlags = CCFlags {doCostCentres :: DoCostCentres, profilerTicks :: GHC.Types.Int, msecsPerTick :: GHC.Types.Int}
- ConcFlags :: RtsTime -> GHC.Types.Int -> ConcFlags
type ConcFlags :: *
data ConcFlags = ConcFlags {ctxtSwitchTime :: RtsTime, ctxtSwitchTicks :: GHC.Types.Int}
- DebugFlags :: GHC.Types.Bool -> GHC.Types.Bool -> GHC.Types.Bool -> GHC.Types.Bool -> GHC.Types.Bool -> GHC.Types.Bool -> GHC.Types.Bool -> GHC.Types.Bool -> GHC.Types.Bool -> GHC.Types.Bool -> GHC.Types.Bool -> GHC.Types.Bool -> GHC.Types.Bool -> GHC.Types.Bool -> GHC.Types.Bool -> GHC.Types.Bool -> DebugFlags
type DebugFlags :: *
data DebugFlags = DebugFlags {scheduler :: GHC.Types.Bool, interpreter :: GHC.Types.Bool, weak :: GHC.Types.Bool, gccafs :: GHC.Types.Bool, gc :: GHC.Types.Bool, nonmoving_gc :: GHC.Types.Bool, block_alloc :: GHC.Types.Bool, sanity :: GHC.Types.Bool, stable :: GHC.Types.Bool, prof :: GHC.Types.Bool, linker :: GHC.Types.Bool, apply :: GHC.Types.Bool, stm :: GHC.Types.Bool, squeeze :: GHC.Types.Bool, hpc :: GHC.Types.Bool, sparks :: GHC.Types.Bool}
type DoCostCentres :: *
@@ -9191,7 +8865,6 @@ module GHC.RTS.Flags where
data DoHeapProfile = NoHeapProfiling | HeapByCCS | HeapByMod | HeapByDescr | HeapByType | HeapByRetainer | HeapByLDV | HeapByClosureType | HeapByInfoTable
type DoTrace :: *
data DoTrace = TraceNone | TraceEventLog | TraceStderr
- GCFlags :: GHC.Maybe.Maybe GHC.IO.FilePath -> GiveGCStats -> GHC.Word.Word32 -> GHC.Word.Word32 -> GHC.Word.Word32 -> GHC.Word.Word32 -> GHC.Word.Word32 -> GHC.Word.Word32 -> GHC.Word.Word32 -> GHC.Word.Word32 -> GHC.Word.Word32 -> GHC.Word.Word32 -> GHC.Types.Bool -> GHC.Types.Double -> GHC.Types.Double -> GHC.Types.Double -> GHC.Word.Word32 -> GHC.Types.Bool -> GHC.Types.Bool -> GHC.Types.Double -> GHC.Types.Bool -> GHC.Types.Bool -> RtsTime -> GHC.Types.Bool -> GHC.Types.Word -> GHC.Types.Word -> GHC.Types.Bool -> GHC.Types.Word -> GCFlags
type GCFlags :: *
data GCFlags
= GCFlags {statsFile :: GHC.Maybe.Maybe GHC.IO.FilePath,
@@ -9226,51 +8899,20 @@ module GHC.RTS.Flags where
data GiveGCStats = NoGCStats | CollectGCStats | OneLineGCStats | SummaryGCStats | VerboseGCStats
type IoSubSystem :: *
data IoSubSystem = IoPOSIX | IoNative
- MiscFlags :: RtsTime -> GHC.Types.Bool -> GHC.Types.Bool -> GHC.Types.Bool -> GHC.Types.Bool -> GHC.Types.Bool -> GHC.Types.Bool -> GHC.Types.Bool -> GHC.Types.Bool -> GHC.Types.Word -> IoSubSystem -> GHC.Word.Word32 -> MiscFlags
type MiscFlags :: *
data MiscFlags = MiscFlags {tickInterval :: RtsTime, installSignalHandlers :: GHC.Types.Bool, installSEHHandlers :: GHC.Types.Bool, generateCrashDumpFile :: GHC.Types.Bool, generateStackTrace :: GHC.Types.Bool, machineReadable :: GHC.Types.Bool, disableDelayedOsMemoryReturn :: GHC.Types.Bool, internalCounters :: GHC.Types.Bool, linkerAlwaysPic :: GHC.Types.Bool, linkerMemBase :: GHC.Types.Word, ioManager :: IoSubSystem, numIoWorkerThreads :: GHC.Word.Word32}
- ParFlags :: GHC.Word.Word32 -> GHC.Types.Bool -> GHC.Word.Word32 -> GHC.Types.Bool -> GHC.Word.Word32 -> GHC.Types.Bool -> GHC.Word.Word32 -> GHC.Word.Word32 -> GHC.Word.Word32 -> GHC.Types.Bool -> ParFlags
type ParFlags :: *
data ParFlags = ParFlags {nCapabilities :: GHC.Word.Word32, migrate :: GHC.Types.Bool, maxLocalSparks :: GHC.Word.Word32, parGcEnabled :: GHC.Types.Bool, parGcGen :: GHC.Word.Word32, parGcLoadBalancingEnabled :: GHC.Types.Bool, parGcLoadBalancingGen :: GHC.Word.Word32, parGcNoSyncWithIdle :: GHC.Word.Word32, parGcThreads :: GHC.Word.Word32, setAffinity :: GHC.Types.Bool}
- ProfFlags :: DoHeapProfile -> RtsTime -> GHC.Types.Word -> GHC.Types.Bool -> GHC.Types.Bool -> GHC.Types.Word -> GHC.Types.Word -> GHC.Maybe.Maybe GHC.Base.String -> GHC.Maybe.Maybe GHC.Base.String -> GHC.Maybe.Maybe GHC.Base.String -> GHC.Maybe.Maybe GHC.Base.String -> GHC.Maybe.Maybe GHC.Base.String -> GHC.Maybe.Maybe GHC.Base.String -> GHC.Maybe.Maybe GHC.Base.String -> ProfFlags
type ProfFlags :: *
data ProfFlags = ProfFlags {doHeapProfile :: DoHeapProfile, heapProfileInterval :: RtsTime, heapProfileIntervalTicks :: GHC.Types.Word, startHeapProfileAtStartup :: GHC.Types.Bool, showCCSOnException :: GHC.Types.Bool, maxRetainerSetSize :: GHC.Types.Word, ccsLength :: GHC.Types.Word, modSelector :: GHC.Maybe.Maybe GHC.Base.String, descrSelector :: GHC.Maybe.Maybe GHC.Base.String, typeSelector :: GHC.Maybe.Maybe GHC.Base.String, ccSelector :: GHC.Maybe.Maybe GHC.Base.String, ccsSelector :: GHC.Maybe.Maybe GHC.Base.String, retainerSelector :: GHC.Maybe.Maybe GHC.Base.String, bioSelector :: GHC.Maybe.Maybe GHC.Base.String}
- RTSFlags :: GCFlags -> ConcFlags -> MiscFlags -> DebugFlags -> CCFlags -> ProfFlags -> TraceFlags -> TickyFlags -> ParFlags -> RTSFlags
type RTSFlags :: *
data RTSFlags = RTSFlags {gcFlags :: GCFlags, concurrentFlags :: ConcFlags, miscFlags :: MiscFlags, debugFlags :: DebugFlags, costCentreFlags :: CCFlags, profilingFlags :: ProfFlags, traceFlags :: TraceFlags, tickyFlags :: TickyFlags, parFlags :: ParFlags}
type RtsTime :: *
type RtsTime = GHC.Word.Word64
- TickyFlags :: GHC.Types.Bool -> GHC.Maybe.Maybe GHC.IO.FilePath -> TickyFlags
type TickyFlags :: *
data TickyFlags = TickyFlags {showTickyStats :: GHC.Types.Bool, tickyFile :: GHC.Maybe.Maybe GHC.IO.FilePath}
- TraceFlags :: DoTrace -> GHC.Types.Bool -> GHC.Types.Bool -> GHC.Types.Bool -> GHC.Types.Bool -> GHC.Types.Bool -> GHC.Types.Bool -> GHC.Types.Bool -> TraceFlags
type TraceFlags :: *
data TraceFlags = TraceFlags {tracing :: DoTrace, timestamp :: GHC.Types.Bool, traceScheduler :: GHC.Types.Bool, traceGc :: GHC.Types.Bool, traceNonmovingGc :: GHC.Types.Bool, sparksSampled :: GHC.Types.Bool, sparksFull :: GHC.Types.Bool, user :: GHC.Types.Bool}
- allocLimitGrace :: GCFlags -> GHC.Types.Word
- apply :: DebugFlags -> GHC.Types.Bool
- bioSelector :: ProfFlags -> GHC.Maybe.Maybe GHC.Base.String
- block_alloc :: DebugFlags -> GHC.Types.Bool
- ccSelector :: ProfFlags -> GHC.Maybe.Maybe GHC.Base.String
- ccsLength :: ProfFlags -> GHC.Types.Word
- ccsSelector :: ProfFlags -> GHC.Maybe.Maybe GHC.Base.String
- compact :: GCFlags -> GHC.Types.Bool
- compactThreshold :: GCFlags -> GHC.Types.Double
- concurrentFlags :: RTSFlags -> ConcFlags
- costCentreFlags :: RTSFlags -> CCFlags
- ctxtSwitchTicks :: ConcFlags -> GHC.Types.Int
- ctxtSwitchTime :: ConcFlags -> RtsTime
- debugFlags :: RTSFlags -> DebugFlags
- descrSelector :: ProfFlags -> GHC.Maybe.Maybe GHC.Base.String
- disableDelayedOsMemoryReturn :: MiscFlags -> GHC.Types.Bool
- doCostCentres :: CCFlags -> DoCostCentres
- doHeapProfile :: ProfFlags -> DoHeapProfile
- doIdleGC :: GCFlags -> GHC.Types.Bool
- gc :: DebugFlags -> GHC.Types.Bool
- gcFlags :: RTSFlags -> GCFlags
- gccafs :: DebugFlags -> GHC.Types.Bool
- generateCrashDumpFile :: MiscFlags -> GHC.Types.Bool
- generateStackTrace :: MiscFlags -> GHC.Types.Bool
- generations :: GCFlags -> GHC.Word.Word32
getCCFlags :: GHC.Types.IO CCFlags
getConcFlags :: GHC.Types.IO ConcFlags
getDebugFlags :: GHC.Types.IO DebugFlags
@@ -9282,85 +8924,6 @@ module GHC.RTS.Flags where
getRTSFlags :: GHC.Types.IO RTSFlags
getTickyFlags :: GHC.Types.IO TickyFlags
getTraceFlags :: GHC.Types.IO TraceFlags
- giveStats :: GCFlags -> GiveGCStats
- heapBase :: GCFlags -> GHC.Types.Word
- heapProfileInterval :: ProfFlags -> RtsTime
- heapProfileIntervalTicks :: ProfFlags -> GHC.Types.Word
- heapSizeSuggestion :: GCFlags -> GHC.Word.Word32
- heapSizeSuggestionAuto :: GCFlags -> GHC.Types.Bool
- hpc :: DebugFlags -> GHC.Types.Bool
- idleGCDelayTime :: GCFlags -> RtsTime
- initialStkSize :: GCFlags -> GHC.Word.Word32
- installSEHHandlers :: MiscFlags -> GHC.Types.Bool
- installSignalHandlers :: MiscFlags -> GHC.Types.Bool
- internalCounters :: MiscFlags -> GHC.Types.Bool
- interpreter :: DebugFlags -> GHC.Types.Bool
- ioManager :: MiscFlags -> IoSubSystem
- largeAllocLim :: GCFlags -> GHC.Word.Word32
- linker :: DebugFlags -> GHC.Types.Bool
- linkerAlwaysPic :: MiscFlags -> GHC.Types.Bool
- linkerMemBase :: MiscFlags -> GHC.Types.Word
- machineReadable :: MiscFlags -> GHC.Types.Bool
- maxHeapSize :: GCFlags -> GHC.Word.Word32
- maxLocalSparks :: ParFlags -> GHC.Word.Word32
- maxRetainerSetSize :: ProfFlags -> GHC.Types.Word
- maxStkSize :: GCFlags -> GHC.Word.Word32
- migrate :: ParFlags -> GHC.Types.Bool
- minAllocAreaSize :: GCFlags -> GHC.Word.Word32
- minOldGenSize :: GCFlags -> GHC.Word.Word32
- miscFlags :: RTSFlags -> MiscFlags
- modSelector :: ProfFlags -> GHC.Maybe.Maybe GHC.Base.String
- msecsPerTick :: CCFlags -> GHC.Types.Int
- nCapabilities :: ParFlags -> GHC.Word.Word32
- nonmoving_gc :: DebugFlags -> GHC.Types.Bool
- numIoWorkerThreads :: MiscFlags -> GHC.Word.Word32
- numa :: GCFlags -> GHC.Types.Bool
- numaMask :: GCFlags -> GHC.Types.Word
- nurseryChunkSize :: GCFlags -> GHC.Word.Word32
- oldGenFactor :: GCFlags -> GHC.Types.Double
- parFlags :: RTSFlags -> ParFlags
- parGcEnabled :: ParFlags -> GHC.Types.Bool
- parGcGen :: ParFlags -> GHC.Word.Word32
- parGcLoadBalancingEnabled :: ParFlags -> GHC.Types.Bool
- parGcLoadBalancingGen :: ParFlags -> GHC.Word.Word32
- parGcNoSyncWithIdle :: ParFlags -> GHC.Word.Word32
- parGcThreads :: ParFlags -> GHC.Word.Word32
- pcFreeHeap :: GCFlags -> GHC.Types.Double
- prof :: DebugFlags -> GHC.Types.Bool
- profilerTicks :: CCFlags -> GHC.Types.Int
- profilingFlags :: RTSFlags -> ProfFlags
- retainerSelector :: ProfFlags -> GHC.Maybe.Maybe GHC.Base.String
- returnDecayFactor :: GCFlags -> GHC.Types.Double
- ringBell :: GCFlags -> GHC.Types.Bool
- sanity :: DebugFlags -> GHC.Types.Bool
- scheduler :: DebugFlags -> GHC.Types.Bool
- setAffinity :: ParFlags -> GHC.Types.Bool
- showCCSOnException :: ProfFlags -> GHC.Types.Bool
- showTickyStats :: TickyFlags -> GHC.Types.Bool
- sparks :: DebugFlags -> GHC.Types.Bool
- sparksFull :: TraceFlags -> GHC.Types.Bool
- sparksSampled :: TraceFlags -> GHC.Types.Bool
- squeeze :: DebugFlags -> GHC.Types.Bool
- squeezeUpdFrames :: GCFlags -> GHC.Types.Bool
- stable :: DebugFlags -> GHC.Types.Bool
- startHeapProfileAtStartup :: ProfFlags -> GHC.Types.Bool
- statsFile :: GCFlags -> GHC.Maybe.Maybe GHC.IO.FilePath
- stkChunkBufferSize :: GCFlags -> GHC.Word.Word32
- stkChunkSize :: GCFlags -> GHC.Word.Word32
- stm :: DebugFlags -> GHC.Types.Bool
- sweep :: GCFlags -> GHC.Types.Bool
- tickInterval :: MiscFlags -> RtsTime
- tickyFile :: TickyFlags -> GHC.Maybe.Maybe GHC.IO.FilePath
- tickyFlags :: RTSFlags -> TickyFlags
- timestamp :: TraceFlags -> GHC.Types.Bool
- traceFlags :: RTSFlags -> TraceFlags
- traceGc :: TraceFlags -> GHC.Types.Bool
- traceNonmovingGc :: TraceFlags -> GHC.Types.Bool
- traceScheduler :: TraceFlags -> GHC.Types.Bool
- tracing :: TraceFlags -> DoTrace
- typeSelector :: ProfFlags -> GHC.Maybe.Maybe GHC.Base.String
- user :: TraceFlags -> GHC.Types.Bool
- weak :: DebugFlags -> GHC.Types.Bool
module GHC.Read where
-- Safety: Trustworthy
@@ -9480,13 +9043,11 @@ module GHC.ResponseFile where
module GHC.ST where
-- Safety: Unsafe
- ST :: forall s a. STRep s a -> ST s a
type role ST nominal representational
type ST :: * -> * -> *
newtype ST s a = ST (STRep s a)
type STRep :: * -> * -> *
type STRep s a = GHC.Prim.State# s -> (# GHC.Prim.State# s, a #)
- STret :: forall s a. GHC.Prim.State# s -> a -> STret s a
type role STret nominal representational
type STret :: * -> * -> *
data STret s a = STret (GHC.Prim.State# s) a
@@ -9497,7 +9058,6 @@ module GHC.ST where
module GHC.STRef where
-- Safety: Unsafe
- STRef :: forall s a. GHC.Prim.MutVar# s a -> STRef s a
type role STRef nominal representational
type STRef :: * -> * -> *
data STRef s a = STRef (GHC.Prim.MutVar# s a)
@@ -9534,7 +9094,6 @@ module GHC.Show where
module GHC.Stable where
-- Safety: Unsafe
- StablePtr :: forall a. GHC.Prim.StablePtr# a -> StablePtr a
type StablePtr :: * -> *
data StablePtr a = StablePtr (GHC.Prim.StablePtr# a)
castPtrToStablePtr :: forall a. GHC.Ptr.Ptr () -> StablePtr a
@@ -9545,7 +9104,6 @@ module GHC.Stable where
module GHC.StableName where
-- Safety: Trustworthy
- StableName :: forall a. GHC.Prim.StableName# a -> StableName a
type role StableName phantom
type StableName :: * -> *
data StableName a = StableName (GHC.Prim.StableName# a)
@@ -9563,7 +9121,6 @@ module GHC.Stack where
data CostCentreStack
type HasCallStack :: Constraint
type HasCallStack = ?callStack::CallStack :: Constraint
- SrcLoc :: [GHC.Types.Char] -> [GHC.Types.Char] -> [GHC.Types.Char] -> GHC.Types.Int -> GHC.Types.Int -> GHC.Types.Int -> GHC.Types.Int -> SrcLoc
type SrcLoc :: *
data SrcLoc = SrcLoc {srcLocPackage :: [GHC.Types.Char], srcLocModule :: [GHC.Types.Char], srcLocFile :: [GHC.Types.Char], srcLocStartLine :: GHC.Types.Int, srcLocStartCol :: GHC.Types.Int, srcLocEndLine :: GHC.Types.Int, srcLocEndCol :: GHC.Types.Int}
callStack :: HasCallStack => CallStack
@@ -9587,13 +9144,6 @@ module GHC.Stack where
prettySrcLoc :: SrcLoc -> GHC.Base.String
pushCallStack :: ([GHC.Types.Char], SrcLoc) -> CallStack -> CallStack
renderStack :: [GHC.Base.String] -> GHC.Base.String
- srcLocEndCol :: SrcLoc -> GHC.Types.Int
- srcLocEndLine :: SrcLoc -> GHC.Types.Int
- srcLocFile :: SrcLoc -> [GHC.Types.Char]
- srcLocModule :: SrcLoc -> [GHC.Types.Char]
- srcLocPackage :: SrcLoc -> [GHC.Types.Char]
- srcLocStartCol :: SrcLoc -> GHC.Types.Int
- srcLocStartLine :: SrcLoc -> GHC.Types.Int
whoCreated :: forall a. a -> GHC.Types.IO [GHC.Base.String]
withFrozenCallStack :: forall a. HasCallStack => (HasCallStack => a) -> a
@@ -9618,19 +9168,13 @@ module GHC.Stack.CCS where
module GHC.Stack.CloneStack where
-- Safety: None
- StackEntry :: GHC.Base.String -> GHC.Base.String -> GHC.Base.String -> GHC.Types.Word -> StackEntry
type StackEntry :: *
data StackEntry = StackEntry {functionName :: GHC.Base.String, moduleName :: GHC.Base.String, srcLoc :: GHC.Base.String, closureType :: GHC.Types.Word}
- StackSnapshot :: GHC.Prim.StackSnapshot# -> StackSnapshot
type StackSnapshot :: *
data StackSnapshot = StackSnapshot GHC.Prim.StackSnapshot#
cloneMyStack :: GHC.Types.IO StackSnapshot
cloneThreadStack :: GHC.Conc.Sync.ThreadId -> GHC.Types.IO StackSnapshot
- closureType :: StackEntry -> GHC.Types.Word
decode :: StackSnapshot -> GHC.Types.IO [StackEntry]
- functionName :: StackEntry -> GHC.Base.String
- moduleName :: StackEntry -> GHC.Base.String
- srcLoc :: StackEntry -> GHC.Base.String
module GHC.Stack.Types where
-- Safety: Trustworthy
@@ -9638,7 +9182,6 @@ module GHC.Stack.Types where
data CallStack = EmptyCallStack | PushCallStack [GHC.Types.Char] SrcLoc CallStack | FreezeCallStack CallStack
type HasCallStack :: Constraint
type HasCallStack = ?callStack::CallStack :: Constraint
- SrcLoc :: [GHC.Types.Char] -> [GHC.Types.Char] -> [GHC.Types.Char] -> GHC.Types.Int -> GHC.Types.Int -> GHC.Types.Int -> GHC.Types.Int -> SrcLoc
type SrcLoc :: *
data SrcLoc = SrcLoc {srcLocPackage :: [GHC.Types.Char], srcLocModule :: [GHC.Types.Char], srcLocFile :: [GHC.Types.Char], srcLocStartLine :: GHC.Types.Int, srcLocStartCol :: GHC.Types.Int, srcLocEndLine :: GHC.Types.Int, srcLocEndCol :: GHC.Types.Int}
emptyCallStack :: CallStack
@@ -9646,13 +9189,6 @@ module GHC.Stack.Types where
fromCallSiteList :: [([GHC.Types.Char], SrcLoc)] -> CallStack
getCallStack :: CallStack -> [([GHC.Types.Char], SrcLoc)]
pushCallStack :: ([GHC.Types.Char], SrcLoc) -> CallStack -> CallStack
- srcLocEndCol :: SrcLoc -> GHC.Types.Int
- srcLocEndLine :: SrcLoc -> GHC.Types.Int
- srcLocFile :: SrcLoc -> [GHC.Types.Char]
- srcLocModule :: SrcLoc -> [GHC.Types.Char]
- srcLocPackage :: SrcLoc -> [GHC.Types.Char]
- srcLocStartCol :: SrcLoc -> GHC.Types.Int
- srcLocStartLine :: SrcLoc -> GHC.Types.Int
module GHC.StaticPtr where
-- Safety: None
@@ -9664,13 +9200,9 @@ module GHC.StaticPtr where
type StaticKey = GHC.Fingerprint.Type.Fingerprint
type StaticPtr :: * -> *
data StaticPtr a = ...
- StaticPtrInfo :: GHC.Base.String -> GHC.Base.String -> (GHC.Types.Int, GHC.Types.Int) -> StaticPtrInfo
type StaticPtrInfo :: *
data StaticPtrInfo = StaticPtrInfo {spInfoUnitId :: GHC.Base.String, spInfoModuleName :: GHC.Base.String, spInfoSrcLoc :: (GHC.Types.Int, GHC.Types.Int)}
deRefStaticPtr :: forall a. StaticPtr a -> a
- spInfoModuleName :: StaticPtrInfo -> GHC.Base.String
- spInfoSrcLoc :: StaticPtrInfo -> (GHC.Types.Int, GHC.Types.Int)
- spInfoUnitId :: StaticPtrInfo -> GHC.Base.String
staticKey :: forall a. StaticPtr a -> StaticKey
staticPtrInfo :: forall a. StaticPtr a -> StaticPtrInfo
staticPtrKeys :: GHC.Types.IO [StaticKey]
@@ -9678,7 +9210,6 @@ module GHC.StaticPtr where
module GHC.Stats where
-- Safety: Trustworthy
- GCDetails :: GHC.Word.Word32 -> GHC.Word.Word32 -> GHC.Word.Word64 -> GHC.Word.Word64 -> GHC.Word.Word64 -> GHC.Word.Word64 -> GHC.Word.Word64 -> GHC.Word.Word64 -> GHC.Word.Word64 -> GHC.Word.Word64 -> GHC.Word.Word64 -> GHC.Word.Word64 -> RtsTime -> RtsTime -> RtsTime -> RtsTime -> RtsTime -> GCDetails
type GCDetails :: *
data GCDetails
= GCDetails {gcdetails_gen :: GHC.Word.Word32,
@@ -9698,7 +9229,6 @@ module GHC.Stats where
gcdetails_elapsed_ns :: RtsTime,
gcdetails_nonmoving_gc_sync_cpu_ns :: RtsTime,
gcdetails_nonmoving_gc_sync_elapsed_ns :: RtsTime}
- RTSStats :: GHC.Word.Word32 -> GHC.Word.Word32 -> GHC.Word.Word64 -> GHC.Word.Word64 -> GHC.Word.Word64 -> GHC.Word.Word64 -> GHC.Word.Word64 -> GHC.Word.Word64 -> GHC.Word.Word64 -> GHC.Word.Word64 -> GHC.Word.Word64 -> GHC.Word.Word64 -> GHC.Word.Word64 -> RtsTime -> RtsTime -> RtsTime -> RtsTime -> RtsTime -> RtsTime -> RtsTime -> RtsTime -> RtsTime -> RtsTime -> RtsTime -> RtsTime -> RtsTime -> RtsTime -> GCDetails -> RTSStats
type RTSStats :: *
data RTSStats
= RTSStats {gcs :: GHC.Word.Word32,
@@ -9731,53 +9261,8 @@ module GHC.Stats where
gc :: GCDetails}
type RtsTime :: *
type RtsTime = GHC.Int.Int64
- allocated_bytes :: RTSStats -> GHC.Word.Word64
- copied_bytes :: RTSStats -> GHC.Word.Word64
- cpu_ns :: RTSStats -> RtsTime
- cumulative_live_bytes :: RTSStats -> GHC.Word.Word64
- cumulative_par_balanced_copied_bytes :: RTSStats -> GHC.Word.Word64
- cumulative_par_max_copied_bytes :: RTSStats -> GHC.Word.Word64
- elapsed_ns :: RTSStats -> RtsTime
- gc :: RTSStats -> GCDetails
- gc_cpu_ns :: RTSStats -> RtsTime
- gc_elapsed_ns :: RTSStats -> RtsTime
- gcdetails_allocated_bytes :: GCDetails -> GHC.Word.Word64
- gcdetails_block_fragmentation_bytes :: GCDetails -> GHC.Word.Word64
- gcdetails_compact_bytes :: GCDetails -> GHC.Word.Word64
- gcdetails_copied_bytes :: GCDetails -> GHC.Word.Word64
- gcdetails_cpu_ns :: GCDetails -> RtsTime
- gcdetails_elapsed_ns :: GCDetails -> RtsTime
- gcdetails_gen :: GCDetails -> GHC.Word.Word32
- gcdetails_large_objects_bytes :: GCDetails -> GHC.Word.Word64
- gcdetails_live_bytes :: GCDetails -> GHC.Word.Word64
- gcdetails_mem_in_use_bytes :: GCDetails -> GHC.Word.Word64
- gcdetails_nonmoving_gc_sync_cpu_ns :: GCDetails -> RtsTime
- gcdetails_nonmoving_gc_sync_elapsed_ns :: GCDetails -> RtsTime
- gcdetails_par_balanced_copied_bytes :: GCDetails -> GHC.Word.Word64
- gcdetails_par_max_copied_bytes :: GCDetails -> GHC.Word.Word64
- gcdetails_slop_bytes :: GCDetails -> GHC.Word.Word64
- gcdetails_sync_elapsed_ns :: GCDetails -> RtsTime
- gcdetails_threads :: GCDetails -> GHC.Word.Word32
- gcs :: RTSStats -> GHC.Word.Word32
getRTSStats :: GHC.Types.IO RTSStats
getRTSStatsEnabled :: GHC.Types.IO GHC.Types.Bool
- init_cpu_ns :: RTSStats -> RtsTime
- init_elapsed_ns :: RTSStats -> RtsTime
- major_gcs :: RTSStats -> GHC.Word.Word32
- max_compact_bytes :: RTSStats -> GHC.Word.Word64
- max_large_objects_bytes :: RTSStats -> GHC.Word.Word64
- max_live_bytes :: RTSStats -> GHC.Word.Word64
- max_mem_in_use_bytes :: RTSStats -> GHC.Word.Word64
- max_slop_bytes :: RTSStats -> GHC.Word.Word64
- mutator_cpu_ns :: RTSStats -> RtsTime
- mutator_elapsed_ns :: RTSStats -> RtsTime
- nonmoving_gc_cpu_ns :: RTSStats -> RtsTime
- nonmoving_gc_elapsed_ns :: RTSStats -> RtsTime
- nonmoving_gc_max_elapsed_ns :: RTSStats -> RtsTime
- nonmoving_gc_sync_cpu_ns :: RTSStats -> RtsTime
- nonmoving_gc_sync_elapsed_ns :: RTSStats -> RtsTime
- nonmoving_gc_sync_max_elapsed_ns :: RTSStats -> RtsTime
- par_copied_bytes :: RTSStats -> GHC.Word.Word64
module GHC.Storable where
-- Safety: Trustworthy
@@ -9910,13 +9395,10 @@ module GHC.TypeLits where
type role SSymbol phantom
type SSymbol :: Symbol -> *
newtype SSymbol s = ...
- SomeChar :: forall (n :: GHC.Types.Char). KnownChar n => Data.Proxy.Proxy n -> SomeChar
type SomeChar :: *
data SomeChar = forall (n :: GHC.Types.Char). KnownChar n => SomeChar (Data.Proxy.Proxy n)
- SomeNat :: forall (n :: Nat). KnownNat n => Data.Proxy.Proxy n -> SomeNat
type SomeNat :: *
data SomeNat = forall (n :: Nat). KnownNat n => SomeNat (Data.Proxy.Proxy n)
- SomeSymbol :: forall (n :: Symbol). KnownSymbol n => Data.Proxy.Proxy n -> SomeSymbol
type SomeSymbol :: *
data SomeSymbol = forall (n :: Symbol). KnownSymbol n => SomeSymbol (Data.Proxy.Proxy n)
type Symbol :: *
@@ -9996,7 +9478,6 @@ module GHC.TypeNats where
type role SNat phantom
type SNat :: Nat -> *
newtype SNat n = ...
- SomeNat :: forall (n :: Nat). KnownNat n => Data.Proxy.Proxy n -> SomeNat
type SomeNat :: *
data SomeNat = forall (n :: Nat). KnownNat n => SomeNat (Data.Proxy.Proxy n)
type (^) :: Natural -> Natural -> Natural
@@ -10048,7 +9529,6 @@ module GHC.Unicode where
module GHC.Weak where
-- Safety: Unsafe
- Weak :: forall v. GHC.Prim.Weak# v -> Weak v
type Weak :: * -> *
data Weak v = Weak (GHC.Prim.Weak# v)
deRefWeak :: forall v. Weak v -> GHC.Types.IO (GHC.Maybe.Maybe v)
@@ -10561,7 +10041,6 @@ module System.IO where
data IOMode = ReadMode | WriteMode | AppendMode | ReadWriteMode
type Newline :: *
data Newline = LF | CRLF
- NewlineMode :: Newline -> Newline -> NewlineMode
type NewlineMode :: *
data NewlineMode = NewlineMode {inputNL :: Newline, outputNL :: Newline}
type SeekMode :: *
@@ -10615,7 +10094,6 @@ module System.IO where
hShow :: Handle -> IO GHC.Base.String
hTell :: Handle -> IO GHC.Num.Integer.Integer
hWaitForInput :: Handle -> GHC.Types.Int -> IO GHC.Types.Bool
- inputNL :: NewlineMode -> Newline
interact :: (GHC.Base.String -> GHC.Base.String) -> IO ()
isEOF :: IO GHC.Types.Bool
latin1 :: TextEncoding
@@ -10630,7 +10108,6 @@ module System.IO where
openFile :: FilePath -> IOMode -> IO Handle
openTempFile :: FilePath -> GHC.Base.String -> IO (FilePath, Handle)
openTempFileWithDefaultPermissions :: FilePath -> GHC.Base.String -> IO (FilePath, Handle)
- outputNL :: NewlineMode -> Newline
print :: forall a. GHC.Show.Show a => a -> IO ()
putChar :: GHC.Types.Char -> IO ()
putStr :: GHC.Base.String -> IO ()
@@ -10966,14 +10443,12 @@ module Text.ParserCombinators.ReadPrec where
module Text.Printf where
-- Safety: Safe
- FieldFormat :: GHC.Maybe.Maybe GHC.Types.Int -> GHC.Maybe.Maybe GHC.Types.Int -> GHC.Maybe.Maybe FormatAdjustment -> GHC.Maybe.Maybe FormatSign -> GHC.Types.Bool -> GHC.Base.String -> GHC.Types.Char -> FieldFormat
type FieldFormat :: *
data FieldFormat = FieldFormat {fmtWidth :: GHC.Maybe.Maybe GHC.Types.Int, fmtPrecision :: GHC.Maybe.Maybe GHC.Types.Int, fmtAdjust :: GHC.Maybe.Maybe FormatAdjustment, fmtSign :: GHC.Maybe.Maybe FormatSign, fmtAlternate :: GHC.Types.Bool, fmtModifiers :: GHC.Base.String, fmtChar :: GHC.Types.Char}
type FieldFormatter :: *
type FieldFormatter = FieldFormat -> GHC.Show.ShowS
type FormatAdjustment :: *
data FormatAdjustment = LeftAdjust | ZeroPad
- FormatParse :: GHC.Base.String -> GHC.Types.Char -> GHC.Base.String -> FormatParse
type FormatParse :: *
data FormatParse = FormatParse {fpModifiers :: GHC.Base.String, fpChar :: GHC.Types.Char, fpRest :: GHC.Base.String}
type FormatSign :: *
@@ -11002,21 +10477,11 @@ module Text.Printf where
errorBadFormat :: forall a. GHC.Types.Char -> a
errorMissingArgument :: forall a. a
errorShortFormat :: forall a. a
- fmtAdjust :: FieldFormat -> GHC.Maybe.Maybe FormatAdjustment
- fmtAlternate :: FieldFormat -> GHC.Types.Bool
- fmtChar :: FieldFormat -> GHC.Types.Char
- fmtModifiers :: FieldFormat -> GHC.Base.String
- fmtPrecision :: FieldFormat -> GHC.Maybe.Maybe GHC.Types.Int
- fmtSign :: FieldFormat -> GHC.Maybe.Maybe FormatSign
- fmtWidth :: FieldFormat -> GHC.Maybe.Maybe GHC.Types.Int
formatChar :: GHC.Types.Char -> FieldFormatter
formatInt :: forall a. (GHC.Real.Integral a, GHC.Enum.Bounded a) => a -> FieldFormatter
formatInteger :: GHC.Num.Integer.Integer -> FieldFormatter
formatRealFloat :: forall a. GHC.Float.RealFloat a => a -> FieldFormatter
formatString :: forall a. IsChar a => [a] -> FieldFormatter
- fpChar :: FormatParse -> GHC.Types.Char
- fpModifiers :: FormatParse -> GHC.Base.String
- fpRest :: FormatParse -> GHC.Base.String
hPrintf :: forall r. HPrintfType r => GHC.IO.Handle.Types.Handle -> GHC.Base.String -> r
perror :: forall a. GHC.Base.String -> a
printf :: forall r. PrintfType r => GHC.Base.String -> r
@@ -11068,7 +10533,7 @@ module Text.Read where
module Text.Read.Lex where
-- Safety: Trustworthy
type Lexeme :: *
- data Lexeme = Char GHC.Types.Char | String GHC.Base.String | Punc GHC.Base.String | Ident GHC.Base.String | Symbol GHC.Base.String | ... | EOF
+ data Lexeme = Char GHC.Types.Char | String GHC.Base.String | Punc GHC.Base.String | Ident GHC.Base.String | Symbol GHC.Base.String | Number Number | EOF
type Number :: *
data Number = ...
expect :: Lexeme -> Text.ParserCombinators.ReadP.ReadP ()
@@ -11121,7 +10586,6 @@ module Type.Reflection where
pattern Fun :: forall k (fun :: k). () => forall (r1 :: GHC.Types.RuntimeRep) (r2 :: GHC.Types.RuntimeRep) (arg :: TYPE r1) (res :: TYPE r2). (k ~ *, fun ~~ (arg -> res)) => TypeRep arg -> TypeRep res -> TypeRep fun
type Module :: *
data Module = ...
- SomeTypeRep :: forall k (a :: k). TypeRep a -> SomeTypeRep
type SomeTypeRep :: *
data SomeTypeRep where
SomeTypeRep :: forall k (a :: k). !(TypeRep a) -> SomeTypeRep
=====================================
utils/dump-decls/Main.hs
=====================================
@@ -13,7 +13,7 @@ import GHC.Types.Unique.Set (nonDetEltsUniqSet)
import GHC.Types.TyThing (tyThingParent_maybe)
import GHC.Types.TyThing.Ppr (pprTyThing)
import GHC.Types.Name (nameOccName, nameModule_maybe, stableNameCmp)
-import GHC.Types.Name.Occurrence (OccName, OccSet, mkOccSet, elemOccSet)
+import GHC.Types.Name.Occurrence (OccName)
import GHC.Unit.External (eps_inst_env)
import GHC.Iface.Syntax (ShowSub(..), ShowHowMuch(..), AltPpr(..))
import GHC.Iface.Type (ShowForAllFlag(..))
@@ -127,11 +127,11 @@ reportModuleDecls modl_nm
let names = GHC.modInfoExports mod_info
sorted_names = sortBy (compare `on` nameOccName) names
- exported_occs :: OccSet
- exported_occs = mkOccSet $ map nameOccName names
+ exported_occs :: [OccName]
+ exported_occs = map nameOccName names
is_exported :: OccName -> Bool
- is_exported = (`elemOccSet` exported_occs)
+ is_exported = (`elem` exported_occs)
things <- mapM GHC.lookupName sorted_names
let contents = vcat $
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dc7ca88b0bec358b5f57affda1514cc74b3337fc
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dc7ca88b0bec358b5f57affda1514cc74b3337fc
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/20230516/65e91484/attachment-0001.html>
More information about the ghc-commits
mailing list