Commit 2f6a0ac7 authored by Simon Peyton Jones's avatar Simon Peyton Jones

Move IP, Symbol, Nat to ghc-prim

This motivation is to declare class IP much earlier (in ghc-prim),
so that implicit parameters (which depend on IP) is available
to library code, notably the 'error' function.

* Move class IP from base:GHC.IP
                to ghc-prim:GHC.Classes
* Delete module GHC.IP from base

* Move types Symbol and Nat
      from base:GHC.TypeLits
      to ghc-prim:GHC.Types

There was a name clash in GHC.RTS.Flags, where I renamed
the local type Nat to RtsNat.
parent de5d022e
......@@ -407,7 +407,7 @@ gHC_PRIM, gHC_TYPES, gHC_GENERICS, gHC_MAGIC,
tYPEABLE, tYPEABLE_INTERNAL, gENERICS,
rEAD_PREC, lEX, gHC_INT, gHC_WORD, mONAD, mONAD_FIX, mONAD_ZIP,
aRROW, cONTROL_APPLICATIVE, gHC_DESUGAR, rANDOM, gHC_EXTS,
cONTROL_EXCEPTION_BASE, gHC_TYPELITS, gHC_IP :: Module
cONTROL_EXCEPTION_BASE, gHC_TYPELITS :: Module
gHC_PRIM = mkPrimModule (fsLit "GHC.Prim") -- Primitive types and values
gHC_TYPES = mkPrimModule (fsLit "GHC.Types")
......@@ -461,7 +461,6 @@ gHC_EXTS = mkBaseModule (fsLit "GHC.Exts")
cONTROL_EXCEPTION_BASE = mkBaseModule (fsLit "Control.Exception.Base")
gHC_GENERICS = mkBaseModule (fsLit "GHC.Generics")
gHC_TYPELITS = mkBaseModule (fsLit "GHC.TypeLits")
gHC_IP = mkBaseModule (fsLit "GHC.IP")
gHC_PARR' :: Module
gHC_PARR' = mkBaseModule (fsLit "GHC.PArr")
......@@ -1195,7 +1194,7 @@ knownSymbolClassName = clsQual gHC_TYPELITS (fsLit "KnownSymbol") knownSymbolCl
-- Implicit parameters
ipClassName :: Name
ipClassName = clsQual gHC_IP (fsLit "IP") ipClassNameKey
ipClassName = clsQual gHC_CLASSES (fsLit "IP") ipClassNameKey
-- Source Locations
callStackDataConName, callStackTyConName, srcLocDataConName :: Name
......
......@@ -204,8 +204,8 @@ doubleDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "D#")
-- Kinds
typeNatKindConName, typeSymbolKindConName :: Name
typeNatKindConName = mkWiredInTyConName UserSyntax gHC_TYPELITS (fsLit "Nat") typeNatKindConNameKey typeNatKindCon
typeSymbolKindConName = mkWiredInTyConName UserSyntax gHC_TYPELITS (fsLit "Symbol") typeSymbolKindConNameKey typeSymbolKindCon
typeNatKindConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Nat") typeNatKindConNameKey typeNatKindCon
typeSymbolKindConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Symbol") typeSymbolKindConNameKey typeSymbolKindCon
parrTyConName, parrDataConName :: Name
parrTyConName = mkWiredInTyConName BuiltInSyntax
......
{-# LANGUAGE Safe #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
-- ip :: IP x a => a is strictly speaking ambiguous, but IP is magic
-- | @since 4.6.0.0
module GHC.IP (IP(..)) where
import GHC.TypeLits
-- | The syntax @?x :: a@ is desugared into @IP "x" a@
class IP (x :: Symbol) a | x -> a where
ip :: a
......@@ -51,7 +51,7 @@ import GHC.Word
type Time = Word64
-- | @'nat'@ defined in @rts/Types.h@
type Nat = #{type unsigned int}
type RtsNat = #{type unsigned int}
data GiveGCStats
= NoGCStats
......@@ -78,19 +78,19 @@ instance Enum GiveGCStats where
data GCFlags = GCFlags
{ statsFile :: Maybe FilePath
, giveStats :: GiveGCStats
, maxStkSize :: Nat
, initialStkSize :: Nat
, stkChunkSize :: Nat
, stkChunkBufferSize :: Nat
, maxHeapSize :: Nat
, minAllocAreaSize :: Nat
, minOldGenSize :: Nat
, heapSizeSuggestion :: Nat
, maxStkSize :: RtsNat
, initialStkSize :: RtsNat
, stkChunkSize :: RtsNat
, stkChunkBufferSize :: RtsNat
, maxHeapSize :: RtsNat
, minAllocAreaSize :: RtsNat
, minOldGenSize :: RtsNat
, heapSizeSuggestion :: RtsNat
, heapSizeSuggestionAuto :: Bool
, oldGenFactor :: Double
, pcFreeHeap :: Double
, generations :: Nat
, steps :: Nat
, generations :: RtsNat
, steps :: RtsNat
, squeezeUpdFrames :: Bool
, compact :: Bool -- ^ True <=> "compact all the time"
, compactThreshold :: Double
......@@ -305,7 +305,7 @@ getGCFlags = do
ptr <- getGcFlagsPtr
GCFlags <$> (peekFilePath =<< #{peek GC_FLAGS, statsFile} ptr)
<*> (toEnum . fromIntegral <$>
(#{peek GC_FLAGS, giveStats} ptr :: IO Nat))
(#{peek GC_FLAGS, giveStats} ptr :: IO RtsNat))
<*> #{peek GC_FLAGS, maxStkSize} ptr
<*> #{peek GC_FLAGS, initialStkSize} ptr
<*> #{peek GC_FLAGS, stkChunkSize} ptr
......@@ -367,7 +367,7 @@ getCCFlags :: IO CCFlags
getCCFlags = do
ptr <- getCcFlagsPtr
CCFlags <$> (toEnum . fromIntegral
<$> (#{peek COST_CENTRE_FLAGS, doCostCentres} ptr :: IO Nat))
<$> (#{peek COST_CENTRE_FLAGS, doCostCentres} ptr :: IO RtsNat))
<*> #{peek COST_CENTRE_FLAGS, profilerTicks} ptr
<*> #{peek COST_CENTRE_FLAGS, msecsPerTick} ptr
......
......@@ -22,7 +22,7 @@ for working with type-level naturals should be defined in a separate library.
module GHC.TypeLits
( -- * Kinds
Nat, Symbol
Nat, Symbol -- Both declared in GHC.Types in package ghc-prim
-- * Linking type and value level
, KnownNat, natVal, natVal'
......@@ -39,6 +39,7 @@ module GHC.TypeLits
) where
import GHC.Base(Eq(..), Ord(..), Bool(True,False), Ordering(..), otherwise)
import GHC.Types( Nat, Symbol )
import GHC.Num(Integer)
import GHC.Base(String)
import GHC.Show(Show(..))
......@@ -49,13 +50,6 @@ import Data.Proxy (Proxy(..))
import Data.Type.Equality(type (==), (:~:)(Refl))
import Unsafe.Coerce(unsafeCoerce)
-- | (Kind) This is the kind of type-level natural numbers.
data Nat
-- | (Kind) This is the kind of type-level symbols.
data Symbol
--------------------------------------------------------------------------------
-- | This class gives the integer associated with a type-level natural.
......
......@@ -231,7 +231,6 @@ Library
GHC.IO.IOMode
GHC.IOArray
GHC.IORef
GHC.IP
GHC.Int
GHC.List
GHC.MVar
......
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE NoImplicitPrelude, MagicHash, StandaloneDeriving, BangPatterns #-}
{-# LANGUAGE NoImplicitPrelude, MagicHash, StandaloneDeriving, BangPatterns,
KindSignatures, DataKinds, MultiParamTypeClasses, FunctionalDependencies #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
-- ip :: IP x a => a is strictly speaking ambiguous, but IP is magic
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
-- XXX -fno-warn-unused-imports needed for the GHC.Tuple import below. Sigh.
{-# OPTIONS_HADDOCK hide #-}
......@@ -17,7 +21,13 @@
--
-----------------------------------------------------------------------------
module GHC.Classes where
module GHC.Classes(
IP(..),
Eq(..), eqInt, neInt,
Ord(..), gtInt, geInt, leInt, ltInt, compareInt, compareInt#,
(&&), (||), not,
divInt#, modInt#
) where
-- GHC.Magic is used in some derived instances
import GHC.Magic ()
......@@ -32,6 +42,13 @@ infixr 2 ||
default () -- Double isn't available yet
-- | The syntax @?x :: a@ is desugared into @IP "x" a@
-- IP is declared very early, so that libraries can take
-- advantage of the implicit-call-stack feature
class IP (x :: Symbol) a | x -> a where
ip :: a
-- | The 'Eq' class defines equality ('==') and inequality ('/=').
-- All the basic datatypes exported by the "Prelude" are instances of 'Eq',
-- and 'Eq' may be derived for any datatype whose constituents are also
......
......@@ -22,6 +22,7 @@ module GHC.Types (
Ordering(..), IO(..),
isTrue#,
SPEC(..),
Nat, Symbol,
Coercible,
) where
......@@ -30,6 +31,13 @@ import GHC.Prim
infixr 5 :
-- | (Kind) This is the kind of type-level natural numbers.
data Nat
-- | (Kind) This is the kind of type-level symbols.
-- Declared here because class IP needs it
data Symbol
data [] a = [] | a : [a]
data {-# CTYPE "HsBool" #-} Bool = False | True
......
type family (*) (a :: Nat) (b :: Nat) :: Nat
type family (+) (a :: Nat) (b :: Nat) :: Nat
type family (-) (a :: Nat) (b :: Nat) :: Nat
type (<=) (x :: Nat) (y :: Nat) = (x <=? y) ~ 'True
type family (<=?) (a :: Nat) (b :: Nat) :: Bool
type family CmpNat (a :: Nat) (b :: Nat) :: Ordering
type family CmpSymbol (a :: Symbol) (b :: Symbol) :: Ordering
class KnownNat (n :: Nat) where
natSing :: SNat n
class KnownSymbol (n :: Symbol) where
symbolSing :: SSymbol n
data Nat
data SomeNat where
SomeNat :: KnownNat n => (Proxy n) -> SomeNat
data SomeSymbol where
SomeSymbol :: KnownSymbol n => (Proxy n) -> SomeSymbol
data Symbol
type family (^) (a :: Nat) (b :: Nat) :: Nat
natVal :: KnownNat n => proxy n -> Integer
natVal' :: KnownNat n => Proxy# n -> Integer
sameNat ::
(KnownNat a, KnownNat b) => Proxy a -> Proxy b -> Maybe (a :~: b)
sameSymbol ::
(KnownSymbol a, KnownSymbol b) =>
Proxy a -> Proxy b -> Maybe (a :~: b)
someNatVal :: Integer -> Maybe SomeNat
someSymbolVal :: String -> SomeSymbol
symbolVal :: KnownSymbol n => proxy n -> String
symbolVal' :: KnownSymbol n => Proxy# n -> String
type family (*) (a :: Nat) (b :: Nat) :: Nat
type family (+) (a :: Nat) (b :: Nat) :: Nat
type family (-) (a :: Nat) (b :: Nat) :: Nat
type (<=) (x :: Nat) (y :: Nat) = (x <=? y) ~ 'True
type family (<=?) (a :: Nat) (b :: Nat) :: Bool
type family CmpNat (a :: Nat) (b :: Nat) :: Ordering
type family CmpSymbol (a :: Symbol) (b :: Symbol) :: Ordering
class KnownNat (n :: Nat) where
natSing :: SNat n
class KnownSymbol (n :: Symbol) where
symbolSing :: SSymbol n
data SomeNat where
SomeNat :: KnownNat n => (Proxy n) -> SomeNat
data SomeSymbol where
SomeSymbol :: KnownSymbol n => (Proxy n) -> SomeSymbol
type family (^) (a :: Nat) (b :: Nat) :: Nat
natVal :: KnownNat n => proxy n -> Integer
natVal' :: KnownNat n => Proxy# n -> Integer
sameNat ::
(KnownNat a, KnownNat b) => Proxy a -> Proxy b -> Maybe (a :~: b)
sameSymbol ::
(KnownSymbol a, KnownSymbol b) =>
Proxy a -> Proxy b -> Maybe (a :~: b)
someNatVal :: Integer -> Maybe SomeNat
someSymbolVal :: String -> SomeSymbol
symbolVal :: KnownSymbol n => proxy n -> String
symbolVal' :: KnownSymbol n => Proxy# n -> String
data Nat
data Symbol
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment