[Git][ghc/ghc][wip/base-stability] 8 commits: base: Introduce Data.Enum
Ben Gamari (@bgamari)
gitlab at gitlab.haskell.org
Thu May 11 01:46:46 UTC 2023
Ben Gamari pushed to branch wip/base-stability at Glasgow Haskell Compiler / GHC
Commits:
9bb86f04 by Ben Gamari at 2023-05-10T19:40:21-04:00
base: Introduce Data.Enum
- - - - -
682aca44 by Ben Gamari at 2023-05-10T19:40:21-04:00
base: Add export list to GHC.Num.Integer
- - - - -
6fa50500 by Ben Gamari at 2023-05-10T19:40:21-04:00
base: Add export list to GHC.Num
- - - - -
bfac7c16 by Ben Gamari at 2023-05-10T19:40:21-04:00
base: Add export list to GHC.Num.Natural
- - - - -
d0bbbc05 by Ben Gamari at 2023-05-10T19:40:21-04:00
base: Introduce Data.Show
- - - - -
86237fa6 by Ben Gamari at 2023-05-10T21:01:04-04:00
base: Add export list to GHC.Float
- - - - -
efc8c431 by Ben Gamari at 2023-05-10T21:01:04-04:00
base: Add export list to GHC.Real
- - - - -
ee8acc6a by Ben Gamari at 2023-05-10T21:01:04-04:00
base: Eliminate module reexport in GHC.Exception
- - - - -
9 changed files:
- + libraries/base/Data/Enum.hs
- + libraries/base/Data/Show.hs
- libraries/base/GHC/Exception.hs
- libraries/base/GHC/Float.hs
- libraries/base/GHC/Num.hs
- libraries/base/GHC/Real.hs
- libraries/base/base.cabal
- libraries/ghc-bignum/src/GHC/Num/Integer.hs
- libraries/ghc-bignum/src/GHC/Num/Natural.hs
Changes:
=====================================
libraries/base/Data/Enum.hs
=====================================
@@ -0,0 +1,22 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module : Data.Enum
+-- Copyright : (c) The University of Glasgow, 1992-2002
+-- License : see libraries/base/LICENSE
+--
+-- Maintainer : cvs-ghc at haskell.org
+-- Stability : stable
+-- Portability : non-portable (GHC extensions)
+--
+-- The 'Enum' and 'Bounded' classes.
+--
+-----------------------------------------------------------------------------
+
+module Data.Enum
+ ( Bounded(..)
+ , Enum(..)
+ ) where
+
+import GHC.Enum
=====================================
libraries/base/Data/Show.hs
=====================================
@@ -0,0 +1,28 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module : Data.Show
+-- Copyright : (c) The University of Glasgow, 1992-2002
+-- License : see libraries/base/LICENSE
+--
+-- Maintainer : cvs-ghc at haskell.org
+-- Stability : stable
+-- Portability : non-portable (GHC extensions)
+--
+-- The 'Show' class.
+--
+-----------------------------------------------------------------------------
+
+module Data.Show
+ ( Show(..)
+ -- * 'ShowS'
+ , ShowS
+ , shows
+ , showChar, showString, showMultiLineString
+ , showParen, showCommaSpace, showSpace
+ , showLitChar, showLitString
+ ) where
+
+import GHC.Show
+
=====================================
libraries/base/GHC/Exception.hs
=====================================
@@ -23,16 +23,33 @@
-----------------------------------------------------------------------------
module GHC.Exception
- ( module GHC.Exception.Type
- , throw
- , ErrorCall(..,ErrorCall)
- , errorCallException
- , errorCallWithCallStackException
- -- re-export CallStack and SrcLoc from GHC.Types
- , CallStack, fromCallSiteList, getCallStack, prettyCallStack
- , prettyCallStackLines, showCCSStack
- , SrcLoc(..), prettySrcLoc
- ) where
+ ( -- * 'Exception' class
+ Exception(..)
+
+ -- * 'SomeException'
+ , SomeException(..)
+
+ -- * Throwing
+ , throw
+
+ -- * Concrete exceptions
+ -- ** Arithmetic exceptions
+ , ArithException(..)
+ , divZeroException
+ , overflowException
+ , ratioZeroDenomException
+ , underflowException
+ -- ** 'ErrorCall'
+ , ErrorCall(..,ErrorCall)
+ , errorCallException
+ , errorCallWithCallStackException
+
+ -- * Reexports
+ -- Re-export CallStack and SrcLoc from GHC.Types
+ , CallStack, fromCallSiteList, getCallStack, prettyCallStack
+ , prettyCallStackLines, showCCSStack
+ , SrcLoc(..), prettySrcLoc
+ ) where
import GHC.Base
import GHC.Show
=====================================
libraries/base/GHC/Float.hs
=====================================
@@ -45,14 +45,99 @@
module GHC.Float
- ( module GHC.Float
- , Float(..), Double(..), Float#, Double#
- , double2Int, int2Double, float2Int, int2Float
-
- -- * Monomorphic equality operators
- -- | See GHC.Classes#matching_overloaded_methods_in_rules
- , eqFloat, eqDouble
- ) where
+ ( -- * Classes
+ Floating(..)
+ , RealFloat(..)
+
+ -- * 'Float'
+ , Float(..), Float#
+ -- ** Conversion
+ , float2Int, int2Float
+ , integerToFloat#
+ , naturalToFloat#
+ , rationalToFloat
+ , castWord32ToFloat
+ , castFloatToWord32
+ , float2Double
+ -- ** Operations
+ , floorFloat
+ , ceilingFloat
+ , roundFloat
+ , properFractionFloat
+ -- ** Predicate
+ , isFloatDenormalized
+ , isFloatFinite
+ , isFloatInfinite
+ , isFloatNaN
+ , isFloatNegativeZero
+ -- ** Comparison
+ , gtFloat, geFloat, leFloat, ltFloat
+ -- ** Arithmetic
+ , plusFloat, minusFloat, timesFloat, divideFloat
+ , negateFloat
+ , expFloat, expm1Float
+ , logFloat, log1pFloat, sqrtFloat, fabsFloat
+ , sinFloat, cosFloat, tanFloat
+ , asinFloat, acosFloat, atanFloat
+ , sinhFloat, coshFloat, tanhFloat
+ , asinhFloat, acoshFloat, atanhFloat
+
+ -- * 'Double'
+ , Double(..)
+ , Double#
+ -- ** Conversion
+ , double2Int
+ , int2Double
+ , integerToDouble#
+ , naturalToDouble#
+ , rationalToDouble
+ , castWord64ToDouble
+ , castDoubleToWord64
+ , double2Float
+ -- ** Operations
+ , floorDouble
+ , ceilingDouble
+ , truncateDouble
+ , roundDouble
+ , properFractionDouble
+ -- ** Predicate
+ , isDoubleDenormalized
+ , isDoubleFinite
+ , isDoubleInfinite
+ , isDoubleNaN
+ , isDoubleNegativeZero
+ -- ** Comparison
+ , gtDouble, geDouble, leDouble, ltDouble
+ -- ** Arithmetic
+ , plusDouble, minusDouble, timesDouble, divideDouble
+ , negateDouble
+ , expDouble, expm1Double
+ , logDouble, log1pDouble, sqrtDouble, fabsDouble
+ , sinDouble, cosDouble, tanDouble
+ , asinDouble, acosDouble, atanDouble
+ , sinhDouble, coshDouble, tanhDouble
+ , asinhDouble, acoshDouble, atanhDouble
+
+ -- * Formatting
+ , showFloat
+ , FFFormat(..)
+ , formatRealFloat
+ , formatRealFloatAlt
+ , showSignedFloat
+
+ -- * Operations
+ , log1mexpOrd
+ , roundTo
+ , floatToDigits
+ , integerToBinaryFloat'
+ , fromRat
+ , fromRat'
+ , roundingMode#
+
+ -- * Monomorphic equality operators
+ -- | See GHC.Classes#matching_overloaded_methods_in_rules
+ , eqFloat, eqDouble
+ ) where
import Data.Maybe
=====================================
libraries/base/GHC/Num.hs
=====================================
@@ -18,7 +18,9 @@
module GHC.Num
- ( module GHC.Num
+ ( Num(..)
+ , subtract
+ , quotRemInteger
, module GHC.Num.Integer
, module GHC.Num.Natural
-- reexported for backward compatibility
=====================================
libraries/base/GHC/Real.hs
=====================================
@@ -18,7 +18,66 @@
--
-----------------------------------------------------------------------------
-module GHC.Real where
+module GHC.Real
+ ( -- * Classes
+ Real(..)
+ , Integral(..)
+ , Fractional(..)
+ , RealFrac(..)
+
+ -- * Conversion
+ , fromIntegral
+ , realToFrac
+
+ -- * Formatting
+ , showSigned
+
+ -- * Predicates
+ , even
+ , odd
+
+ -- * Arithmetic
+ , (^)
+ , (^^)
+ , gcd
+ , lcm
+
+ -- * 'Ratio'
+ , Ratio(..)
+ , Rational
+ , infinity
+ , notANumber
+
+ -- * 'Enum' helpers
+ , numericEnumFrom
+ , numericEnumFromThen
+ , numericEnumFromTo
+ , numericEnumFromThenTo
+ , integralEnumFrom
+ , integralEnumFromThen
+ , integralEnumFromTo
+ , integralEnumFromThenTo
+
+ -- ** Construction
+ , (%)
+
+ -- ** Projection
+ , numerator
+ , denominator
+
+ -- ** Operations
+ , reduce
+
+ -- * Internal
+ , ratioPrec
+ , ratioPrec1
+ , divZeroError
+ , ratioZeroDenominatorError
+ , overflowError
+ , underflowError
+ , mkRationalBase2
+ , mkRationalBase10
+ ) where
#include "MachDeps.h"
=====================================
libraries/base/base.cabal
=====================================
@@ -127,6 +127,7 @@ Library
Data.Dynamic
Data.Either
Data.Eq
+ Data.Enum
Data.Fixed
Data.Foldable
Data.Foldable1
@@ -151,6 +152,7 @@ Library
Data.Proxy
Data.Ratio
Data.Semigroup
+ Data.Show
Data.STRef
Data.STRef.Lazy
Data.STRef.Strict
=====================================
libraries/ghc-bignum/src/GHC/Num/Integer.hs
=====================================
@@ -20,7 +20,131 @@
--
-- The 'Integer' type.
-module GHC.Num.Integer where
+module GHC.Num.Integer
+ ( Integer(..)
+ , integerCheck
+ , integerCheck#
+
+ -- * Useful constants
+ , integerZero
+ , integerOne
+
+ -- * Conversion with...
+ -- ** 'Int'
+ , integerFromInt#
+ , integerFromInt
+ , integerToInt#
+ , integerToInt
+ -- ** 'BigNat'
+ , integerFromBigNat#
+ , integerFromBigNatNeg#
+ , integerFromBigNatSign#
+ , integerToBigNatSign#
+ , integerToBigNatClamp#
+ -- ** 'Word'
+ , integerFromWord#
+ , integerFromWord
+ , integerFromWordNeg#
+ , integerFromWordSign#
+ , integerToWord#
+ , integerToWord
+ -- ** 'Natural'
+ , integerFromNatural
+ , integerToNaturalClamp
+ , integerToNatural
+ , integerToNaturalThrow
+ -- ** 'Int64'/'Word64'
+ , integerFromInt64#
+ , integerFromWord64#
+ , integerToInt64#
+ , integerToWord64#
+ -- ** Floating-point
+ , integerDecodeDouble#
+ , integerEncodeDouble#
+ , integerEncodeDouble
+ , integerEncodeFloat#
+ -- ** 'Addr#'
+ , integerToAddr#
+ , integerToAddr
+ , integerFromAddr#
+ , integerFromAddr
+ -- ** Limbs
+ , integerFromWordList
+ , integerToMutableByteArray#
+ , integerToMutableByteArray
+ , integerFromByteArray#
+ , integerFromByteArray
+
+ -- * Predicates
+ , integerIsNegative#
+ , integerIsNegative
+ , integerIsZero
+ , integerIsOne
+
+ -- * Comparison
+ , integerNe
+ , integerEq
+ , integerLe
+ , integerLt
+ , integerGt
+ , integerGe
+ , integerEq#
+ , integerNe#
+ , integerGt#
+ , integerLe#
+ , integerLt#
+ , integerGe#
+ , integerCompare
+
+ -- * Arithmetic
+ , integerSub
+ , integerAdd
+ , integerMul
+ , integerNegate
+ , integerAbs
+ , integerSignum
+ , integerSignum#
+ , integerQuotRem#
+ , integerQuotRem
+ , integerQuot
+ , integerRem
+ , integerDivMod#
+ , integerDivMod
+ , integerDiv
+ , integerMod
+ , integerGcd
+ , integerLcm
+ , integerSqr
+ , integerLog2#
+ , integerLog2
+ , integerLogBaseWord#
+ , integerLogBaseWord
+ , integerLogBase#
+ , integerLogBase
+ , integerIsPowerOf2#
+ , integerGcde#
+ , integerGcde
+ , integerRecipMod#
+ , integerPowMod#
+
+ -- * Bit operations
+ , integerPopCount#
+ , integerBit#
+ , integerBit
+ , integerTestBit#
+ , integerTestBit
+ , integerShiftR#
+ , integerShiftR
+ , integerShiftL#
+ , integerShiftL
+ , integerOr
+ , integerXor
+ , integerAnd
+ , integerComplement
+
+ -- * Miscellaneous
+ , integerSizeInBase#
+ ) where
#include "MachDeps.h"
#include "WordSize.h"
=====================================
libraries/ghc-bignum/src/GHC/Num/Natural.hs
=====================================
@@ -8,7 +8,109 @@
#include "MachDeps.h"
#include "WordSize.h"
-module GHC.Num.Natural where
+module GHC.Num.Natural
+ ( Natural(..)
+ , naturalCheck#
+ , naturalCheck
+
+ -- * Useful constants
+ , naturalZero
+ , naturalOne
+
+ -- * Predicates
+ , naturalIsZero
+ , naturalIsOne
+ , naturalIsPowerOf2#
+
+ -- * Conversion with...
+ -- ** 'BigNat'
+ , naturalFromBigNat#
+ , naturalToBigNat#
+ -- ** 'Word'
+ , naturalFromWord#
+ , naturalFromWord2#
+ , naturalFromWord
+ , naturalToWord#
+ , naturalToWord
+ , naturalToWordClamp#
+ , naturalToWordClamp
+ , naturalToWordMaybe#
+ -- ** Limbs
+ , naturalFromWordList
+ , naturalToMutableByteArray#
+ , naturalFromByteArray#
+ -- ** Floating point
+ , naturalEncodeDouble#
+ , naturalEncodeFloat#
+ -- ** 'Addr#'
+ , naturalToAddr#
+ , naturalToAddr
+ , naturalFromAddr#
+ , naturalFromAddr
+
+ -- * Comparison
+ , naturalEq#
+ , naturalEq
+ , naturalNe#
+ , naturalNe
+ , naturalGe#
+ , naturalGe
+ , naturalLe#
+ , naturalLe
+ , naturalGt#
+ , naturalGt
+ , naturalLt#
+ , naturalLt
+ , naturalCompare
+
+ -- * Bit operations
+ , naturalPopCount#
+ , naturalPopCount
+ , naturalShiftR#
+ , naturalShiftR
+ , naturalShiftL#
+ , naturalShiftL
+ , naturalAnd
+ , naturalAndNot
+ , naturalOr
+ , naturalXor
+ , naturalTestBit#
+ , naturalTestBit
+ , naturalBit#
+ , naturalBit
+ , naturalSetBit#
+ , naturalSetBit
+ , naturalClearBit#
+ , naturalClearBit
+ , naturalComplementBit#
+ , naturalComplementBit
+
+ -- * Arithmetic
+ , naturalAdd
+ , naturalSub
+ , naturalSubThrow
+ , naturalSubUnsafe
+ , naturalMul
+ , naturalSqr
+ , naturalSignum
+ , naturalNegate
+ , naturalQuotRem#
+ , naturalQuotRem
+ , naturalQuot
+ , naturalRem
+ , naturalGcd
+ , naturalLcm
+ , naturalLog2#
+ , naturalLog2
+ , naturalLogBaseWord#
+ , naturalLogBaseWord
+ , naturalLogBase#
+ , naturalLogBase
+ , naturalPowMod
+
+ -- * Miscellaneous
+ , naturalSizeInBase#
+ ) where
import GHC.Prim
import GHC.Types
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b4780d9128709b7556f5a4ec5e6fdeb5ab6ee46e...ee8acc6a23af4bd521636a715641a2da5b1f8eb0
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b4780d9128709b7556f5a4ec5e6fdeb5ab6ee46e...ee8acc6a23af4bd521636a715641a2da5b1f8eb0
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/20230510/0ef75005/attachment-0001.html>
More information about the ghc-commits
mailing list