[Git][ghc/ghc][wip/andreask/interpreter_primops] 4 commits: Fix unary ops
by Andreas Klebinger (@AndreasK) 16 Apr '25
by Andreas Klebinger (@AndreasK) 16 Apr '25
16 Apr '25
Andreas Klebinger pushed to branch wip/andreask/interpreter_primops at Glasgow Haskell Compiler / GHC
Commits:
1f7f27e6 by Andreas Klebinger at 2025-04-14T23:22:13+02:00
Fix unary ops
- - - - -
903e5965 by Andreas Klebinger at 2025-04-15T00:02:58+02:00
Fix shift op
- - - - -
a6e0e0aa by Andreas Klebinger at 2025-04-16T20:12:18+02:00
Fix macro parantheses
- - - - -
12f61803 by Andreas Klebinger at 2025-04-17T00:09:50+02:00
More testing
- - - - -
6 changed files:
- compiler/GHC/Builtin/primops.txt.pp
- compiler/GHC/StgToByteCode.hs
- rts/Interpreter.c
- testsuite/tests/numeric/should_run/foundation.hs
- utils/genprimopcode/Main.hs
- utils/genprimopcode/Syntax.hs
Changes:
=====================================
compiler/GHC/Builtin/primops.txt.pp
=====================================
@@ -147,6 +147,7 @@ defaults
fixity = Nothing
vector = []
deprecated_msg = {} -- A non-empty message indicates deprecation
+ div_like = False -- Second argument expected to be non zero - used for tests
-- Note [When do out-of-line primops go in primops.txt.pp]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -296,14 +297,18 @@ primop Int8MulOp "timesInt8#" GenPrimOp Int8# -> Int8# -> Int8#
primop Int8QuotOp "quotInt8#" GenPrimOp Int8# -> Int8# -> Int8#
with
effect = CanFail
+ div_like = True
primop Int8RemOp "remInt8#" GenPrimOp Int8# -> Int8# -> Int8#
with
effect = CanFail
+ div_like = True
+
primop Int8QuotRemOp "quotRemInt8#" GenPrimOp Int8# -> Int8# -> (# Int8#, Int8# #)
with
effect = CanFail
+ div_like = True
primop Int8SllOp "uncheckedShiftLInt8#" GenPrimOp Int8# -> Int# -> Int8#
primop Int8SraOp "uncheckedShiftRAInt8#" GenPrimOp Int8# -> Int# -> Int8#
@@ -342,14 +347,17 @@ primop Word8MulOp "timesWord8#" GenPrimOp Word8# -> Word8# -> Word8#
primop Word8QuotOp "quotWord8#" GenPrimOp Word8# -> Word8# -> Word8#
with
effect = CanFail
+ div_like = True
primop Word8RemOp "remWord8#" GenPrimOp Word8# -> Word8# -> Word8#
with
effect = CanFail
+ div_like = True
primop Word8QuotRemOp "quotRemWord8#" GenPrimOp Word8# -> Word8# -> (# Word8#, Word8# #)
with
effect = CanFail
+ div_like = True
primop Word8AndOp "andWord8#" GenPrimOp Word8# -> Word8# -> Word8#
with commutable = True
@@ -400,14 +408,17 @@ primop Int16MulOp "timesInt16#" GenPrimOp Int16# -> Int16# -> Int16#
primop Int16QuotOp "quotInt16#" GenPrimOp Int16# -> Int16# -> Int16#
with
effect = CanFail
+ div_like = True
primop Int16RemOp "remInt16#" GenPrimOp Int16# -> Int16# -> Int16#
with
effect = CanFail
+ div_like = True
primop Int16QuotRemOp "quotRemInt16#" GenPrimOp Int16# -> Int16# -> (# Int16#, Int16# #)
with
effect = CanFail
+ div_like = True
primop Int16SllOp "uncheckedShiftLInt16#" GenPrimOp Int16# -> Int# -> Int16#
primop Int16SraOp "uncheckedShiftRAInt16#" GenPrimOp Int16# -> Int# -> Int16#
@@ -446,14 +457,17 @@ primop Word16MulOp "timesWord16#" GenPrimOp Word16# -> Word16# -> Word16#
primop Word16QuotOp "quotWord16#" GenPrimOp Word16# -> Word16# -> Word16#
with
effect = CanFail
+ div_like = True
primop Word16RemOp "remWord16#" GenPrimOp Word16# -> Word16# -> Word16#
with
effect = CanFail
+ div_like = True
primop Word16QuotRemOp "quotRemWord16#" GenPrimOp Word16# -> Word16# -> (# Word16#, Word16# #)
with
effect = CanFail
+ div_like = True
primop Word16AndOp "andWord16#" GenPrimOp Word16# -> Word16# -> Word16#
with commutable = True
@@ -504,14 +518,17 @@ primop Int32MulOp "timesInt32#" GenPrimOp Int32# -> Int32# -> Int32#
primop Int32QuotOp "quotInt32#" GenPrimOp Int32# -> Int32# -> Int32#
with
effect = CanFail
+ div_like = True
primop Int32RemOp "remInt32#" GenPrimOp Int32# -> Int32# -> Int32#
with
effect = CanFail
+ div_like = True
primop Int32QuotRemOp "quotRemInt32#" GenPrimOp Int32# -> Int32# -> (# Int32#, Int32# #)
with
effect = CanFail
+ div_like = True
primop Int32SllOp "uncheckedShiftLInt32#" GenPrimOp Int32# -> Int# -> Int32#
primop Int32SraOp "uncheckedShiftRAInt32#" GenPrimOp Int32# -> Int# -> Int32#
@@ -550,14 +567,17 @@ primop Word32MulOp "timesWord32#" GenPrimOp Word32# -> Word32# -> Word32#
primop Word32QuotOp "quotWord32#" GenPrimOp Word32# -> Word32# -> Word32#
with
effect = CanFail
+ div_like = True
primop Word32RemOp "remWord32#" GenPrimOp Word32# -> Word32# -> Word32#
with
effect = CanFail
+ div_like = True
primop Word32QuotRemOp "quotRemWord32#" GenPrimOp Word32# -> Word32# -> (# Word32#, Word32# #)
with
effect = CanFail
+ div_like = True
primop Word32AndOp "andWord32#" GenPrimOp Word32# -> Word32# -> Word32#
with commutable = True
@@ -608,10 +628,12 @@ primop Int64MulOp "timesInt64#" GenPrimOp Int64# -> Int64# -> Int64#
primop Int64QuotOp "quotInt64#" GenPrimOp Int64# -> Int64# -> Int64#
with
effect = CanFail
+ div_like = True
primop Int64RemOp "remInt64#" GenPrimOp Int64# -> Int64# -> Int64#
with
effect = CanFail
+ div_like = True
primop Int64SllOp "uncheckedIShiftL64#" GenPrimOp Int64# -> Int# -> Int64#
primop Int64SraOp "uncheckedIShiftRA64#" GenPrimOp Int64# -> Int# -> Int64#
@@ -650,10 +672,12 @@ primop Word64MulOp "timesWord64#" GenPrimOp Word64# -> Word64# -> Word64#
primop Word64QuotOp "quotWord64#" GenPrimOp Word64# -> Word64# -> Word64#
with
effect = CanFail
+ div_like = True
primop Word64RemOp "remWord64#" GenPrimOp Word64# -> Word64# -> Word64#
with
effect = CanFail
+ div_like = True
primop Word64AndOp "and64#" GenPrimOp Word64# -> Word64# -> Word64#
with commutable = True
@@ -737,6 +761,7 @@ primop IntQuotOp "quotInt#" GenPrimOp
zero.
}
with effect = CanFail
+ div_like = True
primop IntRemOp "remInt#" GenPrimOp
Int# -> Int# -> Int#
@@ -744,11 +769,13 @@ primop IntRemOp "remInt#" GenPrimOp
behavior is undefined if the second argument is zero.
}
with effect = CanFail
+ div_like = True
primop IntQuotRemOp "quotRemInt#" GenPrimOp
Int# -> Int# -> (# Int#, Int# #)
{Rounds towards zero.}
with effect = CanFail
+ div_like = True
primop IntAndOp "andI#" GenPrimOp Int# -> Int# -> Int#
{Bitwise "and".}
@@ -886,19 +913,23 @@ primop WordMul2Op "timesWord2#" GenPrimOp
primop WordQuotOp "quotWord#" GenPrimOp Word# -> Word# -> Word#
with effect = CanFail
+ div_like = True
primop WordRemOp "remWord#" GenPrimOp Word# -> Word# -> Word#
with effect = CanFail
+ div_like = True
primop WordQuotRemOp "quotRemWord#" GenPrimOp
Word# -> Word# -> (# Word#, Word# #)
with effect = CanFail
+ div_like = True
primop WordQuotRem2Op "quotRemWord2#" GenPrimOp
Word# -> Word# -> Word# -> (# Word#, Word# #)
{ Takes high word of dividend, then low word of dividend, then divisor.
Requires that high word < divisor.}
with effect = CanFail
+ div_like = True
primop WordAndOp "and#" GenPrimOp Word# -> Word# -> Word#
with commutable = True
@@ -4166,6 +4197,7 @@ primop VecQuotOp "quot#" GenPrimOp
Do not expect high performance. }
with effect = CanFail
vector = INT_VECTOR_TYPES
+ div_like = True
primop VecRemOp "rem#" GenPrimOp
VECTOR -> VECTOR -> VECTOR
@@ -4175,6 +4207,8 @@ primop VecRemOp "rem#" GenPrimOp
Do not expect high performance. }
with effect = CanFail
vector = INT_VECTOR_TYPES
+ div_like = True
+
primop VecNegOp "negate#" GenPrimOp
VECTOR -> VECTOR
=====================================
compiler/GHC/StgToByteCode.hs
=====================================
@@ -857,6 +857,17 @@ doPrimOp platform op init_d s p args =
Word8AddOp -> sizedPrimOp OP_ADD
AddrAddOp -> sizedPrimOp OP_ADD
+ IntMulOp -> sizedPrimOp OP_MUL
+ Int64MulOp -> sizedPrimOp OP_MUL
+ Int32MulOp -> sizedPrimOp OP_MUL
+ Int16MulOp -> sizedPrimOp OP_MUL
+ Int8MulOp -> sizedPrimOp OP_MUL
+ WordMulOp -> sizedPrimOp OP_MUL
+ Word64MulOp -> sizedPrimOp OP_MUL
+ Word32MulOp -> sizedPrimOp OP_MUL
+ Word16MulOp -> sizedPrimOp OP_MUL
+ Word8MulOp -> sizedPrimOp OP_MUL
+
IntSubOp -> sizedPrimOp OP_SUB
WordSubOp -> sizedPrimOp OP_SUB
Int64SubOp -> sizedPrimOp OP_SUB
@@ -1009,20 +1020,20 @@ doPrimOp platform op init_d s p args =
Int16NegOp -> sizedPrimOp OP_NEG
Int8NegOp -> sizedPrimOp OP_NEG
- IntToWordOp -> no_op
- WordToIntOp -> no_op
- Int8ToWord8Op -> no_op
- Word8ToInt8Op -> no_op
- Int16ToWord16Op -> no_op
- Word16ToInt16Op -> no_op
- Int32ToWord32Op -> no_op
- Word32ToInt32Op -> no_op
- Int64ToWord64Op -> no_op
- Word64ToInt64Op -> no_op
- IntToAddrOp -> no_op
- AddrToIntOp -> no_op
- ChrOp -> no_op -- Int# and Char# are rep'd the same
- OrdOp -> no_op
+ IntToWordOp -> mk_conv (platformWordWidth platform)
+ WordToIntOp -> mk_conv (platformWordWidth platform)
+ Int8ToWord8Op -> mk_conv W8
+ Word8ToInt8Op -> mk_conv W8
+ Int16ToWord16Op -> mk_conv W16
+ Word16ToInt16Op -> mk_conv W16
+ Int32ToWord32Op -> mk_conv W32
+ Word32ToInt32Op -> mk_conv W32
+ Int64ToWord64Op -> mk_conv W64
+ Word64ToInt64Op -> mk_conv W64
+ IntToAddrOp -> mk_conv (platformWordWidth platform)
+ AddrToIntOp -> mk_conv (platformWordWidth platform)
+ ChrOp -> mk_conv (platformWordWidth platform) -- Int# and Char# are rep'd the same
+ OrdOp -> mk_conv (platformWordWidth platform)
IndexOffAddrOp_Word8 -> primOpWithRep (OP_INDEX_ADDR W8) W8
IndexOffAddrOp_Word16 -> primOpWithRep (OP_INDEX_ADDR W16) W16
@@ -1031,6 +1042,7 @@ doPrimOp platform op init_d s p args =
_ -> Nothing
where
+ primArg1Width :: StgArg -> Width
primArg1Width arg
| rep <- (stgArgRepU arg)
= case rep of
@@ -1080,43 +1092,12 @@ doPrimOp platform op init_d s p args =
let slide = mkSlideW (mkSlideWords width) (bytesToWords platform $ init_d - s) `snocOL` mkNReturn width
return $ prim_code `appOL` slide
- no_op = Just $ do
+ mk_conv :: Width -> Maybe (BcM (OrdList BCInstr))
+ mk_conv target_width = Just $ do
let width = primArg1Width (head args)
- prim_code <- terribleNoOp init_d s p undefined args
- let slide = mkSlideW (mkSlideWords width) (bytesToWords platform $ init_d - s) `snocOL` mkNReturn width
- return $ prim_code `appOL` slide
-
--- It's horrible, but still better than calling intToWord ...
-terribleNoOp
- :: StackDepth
- -> Sequel
- -> BCEnv
- -> BCInstr -- The operator
- -> [StgArg] -- Args, in *reverse* order (must be fully applied)
- -> BcM BCInstrList
-terribleNoOp orig_d _ p _ args = app_code
- where
- app_code = do
- profile <- getProfile
- let --platform = profilePlatform profile
-
- non_voids =
- addArgReps (assertNonVoidStgArgs args)
- (_, _, args_offsets) =
- mkVirtHeapOffsetsWithPadding profile StdHeader non_voids
-
- do_pushery !d (arg : args) = do
- (push, arg_bytes) <- case arg of
- (Padding l _) -> return $! pushPadding (ByteOff l)
- (FieldOff a _) -> pushConstrAtom d p (fromNonVoid a)
- more_push_code <- do_pushery (d + arg_bytes) args
- return (push `appOL` more_push_code)
- do_pushery !_d [] = do
- -- let !n_arg_words = bytesToWords platform (d - orig_d)
- return (nilOL)
-
- -- Push on the stack in the reverse order.
- do_pushery orig_d (reverse args_offsets)
+ (push_code, _bytes) <- pushAtom init_d p (head args)
+ let slide = mkSlideW (mkSlideWords width) (bytesToWords platform $ init_d - s) `snocOL` mkNReturn target_width
+ return $ push_code `appOL` slide
-- Push the arguments on the stack and emit the given instruction
-- Pushes one word per non void arg.
=====================================
rts/Interpreter.c
=====================================
@@ -249,9 +249,9 @@ See ticket #25750
#define SafeSpWP(n) \
((StgWord*) ((WITHIN_CAP_CHUNK_BOUNDS_W(n)) ? Sp_plusW(n) : slow_spw(Sp, cap->r.rCurrentTSO->stackobj, n)))
#define SafeSpBP(off_w) \
- ( (StgWord*) (WITHIN_CAP_CHUNK_BOUNDS_W(1+off_w/sizeof(StgWord))) ? \
+ ( (StgWord*) (WITHIN_CAP_CHUNK_BOUNDS_W((1+(off_w))/sizeof(StgWord))) ? \
Sp_plusB(off_w) : \
- (StgWord*) ((ptrdiff_t)(off_w % sizeof(StgWord)) + (StgWord8*)slow_spw(Sp, cap->r.rCurrentTSO->stackobj, off_w/sizeof(StgWord))))
+ (StgWord*) ((ptrdiff_t)((off_w) % sizeof(StgWord)) + (StgWord8*)slow_spw(Sp, cap->r.rCurrentTSO->stackobj, (off_w)/sizeof(StgWord))))
@@ -2270,10 +2270,10 @@ run_BCO:
#define UN_SIZED_OP(op,ty) \
{ \
if(sizeof(ty) == 8) { \
- ty r = op (*(ty*) ReadSpW64(0)); \
+ ty r = op ((ty) ReadSpW64(0)); \
SpW64(0) = (StgWord64) r; \
} else { \
- ty r = op (*(ty*) ReadSpW(0)); \
+ ty r = op ((ty) ReadSpW(0)); \
SpW(0) = (StgWord) r; \
} \
goto nextInsn; \
@@ -2293,15 +2293,30 @@ run_BCO:
goto nextInsn; \
}
+// op :: ty -> Int -> ty
+#define SIZED_BIN_OP_TY_INT(op,ty) \
+{ \
+ if(sizeof(ty) > sizeof(StgWord)) { \
+ ty r = ((ty) ReadSpW64(0)) op ((ty) ReadSpW(2)); \
+ Sp_addW(1); \
+ SpW64(0) = (StgWord64) r; \
+ } else { \
+ ty r = ((ty) ReadSpW(0)) op ((ty) ReadSpW(1)); \
+ Sp_addW(1); \
+ SpW(0) = (StgWord) r; \
+ }; \
+ goto nextInsn; \
+}
+
case bci_OP_ADD_64: SIZED_BIN_OP(+, StgInt64)
case bci_OP_SUB_64: SIZED_BIN_OP(-, StgInt64)
case bci_OP_AND_64: SIZED_BIN_OP(&, StgInt64)
case bci_OP_XOR_64: SIZED_BIN_OP(^, StgInt64)
case bci_OP_OR_64: SIZED_BIN_OP(|, StgInt64)
case bci_OP_MUL_64: SIZED_BIN_OP(*, StgInt64)
- case bci_OP_SHL_64: SIZED_BIN_OP(<<, StgWord64)
- case bci_OP_LSR_64: SIZED_BIN_OP(>>, StgWord64)
- case bci_OP_ASR_64: SIZED_BIN_OP(>>, StgInt64)
+ case bci_OP_SHL_64: SIZED_BIN_OP_TY_INT(<<, StgWord64)
+ case bci_OP_LSR_64: SIZED_BIN_OP_TY_INT(>>, StgWord64)
+ case bci_OP_ASR_64: SIZED_BIN_OP_TY_INT(>>, StgInt64)
case bci_OP_NEQ_64: SIZED_BIN_OP(!=, StgWord64)
case bci_OP_EQ_64: SIZED_BIN_OP(==, StgWord64)
@@ -2325,9 +2340,9 @@ run_BCO:
case bci_OP_XOR_32: SIZED_BIN_OP(^, StgInt32)
case bci_OP_OR_32: SIZED_BIN_OP(|, StgInt32)
case bci_OP_MUL_32: SIZED_BIN_OP(*, StgInt32)
- case bci_OP_SHL_32: SIZED_BIN_OP(<<, StgWord32)
- case bci_OP_LSR_32: SIZED_BIN_OP(>>, StgWord32)
- case bci_OP_ASR_32: SIZED_BIN_OP(>>, StgInt32)
+ case bci_OP_SHL_32: SIZED_BIN_OP_TY_INT(<<, StgWord32)
+ case bci_OP_LSR_32: SIZED_BIN_OP_TY_INT(>>, StgWord32)
+ case bci_OP_ASR_32: SIZED_BIN_OP_TY_INT(>>, StgInt32)
case bci_OP_NEQ_32: SIZED_BIN_OP(!=, StgWord32)
case bci_OP_EQ_32: SIZED_BIN_OP(==, StgWord32)
@@ -2351,9 +2366,9 @@ run_BCO:
case bci_OP_XOR_16: SIZED_BIN_OP(^, StgInt16)
case bci_OP_OR_16: SIZED_BIN_OP(|, StgInt16)
case bci_OP_MUL_16: SIZED_BIN_OP(*, StgInt16)
- case bci_OP_SHL_16: SIZED_BIN_OP(<<, StgWord16)
- case bci_OP_LSR_16: SIZED_BIN_OP(>>, StgWord16)
- case bci_OP_ASR_16: SIZED_BIN_OP(>>, StgInt16)
+ case bci_OP_SHL_16: SIZED_BIN_OP_TY_INT(<<, StgWord16)
+ case bci_OP_LSR_16: SIZED_BIN_OP_TY_INT(>>, StgWord16)
+ case bci_OP_ASR_16: SIZED_BIN_OP_TY_INT(>>, StgInt16)
case bci_OP_NEQ_16: SIZED_BIN_OP(!=, StgWord16)
case bci_OP_EQ_16: SIZED_BIN_OP(==, StgWord16)
@@ -2377,9 +2392,9 @@ run_BCO:
case bci_OP_XOR_08: SIZED_BIN_OP(^, StgInt8)
case bci_OP_OR_08: SIZED_BIN_OP(|, StgInt8)
case bci_OP_MUL_08: SIZED_BIN_OP(*, StgInt8)
- case bci_OP_SHL_08: SIZED_BIN_OP(<<, StgWord8)
- case bci_OP_LSR_08: SIZED_BIN_OP(>>, StgWord8)
- case bci_OP_ASR_08: SIZED_BIN_OP(>>, StgInt8)
+ case bci_OP_SHL_08: SIZED_BIN_OP_TY_INT(<<, StgWord8)
+ case bci_OP_LSR_08: SIZED_BIN_OP_TY_INT(>>, StgWord8)
+ case bci_OP_ASR_08: SIZED_BIN_OP_TY_INT(>>, StgInt8)
case bci_OP_NEQ_08: SIZED_BIN_OP(!=, StgWord8)
case bci_OP_EQ_08: SIZED_BIN_OP(==, StgWord8)
=====================================
testsuite/tests/numeric/should_run/foundation.hs
=====================================
@@ -1,3 +1,8 @@
+{- PARTS OF THIS FILE ARE SEMI-AUTOGENERATED.
+ You can re-generate them by invoking the genprimops utility with --foundation-tests
+ and then integrating the output in this file.
+-}
+
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
@@ -19,6 +24,7 @@ import Data.Typeable
import Data.Proxy
import GHC.Int
import GHC.Word
+import GHC.Word
import Data.Function
import GHC.Prim
import Control.Monad.Reader
@@ -108,6 +114,17 @@ arbitraryWord64 = Gen $ do
h <- ask
liftIO (randomWord64 h)
+nonZero :: (Arbitrary a, Num a, Eq a) => Gen (NonZero a)
+nonZero = do
+ x <- arbitrary
+ if x == 0 then nonZero else pure $ NonZero x
+
+newtype NonZero a = NonZero { getNonZero :: a }
+ deriving (Eq,Ord,Bounded,Show)
+
+instance (Arbitrary a, Num a, Eq a) => Arbitrary (NonZero a) where
+ arbitrary = nonZero
+
instance Arbitrary Natural where
arbitrary = integralDownsize . (`mod` 10000) . abs <$> arbitraryInt64
@@ -138,10 +155,10 @@ instance Arbitrary Int8 where
instance Arbitrary Char where
arbitrary = do
- let low = fromEnum (minBound :: Char)
- high = fromEnum (maxBound :: Char)
- x <- arbitrary
- if x >= low && x <= high then return (chr x) else arbitrary
+ let high = fromIntegral $ fromEnum (maxBound :: Char) :: Word
+ (x::Word) <- arbitrary
+ let x' = mod x high
+ return (chr $ fromIntegral x')
int64ToInt :: Int64 -> Int
int64ToInt (I64# i) = I# (int64ToInt# i)
@@ -277,9 +294,8 @@ testMultiplicative _ = Group "Multiplicative"
testDividible :: forall a . (Show a, Eq a, Integral a, Num a, Arbitrary a, Typeable a)
=> Proxy a -> Test
testDividible _ = Group "Divisible"
- [ Property "(x `div` y) * y + (x `mod` y) == x" $ \(a :: a) b ->
- if b == 0 then True === True
- else a === (a `div` b) * b + (a `mod` b)
+ [ Property "(x `div` y) * y + (x `mod` y) == x" $ \(a :: a) (NonZero b) ->
+ a === (a `div` b) * b + (a `mod` b)
]
testOperatorPrecedence :: forall a . (Show a, Eq a, Prelude.Num a, Integral a, Num a, Arbitrary a, Typeable a)
@@ -368,6 +384,9 @@ wInt64# = I64#
class TestPrimop f where
testPrimop :: String -> f -> f -> Test
+ testPrimopDivLike :: String -> f -> f -> Test
+ testPrimopDivLike _ _ _ = error "Div testing not supported for this type."
+
{-
instance TestPrimop (Int# -> Int# -> Int#) where
testPrimop s l r = Property s $ \(uInt -> a1) (uInt -> a2) -> (wInt (l a1 a2)) === wInt (r a1 a2)
@@ -383,6 +402,9 @@ instance TestPrimop (Word# -> Int# -> Word#) where
-}
+twoNonZero :: (a -> a -> b) -> a -> NonZero a -> b
+twoNonZero f x (NonZero y) = f x y
+
main = runTests (Group "ALL" [testNumberRefs, testPrimops])
-- Test an interpreted primop vs a compiled primop
@@ -400,9 +422,9 @@ testPrimops = Group "primop"
, testPrimop "plusInt8#" Primop.plusInt8# Wrapper.plusInt8#
, testPrimop "subInt8#" Primop.subInt8# Wrapper.subInt8#
, testPrimop "timesInt8#" Primop.timesInt8# Wrapper.timesInt8#
- , testPrimop "quotInt8#" Primop.quotInt8# Wrapper.quotInt8#
- , testPrimop "remInt8#" Primop.remInt8# Wrapper.remInt8#
- , testPrimop "quotRemInt8#" Primop.quotRemInt8# Wrapper.quotRemInt8#
+ , testPrimopDivLike "quotInt8#" Primop.quotInt8# Wrapper.quotInt8#
+ , testPrimopDivLike "remInt8#" Primop.remInt8# Wrapper.remInt8#
+ , testPrimopDivLike "quotRemInt8#" Primop.quotRemInt8# Wrapper.quotRemInt8#
, testPrimop "uncheckedShiftLInt8#" Primop.uncheckedShiftLInt8# Wrapper.uncheckedShiftLInt8#
, testPrimop "uncheckedShiftRAInt8#" Primop.uncheckedShiftRAInt8# Wrapper.uncheckedShiftRAInt8#
, testPrimop "uncheckedShiftRLInt8#" Primop.uncheckedShiftRLInt8# Wrapper.uncheckedShiftRLInt8#
@@ -418,9 +440,9 @@ testPrimops = Group "primop"
, testPrimop "plusWord8#" Primop.plusWord8# Wrapper.plusWord8#
, testPrimop "subWord8#" Primop.subWord8# Wrapper.subWord8#
, testPrimop "timesWord8#" Primop.timesWord8# Wrapper.timesWord8#
- , testPrimop "quotWord8#" Primop.quotWord8# Wrapper.quotWord8#
- , testPrimop "remWord8#" Primop.remWord8# Wrapper.remWord8#
- , testPrimop "quotRemWord8#" Primop.quotRemWord8# Wrapper.quotRemWord8#
+ , testPrimopDivLike "quotWord8#" Primop.quotWord8# Wrapper.quotWord8#
+ , testPrimopDivLike "remWord8#" Primop.remWord8# Wrapper.remWord8#
+ , testPrimopDivLike "quotRemWord8#" Primop.quotRemWord8# Wrapper.quotRemWord8#
, testPrimop "andWord8#" Primop.andWord8# Wrapper.andWord8#
, testPrimop "orWord8#" Primop.orWord8# Wrapper.orWord8#
, testPrimop "xorWord8#" Primop.xorWord8# Wrapper.xorWord8#
@@ -440,9 +462,9 @@ testPrimops = Group "primop"
, testPrimop "plusInt16#" Primop.plusInt16# Wrapper.plusInt16#
, testPrimop "subInt16#" Primop.subInt16# Wrapper.subInt16#
, testPrimop "timesInt16#" Primop.timesInt16# Wrapper.timesInt16#
- , testPrimop "quotInt16#" Primop.quotInt16# Wrapper.quotInt16#
- , testPrimop "remInt16#" Primop.remInt16# Wrapper.remInt16#
- , testPrimop "quotRemInt16#" Primop.quotRemInt16# Wrapper.quotRemInt16#
+ , testPrimopDivLike "quotInt16#" Primop.quotInt16# Wrapper.quotInt16#
+ , testPrimopDivLike "remInt16#" Primop.remInt16# Wrapper.remInt16#
+ , testPrimopDivLike "quotRemInt16#" Primop.quotRemInt16# Wrapper.quotRemInt16#
, testPrimop "uncheckedShiftLInt16#" Primop.uncheckedShiftLInt16# Wrapper.uncheckedShiftLInt16#
, testPrimop "uncheckedShiftRAInt16#" Primop.uncheckedShiftRAInt16# Wrapper.uncheckedShiftRAInt16#
, testPrimop "uncheckedShiftRLInt16#" Primop.uncheckedShiftRLInt16# Wrapper.uncheckedShiftRLInt16#
@@ -458,9 +480,9 @@ testPrimops = Group "primop"
, testPrimop "plusWord16#" Primop.plusWord16# Wrapper.plusWord16#
, testPrimop "subWord16#" Primop.subWord16# Wrapper.subWord16#
, testPrimop "timesWord16#" Primop.timesWord16# Wrapper.timesWord16#
- , testPrimop "quotWord16#" Primop.quotWord16# Wrapper.quotWord16#
- , testPrimop "remWord16#" Primop.remWord16# Wrapper.remWord16#
- , testPrimop "quotRemWord16#" Primop.quotRemWord16# Wrapper.quotRemWord16#
+ , testPrimopDivLike "quotWord16#" Primop.quotWord16# Wrapper.quotWord16#
+ , testPrimopDivLike "remWord16#" Primop.remWord16# Wrapper.remWord16#
+ , testPrimopDivLike "quotRemWord16#" Primop.quotRemWord16# Wrapper.quotRemWord16#
, testPrimop "andWord16#" Primop.andWord16# Wrapper.andWord16#
, testPrimop "orWord16#" Primop.orWord16# Wrapper.orWord16#
, testPrimop "xorWord16#" Primop.xorWord16# Wrapper.xorWord16#
@@ -480,9 +502,9 @@ testPrimops = Group "primop"
, testPrimop "plusInt32#" Primop.plusInt32# Wrapper.plusInt32#
, testPrimop "subInt32#" Primop.subInt32# Wrapper.subInt32#
, testPrimop "timesInt32#" Primop.timesInt32# Wrapper.timesInt32#
- , testPrimop "quotInt32#" Primop.quotInt32# Wrapper.quotInt32#
- , testPrimop "remInt32#" Primop.remInt32# Wrapper.remInt32#
- , testPrimop "quotRemInt32#" Primop.quotRemInt32# Wrapper.quotRemInt32#
+ , testPrimopDivLike "quotInt32#" Primop.quotInt32# Wrapper.quotInt32#
+ , testPrimopDivLike "remInt32#" Primop.remInt32# Wrapper.remInt32#
+ , testPrimopDivLike "quotRemInt32#" Primop.quotRemInt32# Wrapper.quotRemInt32#
, testPrimop "uncheckedShiftLInt32#" Primop.uncheckedShiftLInt32# Wrapper.uncheckedShiftLInt32#
, testPrimop "uncheckedShiftRAInt32#" Primop.uncheckedShiftRAInt32# Wrapper.uncheckedShiftRAInt32#
, testPrimop "uncheckedShiftRLInt32#" Primop.uncheckedShiftRLInt32# Wrapper.uncheckedShiftRLInt32#
@@ -498,9 +520,9 @@ testPrimops = Group "primop"
, testPrimop "plusWord32#" Primop.plusWord32# Wrapper.plusWord32#
, testPrimop "subWord32#" Primop.subWord32# Wrapper.subWord32#
, testPrimop "timesWord32#" Primop.timesWord32# Wrapper.timesWord32#
- , testPrimop "quotWord32#" Primop.quotWord32# Wrapper.quotWord32#
- , testPrimop "remWord32#" Primop.remWord32# Wrapper.remWord32#
- , testPrimop "quotRemWord32#" Primop.quotRemWord32# Wrapper.quotRemWord32#
+ , testPrimopDivLike "quotWord32#" Primop.quotWord32# Wrapper.quotWord32#
+ , testPrimopDivLike "remWord32#" Primop.remWord32# Wrapper.remWord32#
+ , testPrimopDivLike "quotRemWord32#" Primop.quotRemWord32# Wrapper.quotRemWord32#
, testPrimop "andWord32#" Primop.andWord32# Wrapper.andWord32#
, testPrimop "orWord32#" Primop.orWord32# Wrapper.orWord32#
, testPrimop "xorWord32#" Primop.xorWord32# Wrapper.xorWord32#
@@ -520,8 +542,8 @@ testPrimops = Group "primop"
, testPrimop "plusInt64#" Primop.plusInt64# Wrapper.plusInt64#
, testPrimop "subInt64#" Primop.subInt64# Wrapper.subInt64#
, testPrimop "timesInt64#" Primop.timesInt64# Wrapper.timesInt64#
- , testPrimop "quotInt64#" Primop.quotInt64# Wrapper.quotInt64#
- , testPrimop "remInt64#" Primop.remInt64# Wrapper.remInt64#
+ , testPrimopDivLike "quotInt64#" Primop.quotInt64# Wrapper.quotInt64#
+ , testPrimopDivLike "remInt64#" Primop.remInt64# Wrapper.remInt64#
, testPrimop "uncheckedIShiftL64#" Primop.uncheckedIShiftL64# Wrapper.uncheckedIShiftL64#
, testPrimop "uncheckedIShiftRA64#" Primop.uncheckedIShiftRA64# Wrapper.uncheckedIShiftRA64#
, testPrimop "uncheckedIShiftRL64#" Primop.uncheckedIShiftRL64# Wrapper.uncheckedIShiftRL64#
@@ -537,8 +559,8 @@ testPrimops = Group "primop"
, testPrimop "plusWord64#" Primop.plusWord64# Wrapper.plusWord64#
, testPrimop "subWord64#" Primop.subWord64# Wrapper.subWord64#
, testPrimop "timesWord64#" Primop.timesWord64# Wrapper.timesWord64#
- , testPrimop "quotWord64#" Primop.quotWord64# Wrapper.quotWord64#
- , testPrimop "remWord64#" Primop.remWord64# Wrapper.remWord64#
+ , testPrimopDivLike "quotWord64#" Primop.quotWord64# Wrapper.quotWord64#
+ , testPrimopDivLike "remWord64#" Primop.remWord64# Wrapper.remWord64#
, testPrimop "and64#" Primop.and64# Wrapper.and64#
, testPrimop "or64#" Primop.or64# Wrapper.or64#
, testPrimop "xor64#" Primop.xor64# Wrapper.xor64#
@@ -557,9 +579,9 @@ testPrimops = Group "primop"
, testPrimop "*#" (Primop.*#) (Wrapper.*#)
, testPrimop "timesInt2#" Primop.timesInt2# Wrapper.timesInt2#
, testPrimop "mulIntMayOflo#" Primop.mulIntMayOflo# Wrapper.mulIntMayOflo#
- , testPrimop "quotInt#" Primop.quotInt# Wrapper.quotInt#
- , testPrimop "remInt#" Primop.remInt# Wrapper.remInt#
- , testPrimop "quotRemInt#" Primop.quotRemInt# Wrapper.quotRemInt#
+ , testPrimopDivLike "quotInt#" Primop.quotInt# Wrapper.quotInt#
+ , testPrimopDivLike "remInt#" Primop.remInt# Wrapper.remInt#
+ , testPrimopDivLike "quotRemInt#" Primop.quotRemInt# Wrapper.quotRemInt#
, testPrimop "andI#" Primop.andI# Wrapper.andI#
, testPrimop "orI#" Primop.orI# Wrapper.orI#
, testPrimop "xorI#" Primop.xorI# Wrapper.xorI#
@@ -585,10 +607,9 @@ testPrimops = Group "primop"
, testPrimop "minusWord#" Primop.minusWord# Wrapper.minusWord#
, testPrimop "timesWord#" Primop.timesWord# Wrapper.timesWord#
, testPrimop "timesWord2#" Primop.timesWord2# Wrapper.timesWord2#
- , testPrimop "quotWord#" Primop.quotWord# Wrapper.quotWord#
- , testPrimop "remWord#" Primop.remWord# Wrapper.remWord#
- , testPrimop "quotRemWord#" Primop.quotRemWord# Wrapper.quotRemWord#
--- , testPrimop "quotRemWord2#" Primop.quotRemWord2# Wrapper.quotRemWord2#
+ , testPrimopDivLike "quotWord#" Primop.quotWord# Wrapper.quotWord#
+ , testPrimopDivLike "remWord#" Primop.remWord# Wrapper.remWord#
+ , testPrimopDivLike "quotRemWord#" Primop.quotRemWord# Wrapper.quotRemWord#
, testPrimop "and#" Primop.and# Wrapper.and#
, testPrimop "or#" Primop.or# Wrapper.or#
, testPrimop "xor#" Primop.xor# Wrapper.xor#
@@ -652,12 +673,15 @@ instance TestPrimop (Char# -> Int#) where
instance TestPrimop (Int# -> Int# -> Int#) where
testPrimop s l r = Property s $ \ (uInt#-> x0) (uInt#-> x1) -> wInt# (l x0 x1) === wInt# (r x0 x1)
+ testPrimopDivLike s l r = Property s $ twoNonZero $ \ (uInt#-> x0) (uInt#-> x1) -> wInt# (l x0 x1) === wInt# (r x0 x1)
instance TestPrimop (Int# -> Int# -> (# Int#,Int# #)) where
testPrimop s l r = Property s $ \ (uInt#-> x0) (uInt#-> x1) -> WTUP2(wInt#,wInt#, (l x0 x1)) === WTUP2(wInt#,wInt#, (r x0 x1))
+ testPrimopDivLike s l r = Property s $ twoNonZero $ \ (uInt#-> x0) (uInt#-> x1) -> WTUP2(wInt#,wInt#, (l x0 x1)) === WTUP2(wInt#,wInt#, (r x0 x1))
instance TestPrimop (Int# -> Int# -> (# Int#,Int#,Int# #)) where
testPrimop s l r = Property s $ \ (uInt#-> x0) (uInt#-> x1) -> WTUP3(wInt#,wInt#,wInt#, (l x0 x1)) === WTUP3(wInt#,wInt#,wInt#, (r x0 x1))
+ testPrimopDivLike s l r = Property s $ twoNonZero $ \ (uInt#-> x0) (uInt#-> x1) -> WTUP3(wInt#,wInt#,wInt#, (l x0 x1)) === WTUP3(wInt#,wInt#,wInt#, (r x0 x1))
instance TestPrimop (Int# -> Char#) where
testPrimop s l r = Property s $ \ (uInt#-> x0) -> wChar# (l x0) === wChar# (r x0)
@@ -685,12 +709,15 @@ instance TestPrimop (Int16# -> Int# -> Int16#) where
instance TestPrimop (Int16# -> Int16# -> Int#) where
testPrimop s l r = Property s $ \ (uInt16#-> x0) (uInt16#-> x1) -> wInt# (l x0 x1) === wInt# (r x0 x1)
+ testPrimopDivLike s l r = Property s $ twoNonZero $ \ (uInt16#-> x0) (uInt16#-> x1) -> wInt# (l x0 x1) === wInt# (r x0 x1)
instance TestPrimop (Int16# -> Int16# -> Int16#) where
testPrimop s l r = Property s $ \ (uInt16#-> x0) (uInt16#-> x1) -> wInt16# (l x0 x1) === wInt16# (r x0 x1)
+ testPrimopDivLike s l r = Property s $ twoNonZero $ \ (uInt16#-> x0) (uInt16#-> x1) -> wInt16# (l x0 x1) === wInt16# (r x0 x1)
instance TestPrimop (Int16# -> Int16# -> (# Int16#,Int16# #)) where
testPrimop s l r = Property s $ \ (uInt16#-> x0) (uInt16#-> x1) -> WTUP2(wInt16#,wInt16#, (l x0 x1)) === WTUP2(wInt16#,wInt16#, (r x0 x1))
+ testPrimopDivLike s l r = Property s $ twoNonZero $ \ (uInt16#-> x0) (uInt16#-> x1) -> WTUP2(wInt16#,wInt16#, (l x0 x1)) === WTUP2(wInt16#,wInt16#, (r x0 x1))
instance TestPrimop (Int16# -> Int#) where
testPrimop s l r = Property s $ \ (uInt16#-> x0) -> wInt# (l x0) === wInt# (r x0)
@@ -706,12 +733,15 @@ instance TestPrimop (Int32# -> Int# -> Int32#) where
instance TestPrimop (Int32# -> Int32# -> Int#) where
testPrimop s l r = Property s $ \ (uInt32#-> x0) (uInt32#-> x1) -> wInt# (l x0 x1) === wInt# (r x0 x1)
+ testPrimopDivLike s l r = Property s $ twoNonZero $ \ (uInt32#-> x0) (uInt32#-> x1) -> wInt# (l x0 x1) === wInt# (r x0 x1)
instance TestPrimop (Int32# -> Int32# -> Int32#) where
testPrimop s l r = Property s $ \ (uInt32#-> x0) (uInt32#-> x1) -> wInt32# (l x0 x1) === wInt32# (r x0 x1)
+ testPrimopDivLike s l r = Property s $ twoNonZero $ \ (uInt32#-> x0) (uInt32#-> x1) -> wInt32# (l x0 x1) === wInt32# (r x0 x1)
instance TestPrimop (Int32# -> Int32# -> (# Int32#,Int32# #)) where
testPrimop s l r = Property s $ \ (uInt32#-> x0) (uInt32#-> x1) -> WTUP2(wInt32#,wInt32#, (l x0 x1)) === WTUP2(wInt32#,wInt32#, (r x0 x1))
+ testPrimopDivLike s l r = Property s $ twoNonZero $ \ (uInt32#-> x0) (uInt32#-> x1) -> WTUP2(wInt32#,wInt32#, (l x0 x1)) === WTUP2(wInt32#,wInt32#, (r x0 x1))
instance TestPrimop (Int32# -> Int#) where
testPrimop s l r = Property s $ \ (uInt32#-> x0) -> wInt# (l x0) === wInt# (r x0)
@@ -727,9 +757,11 @@ instance TestPrimop (Int64# -> Int# -> Int64#) where
instance TestPrimop (Int64# -> Int64# -> Int#) where
testPrimop s l r = Property s $ \ (uInt64#-> x0) (uInt64#-> x1) -> wInt# (l x0 x1) === wInt# (r x0 x1)
+ testPrimopDivLike s l r = Property s $ twoNonZero $ \ (uInt64#-> x0) (uInt64#-> x1) -> wInt# (l x0 x1) === wInt# (r x0 x1)
instance TestPrimop (Int64# -> Int64# -> Int64#) where
testPrimop s l r = Property s $ \ (uInt64#-> x0) (uInt64#-> x1) -> wInt64# (l x0 x1) === wInt64# (r x0 x1)
+ testPrimopDivLike s l r = Property s $ twoNonZero $ \ (uInt64#-> x0) (uInt64#-> x1) -> wInt64# (l x0 x1) === wInt64# (r x0 x1)
instance TestPrimop (Int64# -> Int#) where
testPrimop s l r = Property s $ \ (uInt64#-> x0) -> wInt# (l x0) === wInt# (r x0)
@@ -745,12 +777,15 @@ instance TestPrimop (Int8# -> Int# -> Int8#) where
instance TestPrimop (Int8# -> Int8# -> Int#) where
testPrimop s l r = Property s $ \ (uInt8#-> x0) (uInt8#-> x1) -> wInt# (l x0 x1) === wInt# (r x0 x1)
+ testPrimopDivLike s l r = Property s $ twoNonZero $ \ (uInt8#-> x0) (uInt8#-> x1) -> wInt# (l x0 x1) === wInt# (r x0 x1)
instance TestPrimop (Int8# -> Int8# -> Int8#) where
testPrimop s l r = Property s $ \ (uInt8#-> x0) (uInt8#-> x1) -> wInt8# (l x0 x1) === wInt8# (r x0 x1)
+ testPrimopDivLike s l r = Property s $ twoNonZero $ \ (uInt8#-> x0) (uInt8#-> x1) -> wInt8# (l x0 x1) === wInt8# (r x0 x1)
instance TestPrimop (Int8# -> Int8# -> (# Int8#,Int8# #)) where
testPrimop s l r = Property s $ \ (uInt8#-> x0) (uInt8#-> x1) -> WTUP2(wInt8#,wInt8#, (l x0 x1)) === WTUP2(wInt8#,wInt8#, (r x0 x1))
+ testPrimopDivLike s l r = Property s $ twoNonZero $ \ (uInt8#-> x0) (uInt8#-> x1) -> WTUP2(wInt8#,wInt8#, (l x0 x1)) === WTUP2(wInt8#,wInt8#, (r x0 x1))
instance TestPrimop (Int8# -> Int#) where
testPrimop s l r = Property s $ \ (uInt8#-> x0) -> wInt# (l x0) === wInt# (r x0)
@@ -764,20 +799,21 @@ instance TestPrimop (Int8# -> Word8#) where
instance TestPrimop (Word# -> Int# -> Word#) where
testPrimop s l r = Property s $ \ (uWord#-> x0) (uInt#-> x1) -> wWord# (l x0 x1) === wWord# (r x0 x1)
-instance TestPrimop (Word# -> Word# -> Word# -> (# Word#,Word# #)) where
- testPrimop s l r = Property s $ \ (uWord#-> x0) (uWord#-> x1) (uWord#-> x2) -> WTUP2(wWord#,wWord#, (l x0 x1 x2)) === WTUP2(wWord#,wWord#, (r x0 x1 x2))
-
instance TestPrimop (Word# -> Word# -> Int#) where
testPrimop s l r = Property s $ \ (uWord#-> x0) (uWord#-> x1) -> wInt# (l x0 x1) === wInt# (r x0 x1)
+ testPrimopDivLike s l r = Property s $ twoNonZero $ \ (uWord#-> x0) (uWord#-> x1) -> wInt# (l x0 x1) === wInt# (r x0 x1)
instance TestPrimop (Word# -> Word# -> Word#) where
testPrimop s l r = Property s $ \ (uWord#-> x0) (uWord#-> x1) -> wWord# (l x0 x1) === wWord# (r x0 x1)
+ testPrimopDivLike s l r = Property s $ twoNonZero $ \ (uWord#-> x0) (uWord#-> x1) -> wWord# (l x0 x1) === wWord# (r x0 x1)
instance TestPrimop (Word# -> Word# -> (# Word#,Int# #)) where
testPrimop s l r = Property s $ \ (uWord#-> x0) (uWord#-> x1) -> WTUP2(wWord#,wInt#, (l x0 x1)) === WTUP2(wWord#,wInt#, (r x0 x1))
+ testPrimopDivLike s l r = Property s $ twoNonZero $ \ (uWord#-> x0) (uWord#-> x1) -> WTUP2(wWord#,wInt#, (l x0 x1)) === WTUP2(wWord#,wInt#, (r x0 x1))
instance TestPrimop (Word# -> Word# -> (# Word#,Word# #)) where
testPrimop s l r = Property s $ \ (uWord#-> x0) (uWord#-> x1) -> WTUP2(wWord#,wWord#, (l x0 x1)) === WTUP2(wWord#,wWord#, (r x0 x1))
+ testPrimopDivLike s l r = Property s $ twoNonZero $ \ (uWord#-> x0) (uWord#-> x1) -> WTUP2(wWord#,wWord#, (l x0 x1)) === WTUP2(wWord#,wWord#, (r x0 x1))
instance TestPrimop (Word# -> Int#) where
testPrimop s l r = Property s $ \ (uWord#-> x0) -> wInt# (l x0) === wInt# (r x0)
@@ -802,12 +838,15 @@ instance TestPrimop (Word16# -> Int# -> Word16#) where
instance TestPrimop (Word16# -> Word16# -> Int#) where
testPrimop s l r = Property s $ \ (uWord16#-> x0) (uWord16#-> x1) -> wInt# (l x0 x1) === wInt# (r x0 x1)
+ testPrimopDivLike s l r = Property s $ twoNonZero $ \ (uWord16#-> x0) (uWord16#-> x1) -> wInt# (l x0 x1) === wInt# (r x0 x1)
instance TestPrimop (Word16# -> Word16# -> Word16#) where
testPrimop s l r = Property s $ \ (uWord16#-> x0) (uWord16#-> x1) -> wWord16# (l x0 x1) === wWord16# (r x0 x1)
+ testPrimopDivLike s l r = Property s $ twoNonZero $ \ (uWord16#-> x0) (uWord16#-> x1) -> wWord16# (l x0 x1) === wWord16# (r x0 x1)
instance TestPrimop (Word16# -> Word16# -> (# Word16#,Word16# #)) where
testPrimop s l r = Property s $ \ (uWord16#-> x0) (uWord16#-> x1) -> WTUP2(wWord16#,wWord16#, (l x0 x1)) === WTUP2(wWord16#,wWord16#, (r x0 x1))
+ testPrimopDivLike s l r = Property s $ twoNonZero $ \ (uWord16#-> x0) (uWord16#-> x1) -> WTUP2(wWord16#,wWord16#, (l x0 x1)) === WTUP2(wWord16#,wWord16#, (r x0 x1))
instance TestPrimop (Word16# -> Int16#) where
testPrimop s l r = Property s $ \ (uWord16#-> x0) -> wInt16# (l x0) === wInt16# (r x0)
@@ -823,12 +862,15 @@ instance TestPrimop (Word32# -> Int# -> Word32#) where
instance TestPrimop (Word32# -> Word32# -> Int#) where
testPrimop s l r = Property s $ \ (uWord32#-> x0) (uWord32#-> x1) -> wInt# (l x0 x1) === wInt# (r x0 x1)
+ testPrimopDivLike s l r = Property s $ twoNonZero $ \ (uWord32#-> x0) (uWord32#-> x1) -> wInt# (l x0 x1) === wInt# (r x0 x1)
instance TestPrimop (Word32# -> Word32# -> Word32#) where
testPrimop s l r = Property s $ \ (uWord32#-> x0) (uWord32#-> x1) -> wWord32# (l x0 x1) === wWord32# (r x0 x1)
+ testPrimopDivLike s l r = Property s $ twoNonZero $ \ (uWord32#-> x0) (uWord32#-> x1) -> wWord32# (l x0 x1) === wWord32# (r x0 x1)
instance TestPrimop (Word32# -> Word32# -> (# Word32#,Word32# #)) where
testPrimop s l r = Property s $ \ (uWord32#-> x0) (uWord32#-> x1) -> WTUP2(wWord32#,wWord32#, (l x0 x1)) === WTUP2(wWord32#,wWord32#, (r x0 x1))
+ testPrimopDivLike s l r = Property s $ twoNonZero $ \ (uWord32#-> x0) (uWord32#-> x1) -> WTUP2(wWord32#,wWord32#, (l x0 x1)) === WTUP2(wWord32#,wWord32#, (r x0 x1))
instance TestPrimop (Word32# -> Int32#) where
testPrimop s l r = Property s $ \ (uWord32#-> x0) -> wInt32# (l x0) === wInt32# (r x0)
@@ -844,9 +886,11 @@ instance TestPrimop (Word64# -> Int# -> Word64#) where
instance TestPrimop (Word64# -> Word64# -> Int#) where
testPrimop s l r = Property s $ \ (uWord64#-> x0) (uWord64#-> x1) -> wInt# (l x0 x1) === wInt# (r x0 x1)
+ testPrimopDivLike s l r = Property s $ twoNonZero $ \ (uWord64#-> x0) (uWord64#-> x1) -> wInt# (l x0 x1) === wInt# (r x0 x1)
instance TestPrimop (Word64# -> Word64# -> Word64#) where
testPrimop s l r = Property s $ \ (uWord64#-> x0) (uWord64#-> x1) -> wWord64# (l x0 x1) === wWord64# (r x0 x1)
+ testPrimopDivLike s l r = Property s $ twoNonZero $ \ (uWord64#-> x0) (uWord64#-> x1) -> wWord64# (l x0 x1) === wWord64# (r x0 x1)
instance TestPrimop (Word64# -> Int64#) where
testPrimop s l r = Property s $ \ (uWord64#-> x0) -> wInt64# (l x0) === wInt64# (r x0)
@@ -862,12 +906,15 @@ instance TestPrimop (Word8# -> Int# -> Word8#) where
instance TestPrimop (Word8# -> Word8# -> Int#) where
testPrimop s l r = Property s $ \ (uWord8#-> x0) (uWord8#-> x1) -> wInt# (l x0 x1) === wInt# (r x0 x1)
+ testPrimopDivLike s l r = Property s $ twoNonZero $ \ (uWord8#-> x0) (uWord8#-> x1) -> wInt# (l x0 x1) === wInt# (r x0 x1)
instance TestPrimop (Word8# -> Word8# -> Word8#) where
testPrimop s l r = Property s $ \ (uWord8#-> x0) (uWord8#-> x1) -> wWord8# (l x0 x1) === wWord8# (r x0 x1)
+ testPrimopDivLike s l r = Property s $ twoNonZero $ \ (uWord8#-> x0) (uWord8#-> x1) -> wWord8# (l x0 x1) === wWord8# (r x0 x1)
instance TestPrimop (Word8# -> Word8# -> (# Word8#,Word8# #)) where
testPrimop s l r = Property s $ \ (uWord8#-> x0) (uWord8#-> x1) -> WTUP2(wWord8#,wWord8#, (l x0 x1)) === WTUP2(wWord8#,wWord8#, (r x0 x1))
+ testPrimopDivLike s l r = Property s $ twoNonZero $ \ (uWord8#-> x0) (uWord8#-> x1) -> WTUP2(wWord8#,wWord8#, (l x0 x1)) === WTUP2(wWord8#,wWord8#, (r x0 x1))
instance TestPrimop (Word8# -> Int8#) where
testPrimop s l r = Property s $ \ (uWord8#-> x0) -> wInt8# (l x0) === wInt8# (r x0)
=====================================
utils/genprimopcode/Main.hs
=====================================
@@ -1,3 +1,4 @@
+{-# OPTIONS_GHC -Wno-x-partial #-}
------------------------------------------------------------------
-- A primop-table mangling program --
--
@@ -693,16 +694,24 @@ gen_foundation_tests (Info _ entries)
where
testable_tys = nub (sort (mapMaybe (\po -> ty po <$ mkTest po) entries))
- mkInstances ty = unlines $
- [ "instance TestPrimop (" ++ pprTy ty ++ ") where"
- , " testPrimop s l r = Property s $ \\ " ++ intercalate " " (zipWith mkArg [0..] (args ty)) ++ " -> " ++ mk_body "l" ++ " === " ++ mk_body "r" ]
-
+ mkInstances inst_ty =
+ let test_lambda = "\\ " ++ intercalate " " (zipWith mkArg [0::Int ..] (arg_tys)) ++ " -> " ++ mk_body "l" ++ " === " ++ mk_body "r"
+ in unlines $
+ [ "instance TestPrimop (" ++ pprTy inst_ty ++ ") where"
+ , " testPrimop s l r = Property s $ " ++ test_lambda ]
+ ++ (if mb_divable_tys
+ then [" testPrimopDivLike s l r = Property s $ twoNonZero $ " ++ test_lambda]
+ else [])
where
- n_args = length (args ty)
+ arg_tys = args inst_ty
+ -- eg Int -> Int -> a
+ mb_divable_tys = case arg_tys of
+ [ty1,ty2] -> ty1 == ty2 && ty1 `elem` divableTyCons
+ _ -> False
- mk_body s = res_ty ty (" (" ++ s ++ " " ++ intercalate " " vs ++ ")")
+ mk_body s = res_ty inst_ty (" (" ++ s ++ " " ++ intercalate " " vs ++ ")")
- vs = zipWith (\n _ -> "x" ++ show n) [0..] (args ty)
+ vs = zipWith (\n _ -> "x" ++ show n) [0::Int ..] (arg_tys)
mkArg n t = "(" ++ unwrapper t ++ "-> x" ++ show n ++ ")"
@@ -714,15 +723,22 @@ gen_foundation_tests (Info _ entries)
args (TyF (TyApp (TyCon c) []) t2) = c : args t2
args (TyApp {}) = []
args (TyUTup {}) = []
+ -- If you hit this you will need to handle the foundation tests to handle the
+ -- type it failed on.
+ args arg_ty = error ("Unexpected primop type:" ++ pprTy arg_ty)
res_ty (TyF _ t2) x = res_ty t2 x
res_ty (TyApp (TyCon c) []) x = wrapper c ++ x
- res_ty (TyUTup args) x =
- let wtup = case length args of
+ res_ty (TyUTup tup_tys) x =
+ let wtup = case length tup_tys of
2 -> "WTUP2"
3 -> "WTUP3"
- in wtup ++"(" ++ intercalate "," (map (\a -> res_ty a "") args ++ [x]) ++ ")"
-
+ -- Only handles primops returning unboxed tuples up to 3 args currently
+ _ -> error "Unexpected primop result type"
+ in wtup ++"(" ++ intercalate "," (map (\a -> res_ty a "") tup_tys ++ [x]) ++ ")"
+ -- If you hit this you will need to handle the foundation tests to handle the
+ -- type it failed on.
+ res_ty unexpected_ty x = error ("Unexpected primop result type:" ++ pprTy unexpected_ty ++ "," ++ x)
wrap qual nm | isLower (head nm) = qual ++ "." ++ nm
@@ -734,7 +750,10 @@ gen_foundation_tests (Info _ entries)
, poName /= "tagToEnum#"
, poName /= "quotRemWord2#"
, (testable (ty po))
- = Just $ intercalate " " ["testPrimop", "\"" ++ poName ++ "\"", wrap "Primop" poName, wrap "Wrapper" poName]
+ = let testPrimOpHow = if is_divLikeOp po
+ then "testPrimopDivLike"
+ else "testPrimop"
+ in Just $ intercalate " " [testPrimOpHow, "\"" ++ poName ++ "\"", wrap "Primop" poName, wrap "Wrapper" poName]
| otherwise = Nothing
@@ -742,13 +761,15 @@ gen_foundation_tests (Info _ entries)
testable (TyF t1 t2) = testable t1 && testable t2
testable (TyC _ t2) = testable t2
testable (TyApp tc tys) = testableTyCon tc && all testable tys
- testable (TyVar a) = False
+ testable (TyVar _a) = False
testable (TyUTup tys) = all testable tys
testableTyCon (TyCon c) =
c `elem` ["Int#", "Word#", "Word8#", "Word16#", "Word32#", "Word64#"
, "Int8#", "Int16#", "Int32#", "Int64#", "Char#"]
testableTyCon _ = False
+ divableTyCons = ["Int#", "Word#", "Word8#", "Word16#", "Word32#", "Word64#"
+ ,"Int8#", "Int16#", "Int32#", "Int64#"]
------------------------------------------------------------------
-- Create PrimOpInfo text from PrimOpSpecs -----------------------
=====================================
utils/genprimopcode/Syntax.hs
=====================================
@@ -53,6 +53,19 @@ is_primtype :: Entry -> Bool
is_primtype (PrimTypeSpec {}) = True
is_primtype _ = False
+is_divLikeOp :: Entry -> Bool
+is_divLikeOp entry = case entry of
+ PrimOpSpec{} -> has_div_like
+ PseudoOpSpec{} -> has_div_like
+ PrimVecOpSpec{} -> has_div_like
+ PrimTypeSpec{} -> False
+ PrimVecTypeSpec{} -> False
+ Section{} -> False
+ where
+ has_div_like = case lookup_attrib "div_like" (opts entry) of
+ Just (OptionTrue{}) -> True
+ _ -> False
+
-- a binding of property to value
data Option
= OptionFalse String -- name = False
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/689e4a7d802a9ee253723cb938e023…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/689e4a7d802a9ee253723cb938e023…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/T25965] 3 commits: driver: Use ModuleGraph for oneshot and --make mode
by Simon Peyton Jones (@simonpj) 16 Apr '25
by Simon Peyton Jones (@simonpj) 16 Apr '25
16 Apr '25
Simon Peyton Jones pushed to branch wip/T25965 at Glasgow Haskell Compiler / GHC
Commits:
d47bf776 by Matthew Pickering at 2025-04-14T16:44:41+01:00
driver: Use ModuleGraph for oneshot and --make mode
This patch uses the `hsc_mod_graph` field for both oneshot and --make
mode. Therefore, if part of the compiler requires usage of the module
graph, you do so in a uniform way for the two different modes.
The `ModuleGraph` describes the relationship between the modules in the
home package and units in external packages. The `ModuleGraph` can be
queried when information about the transitive closure of a package is
needed. For example, the primary use of the ModuleGraph from within the
compiler is in the loader, which needs to know the transitive closure of
a module so it can load all the relevant objects for evaluation.
In --make mode, downsweep computes the ModuleGraph before any
compilation starts.
In oneshot mode, a thunk is created at the start of compilation, which
when forced will compute the module graph beneath the current module.
The thunk is only forced at the moment when the user uses Template
Haskell.
Finally, there are some situations where we need to discover what
dependencies to load but haven't loaded a module graph at all. In this
case, there is a fallback which computes the transitive closure on the
fly and doesn't cache the result. Presumably if you are going to call
getLinkDeps a lot, you would compute the right ModuleGraph before you
started.
Importantly, this removes the ExternalModuleGraph abstraction. This was quite
awkward to work with since it stored information about the home package
inside the EPS.
This patch will also be very useful when implementing explicit level
imports, which requires more significant use of the module graph in
order to determine which level instances are available at.
Towards #25795
-------------------------
Metric Decrease:
MultiLayerModulesTH_Make
MultiLayerModulesTH_OneShot
-------------------------
- - - - -
395e0ad1 by sheaf at 2025-04-16T12:33:26-04:00
base: remove .Internal modules (e.g. GHC.TypeLits)
This commit removes the following internal modules from base,
as per CLC proposal 217:
- GHC.TypeNats.Internal
- GHC.TypeLits.Internal
- GHC.ExecutionStack.Internal
Fixes #25007
- - - - -
15201e7e by Simon Peyton Jones at 2025-04-16T23:00:04+01:00
Fix infelicities in the Specialiser
On the way to #23109 (unary classes) I discovered some infelicities
(or maybe tiny bugs, I forget) in the type-class specialiser.
I also tripped over #25965, an outright bug in the rule matcher
Specifically:
* I enhanced `wantCallsFor`, whih previously always said `True`,
to discard calls of class-ops, data constructors etc.
This is a bit more efficient; and it means we don't need to
worry about filtering them out later.
* I tidied up some tricky logic that eliminated redundant
specialisations. It wasn't working correctly. See the
expanded Note [Specialisations already covered], and
(MP3) in Note [Specialising polymorphic dictionaries].
And the new top-level `alreadyCovered` function, which now
goes via `GHC.Core.Rules.ruleLhsIsMoreSpecific`
I also added a useful Note [The (CI-KEY) invariant]
* I fixed a tricky bug in the `go_fam_fam` in
`GHC.Core.Unify.uVarOrFam`, which allows matching to succeed without
binding all type varibles. This caused #25965.
I enhanced Note [Apartness and type families] some more
- - - - -
42 changed files:
- compiler/GHC/Core/Opt/Specialise.hs
- compiler/GHC/Core/Rules.hs
- compiler/GHC/Core/Unify.hs
- compiler/GHC/Driver/Downsweep.hs
- compiler/GHC/Driver/Env.hs
- compiler/GHC/Driver/Env/Types.hs
- compiler/GHC/Driver/Errors/Ppr.hs
- compiler/GHC/Driver/Errors/Types.hs
- compiler/GHC/Driver/Main.hs
- compiler/GHC/Driver/Make.hs
- compiler/GHC/Driver/MakeAction.hs
- + compiler/GHC/Driver/Messager.hs
- compiler/GHC/Driver/Pipeline.hs-boot
- compiler/GHC/Driver/Pipeline/Execute.hs
- compiler/GHC/Iface/Load.hs
- compiler/GHC/Iface/Recomp.hs
- compiler/GHC/Linker/Deps.hs
- compiler/GHC/Linker/Loader.hs
- compiler/GHC/Runtime/Loader.hs
- compiler/GHC/Tc/Solver/Equality.hs
- compiler/GHC/Types/Basic.hs
- compiler/GHC/Unit/External.hs
- compiler/GHC/Unit/Finder.hs
- − compiler/GHC/Unit/Module/External/Graph.hs
- compiler/GHC/Unit/Module/Graph.hs
- compiler/GHC/Unit/Module/ModNodeKey.hs
- compiler/ghc.cabal.in
- libraries/base/base.cabal.in
- libraries/base/changelog.md
- − libraries/base/src/GHC/ExecutionStack/Internal.hs
- − libraries/base/src/GHC/TypeLits/Internal.hs
- − libraries/base/src/GHC/TypeNats/Internal.hs
- + testsuite/tests/ghc-api/fixed-nodes/InterfaceModuleGraph.hs
- + testsuite/tests/ghc-api/fixed-nodes/InterfaceModuleGraph.stdout
- testsuite/tests/ghc-api/fixed-nodes/all.T
- testsuite/tests/interface-stability/base-exports.stdout
- testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
- testsuite/tests/interface-stability/base-exports.stdout-mingw32
- testsuite/tests/interface-stability/base-exports.stdout-ws-32
- testsuite/tests/plugins/defaulting-plugin/DefaultLifted.hs
- + testsuite/tests/simplCore/should_compile/T25965.hs
- testsuite/tests/simplCore/should_compile/all.T
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8c5dd598bba0307638c50f3d0b2e7a…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8c5dd598bba0307638c50f3d0b2e7a…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/az/ghc-cpp] 106 commits: driver: Use ModuleGraph for oneshot and --make mode
by Alan Zimmerman (@alanz) 16 Apr '25
by Alan Zimmerman (@alanz) 16 Apr '25
16 Apr '25
Alan Zimmerman pushed to branch wip/az/ghc-cpp at Glasgow Haskell Compiler / GHC
Commits:
d47bf776 by Matthew Pickering at 2025-04-14T16:44:41+01:00
driver: Use ModuleGraph for oneshot and --make mode
This patch uses the `hsc_mod_graph` field for both oneshot and --make
mode. Therefore, if part of the compiler requires usage of the module
graph, you do so in a uniform way for the two different modes.
The `ModuleGraph` describes the relationship between the modules in the
home package and units in external packages. The `ModuleGraph` can be
queried when information about the transitive closure of a package is
needed. For example, the primary use of the ModuleGraph from within the
compiler is in the loader, which needs to know the transitive closure of
a module so it can load all the relevant objects for evaluation.
In --make mode, downsweep computes the ModuleGraph before any
compilation starts.
In oneshot mode, a thunk is created at the start of compilation, which
when forced will compute the module graph beneath the current module.
The thunk is only forced at the moment when the user uses Template
Haskell.
Finally, there are some situations where we need to discover what
dependencies to load but haven't loaded a module graph at all. In this
case, there is a fallback which computes the transitive closure on the
fly and doesn't cache the result. Presumably if you are going to call
getLinkDeps a lot, you would compute the right ModuleGraph before you
started.
Importantly, this removes the ExternalModuleGraph abstraction. This was quite
awkward to work with since it stored information about the home package
inside the EPS.
This patch will also be very useful when implementing explicit level
imports, which requires more significant use of the module graph in
order to determine which level instances are available at.
Towards #25795
-------------------------
Metric Decrease:
MultiLayerModulesTH_Make
MultiLayerModulesTH_OneShot
-------------------------
- - - - -
395e0ad1 by sheaf at 2025-04-16T12:33:26-04:00
base: remove .Internal modules (e.g. GHC.TypeLits)
This commit removes the following internal modules from base,
as per CLC proposal 217:
- GHC.TypeNats.Internal
- GHC.TypeLits.Internal
- GHC.ExecutionStack.Internal
Fixes #25007
- - - - -
123063e9 by Alan Zimmerman at 2025-04-16T20:10:56+01:00
GHC-CPP: first rough proof of concept
Processes
#define FOO
#ifdef FOO
x = 1
#endif
Into
[ITcppIgnored [L loc ITcppDefine]
,ITcppIgnored [L loc ITcppIfdef]
,ITvarid "x"
,ITequal
,ITinteger (IL {il_text = SourceText "1", il_neg = False, il_value = 1})
,ITcppIgnored [L loc ITcppEndif]
,ITeof]
In time, ITcppIgnored will be pushed into a comment
- - - - -
fd78ccfb by Alan Zimmerman at 2025-04-16T20:10:56+01:00
Tidy up before re-visiting the continuation mechanic
- - - - -
52d3b28a by Alan Zimmerman at 2025-04-16T20:10:56+01:00
Switch preprocessor to continuation passing style
Proof of concept, needs tidying up
- - - - -
d13cf4cb by Alan Zimmerman at 2025-04-16T20:10:56+01:00
Small cleanup
- - - - -
824da70d by Alan Zimmerman at 2025-04-16T20:10:56+01:00
Get rid of some cruft
- - - - -
eb4129f5 by Alan Zimmerman at 2025-04-16T20:10:56+01:00
Starting to integrate.
Need to get the pragma recognised and set
- - - - -
aad083ff by Alan Zimmerman at 2025-04-16T20:10:56+01:00
Make cppTokens extend to end of line, and process CPP comments
- - - - -
45924ee6 by Alan Zimmerman at 2025-04-16T20:10:56+01:00
Remove unused ITcppDefined
- - - - -
44e4848c by Alan Zimmerman at 2025-04-16T20:10:56+01:00
Allow spaces between # and keyword for preprocessor directive
- - - - -
79969238 by Alan Zimmerman at 2025-04-16T20:10:56+01:00
Process CPP continuation lines
They are emited as separate ITcppContinue tokens.
Perhaps the processing should be more like a comment, and keep on
going to the end.
BUT, the last line needs to be slurped as a whole.
- - - - -
f0c652a4 by Alan Zimmerman at 2025-04-16T20:10:56+01:00
Accumulate CPP continuations, process when ready
Can be simplified further, we only need one CPP token
- - - - -
f31fe568 by Alan Zimmerman at 2025-04-16T20:10:56+01:00
Simplify Lexer interface. Only ITcpp
We transfer directive lines through it, then parse them from scratch
in the preprocessor.
- - - - -
bd6770e9 by Alan Zimmerman at 2025-04-16T20:10:56+01:00
Deal with directive on last line, with no trailing \n
- - - - -
f1e92507 by Alan Zimmerman at 2025-04-16T20:10:56+01:00
Start parsing and processing the directives
- - - - -
57711e91 by Alan Zimmerman at 2025-04-16T20:10:56+01:00
Prepare for processing include files
- - - - -
9bfc7265 by Alan Zimmerman at 2025-04-16T20:10:56+01:00
Move PpState into PreProcess
And initParserState, initPragState too
- - - - -
7cc6b013 by Alan Zimmerman at 2025-04-16T20:10:56+01:00
Process nested include files
Also move PpState out of Lexer.x, so it is easy to evolve it in a ghci
session, loading utils/check-cpp/Main.hs
- - - - -
4b52bccf by Alan Zimmerman at 2025-04-16T20:10:56+01:00
Split into separate files
- - - - -
96e31900 by Alan Zimmerman at 2025-04-16T20:10:56+01:00
Starting on expression parser.
But it hangs. Time for Text.Parsec.Expr
- - - - -
e49afbce by Alan Zimmerman at 2025-04-16T20:10:56+01:00
Start integrating the ghc-cpp work
From https://github.com/alanz/ghc-cpp
- - - - -
e2cc26ad by Alan Zimmerman at 2025-04-16T20:10:56+01:00
WIP
- - - - -
160c9536 by Alan Zimmerman at 2025-04-16T20:10:56+01:00
Fixup after rebase
- - - - -
88624cf4 by Alan Zimmerman at 2025-04-16T20:10:56+01:00
WIP
- - - - -
f5926471 by Alan Zimmerman at 2025-04-16T20:10:56+01:00
Fixup after rebase, including all tests pass
- - - - -
a1367108 by Alan Zimmerman at 2025-04-16T20:10:56+01:00
Change pragma usage to GHC_CPP from GhcCPP
- - - - -
7e6498c1 by Alan Zimmerman at 2025-04-16T20:10:57+01:00
Some comments
- - - - -
e78ec5c9 by Alan Zimmerman at 2025-04-16T20:10:57+01:00
Reformat
- - - - -
9944ddb2 by Alan Zimmerman at 2025-04-16T20:10:57+01:00
Delete unused file
- - - - -
d6c5e468 by Alan Zimmerman at 2025-04-16T20:10:57+01:00
Rename module Parse to ParsePP
- - - - -
90325d92 by Alan Zimmerman at 2025-04-16T20:10:57+01:00
Clarify naming in the parser
- - - - -
d3af5ff1 by Alan Zimmerman at 2025-04-16T20:10:57+01:00
WIP. Switching to alex/happy to be able to work in-tree
Since Parsec is not available
- - - - -
8da3fda7 by Alan Zimmerman at 2025-04-16T20:10:57+01:00
Layering is now correct
- GHC lexer, emits CPP tokens
- accumulated in Preprocessor state
- Lexed by CPP lexer, CPP command extracted, tokens concated with
spaces (to get rid of token pasting via comments)
- if directive lexed and parsed by CPP lexer/parser, and evaluated
- - - - -
a330a9f6 by Alan Zimmerman at 2025-04-16T20:10:57+01:00
First example working
Loading Example1.hs into ghci, getting the right results
```
{-# LANGUAGE GHC_CPP #-}
module Example1 where
y = 3
x =
"hello"
"bye now"
foo = putStrLn x
```
- - - - -
e5719609 by Alan Zimmerman at 2025-04-16T20:10:57+01:00
Rebase, and all tests pass except whitespace for generated parser
- - - - -
39bc1059 by Alan Zimmerman at 2025-04-16T20:10:57+01:00
More plumbing. Ready for testing tomorrow.
- - - - -
8e0e5340 by Alan Zimmerman at 2025-04-16T20:10:57+01:00
Proress. Renamed module State from Types
And at first blush it seems to handle preprocessor scopes properly.
- - - - -
0e43c398 by Alan Zimmerman at 2025-04-16T20:10:57+01:00
Insert basic GHC version macros into parser
__GLASGOW_HASKELL__
__GLASGOW_HASKELL_FULL_VERSION__
__GLASGOW_HASKELL_PATCHLEVEL1__
__GLASGOW_HASKELL_PATCHLEVEL2__
- - - - -
a9a9eaf0 by Alan Zimmerman at 2025-04-16T20:10:57+01:00
Re-sync check-cpp for easy ghci work
- - - - -
47dd783d by Alan Zimmerman at 2025-04-16T20:10:57+01:00
Get rid of warnings
- - - - -
17bbdb4c by Alan Zimmerman at 2025-04-16T20:10:57+01:00
Rework macro processing, in check-cpp
Macros kept at the top level, looked up via name, multiple arity
versions per name can be stored
- - - - -
c440cfe6 by Alan Zimmerman at 2025-04-16T20:10:57+01:00
WIP. Can crack arguments for #define
Next step it to crack out args in an expansion
- - - - -
8667821a by Alan Zimmerman at 2025-04-16T20:10:57+01:00
WIP on arg parsing.
- - - - -
57b11c08 by Alan Zimmerman at 2025-04-16T20:10:57+01:00
Progress. Still screwing up nested parens.
- - - - -
d653f23c by Alan Zimmerman at 2025-04-16T20:10:57+01:00
Seems to work, but has redundant code
- - - - -
e538ed75 by Alan Zimmerman at 2025-04-16T20:10:57+01:00
Remove redundant code
- - - - -
0b6d5076 by Alan Zimmerman at 2025-04-16T20:10:57+01:00
Reformat
- - - - -
fff97636 by Alan Zimmerman at 2025-04-16T20:10:57+01:00
Expand args, single pass
Still need to repeat until fixpoint
- - - - -
793a5a50 by Alan Zimmerman at 2025-04-16T20:10:57+01:00
Fixed point expansion
- - - - -
9960bc20 by Alan Zimmerman at 2025-04-16T20:10:58+01:00
Sync the playground to compiler
- - - - -
cf1ba1c3 by Alan Zimmerman at 2025-04-16T20:10:58+01:00
Working on dumping the GHC_CPP result
But We need to keep the BufSpan in a comment
- - - - -
607a90d1 by Alan Zimmerman at 2025-04-16T20:10:58+01:00
Keep BufSpan in queued comments in GHC.Parser.Lexer
- - - - -
bb62e04e by Alan Zimmerman at 2025-04-16T20:10:58+01:00
Getting close to being able to print the combined tokens
showing what is in and what is out
- - - - -
5a94b451 by Alan Zimmerman at 2025-04-16T20:10:58+01:00
First implementation of dumpGhcCpp.
Example output
First dumps all macros in the state, then the source, showing which
lines are in and which are out
------------------------------
- |#define FOO(A,B) A + B
- |#define FOO(A,B,C) A + B + C
- |#if FOO(1,FOO(3,4)) == 8
- |-- a comment
|x = 1
- |#else
- |x = 5
- |#endif
- - - - -
293695de by Alan Zimmerman at 2025-04-16T20:10:58+01:00
Clean up a bit
- - - - -
f914e0ee by Alan Zimmerman at 2025-04-16T20:10:58+01:00
Add -ddump-ghc-cpp option and a test based on it
- - - - -
5f8f7fce by Alan Zimmerman at 2025-04-16T20:10:58+01:00
Restore Lexer.x rules, we need them for continuation lines
- - - - -
cdfd5ae3 by Alan Zimmerman at 2025-04-16T20:10:58+01:00
Lexer.x: trying to sort out the span for continuations
- We need to match on \n at the end of the line
- We cannot simply back up for it
- - - - -
fa3c0c39 by Alan Zimmerman at 2025-04-16T20:10:58+01:00
Inserts predefined macros. But does not dump properly
Because the cpp tokens have a trailing newline
- - - - -
43bc181e by Alan Zimmerman at 2025-04-16T20:10:58+01:00
Remove unnecessary LExer rules
We *need* the ones that explicitly match to the end of the line.
- - - - -
677fbf16 by Alan Zimmerman at 2025-04-16T20:10:58+01:00
Generate correct span for ITcpp
Dump now works, except we do not render trailing `\` for continuation
lines. This is good enough for use in test output.
- - - - -
e4340715 by Alan Zimmerman at 2025-04-16T20:10:58+01:00
Reduce duplication in lexer
- - - - -
71d4bbf1 by Alan Zimmerman at 2025-04-16T20:10:58+01:00
Tweaks
- - - - -
b202952e by Alan Zimmerman at 2025-04-16T20:10:58+01:00
Insert min_version predefined macros into state
The mechanism now works. Still need to flesh out the full set.
- - - - -
40a69c9d by Alan Zimmerman at 2025-04-16T20:10:58+01:00
Trying my alternative pragma syntax.
It works, but dumpGhcCpp is broken, I suspect from the ITcpp token
span update.
- - - - -
4a47227d by Alan Zimmerman at 2025-04-16T20:10:58+01:00
Pragma extraction now works, with both CPP and GHC_CPP
For the following
{-# LANGUAGE CPP #-}
#if __GLASGOW_HASKELL__ >= 913
{-# LANGUAGE GHC_CPP #-}
#endif
We will enable GHC_CPP only
- - - - -
0acda1b0 by Alan Zimmerman at 2025-04-16T20:10:58+01:00
Remove some tracing
- - - - -
9110a0ee by Alan Zimmerman at 2025-04-16T20:10:58+01:00
Fix test exes for changes
- - - - -
3e1238ed by Alan Zimmerman at 2025-04-16T20:10:58+01:00
For GHC_CPP tests, normalise config-time-based macros
- - - - -
a39358b9 by Alan Zimmerman at 2025-04-16T20:10:58+01:00
WIP
- - - - -
b1a3506d by Alan Zimmerman at 2025-04-16T20:10:58+01:00
WIP again. What is wrong?
- - - - -
404ca306 by Alan Zimmerman at 2025-04-16T20:10:58+01:00
Revert to dynflags for normal not pragma lexing
- - - - -
2c02292a by Alan Zimmerman at 2025-04-16T20:10:58+01:00
Working on getting check-exact to work properly
- - - - -
a7b57ca5 by Alan Zimmerman at 2025-04-16T20:10:58+01:00
Passes CppCommentPlacement test
- - - - -
a0064092 by Alan Zimmerman at 2025-04-16T20:10:58+01:00
Starting on exact printing with GHC_CPP
While overriding normal CPP
- - - - -
f9fc3f3e by Alan Zimmerman at 2025-04-16T20:10:59+01:00
Correctly store CPP ignored tokens as comments
By populating the lexeme string in it, based on the bufpos
- - - - -
37ed0ade by Alan Zimmerman at 2025-04-16T20:10:59+01:00
WIP
- - - - -
005347ce by Alan Zimmerman at 2025-04-16T20:10:59+01:00
Simplifying
- - - - -
218df0c2 by Alan Zimmerman at 2025-04-16T20:10:59+01:00
Update the active state logic
- - - - -
03f4dc01 by Alan Zimmerman at 2025-04-16T20:10:59+01:00
Work the new logic into the mainline code
- - - - -
5dbe86c3 by Alan Zimmerman at 2025-04-16T20:10:59+01:00
Process `defined` operator
- - - - -
9597084f by Alan Zimmerman at 2025-04-16T20:10:59+01:00
Manage lexer state while skipping tokens
There is very intricate layout-related state used when lexing. If a
CPP directive blanks out some tokens, store this state when the
blanking starts, and restore it when they are no longer being blanked.
- - - - -
5bc84360 by Alan Zimmerman at 2025-04-16T20:10:59+01:00
Track the last token buffer index, for ITCppIgnored
We need to attach the source being skipped in an ITCppIgnored token.
We cannot simply use its BufSpan as an index into the underlying
StringBuffer as it counts unicode chars, not bytes.
So we update the lexer state to store the starting StringBuffer
location for the last token, and use the already-stored length to
extract the correct portion of the StringBuffer being parsed.
- - - - -
cfcb6cbf by Alan Zimmerman at 2025-04-16T20:10:59+01:00
Process the ! operator in GHC_CPP expressions
- - - - -
81c74e50 by Alan Zimmerman at 2025-04-16T20:10:59+01:00
Predefine a constant when GHC_CPP is being used.
- - - - -
c12468a2 by Alan Zimmerman at 2025-04-16T20:10:59+01:00
WIP
- - - - -
ba57f7c9 by Alan Zimmerman at 2025-04-16T20:10:59+01:00
Skip lines directly in the lexer when required
- - - - -
df7d3e65 by Alan Zimmerman at 2025-04-16T20:10:59+01:00
Properly manage location when accepting tokens again
- - - - -
22027a8f by Alan Zimmerman at 2025-04-16T20:10:59+01:00
Seems to be working now, for Example9
- - - - -
aded1557 by Alan Zimmerman at 2025-04-16T20:10:59+01:00
Remove tracing
- - - - -
1ce351d1 by Alan Zimmerman at 2025-04-16T20:10:59+01:00
Fix parsing '*' in block comments
Instead of replacing them with '-'
- - - - -
c8e3ce16 by Alan Zimmerman at 2025-04-16T20:10:59+01:00
Keep the trailing backslash in a ITcpp token
- - - - -
ed91afa3 by Alan Zimmerman at 2025-04-16T20:10:59+01:00
Deal with only enabling one section of a group.
A group is an instance of a conditional introduced by
#if/#ifdef/#ifndef,
and ending at the final #endif, including intermediate #elsif sections
- - - - -
76355312 by Alan Zimmerman at 2025-04-16T20:10:59+01:00
Replace remaining identifiers with 0 when evaluating
As per the spec
- - - - -
0cccd058 by Alan Zimmerman at 2025-04-16T20:10:59+01:00
Snapshot before rebase
- - - - -
899c3a8c by Alan Zimmerman at 2025-04-16T20:10:59+01:00
Skip non-processed lines starting with #
- - - - -
1b186f6c by Alan Zimmerman at 2025-04-16T20:10:59+01:00
Export generateMacros so we can use it in ghc-exactprint
- - - - -
d3e2e345 by Alan Zimmerman at 2025-04-16T20:10:59+01:00
Fix rebase
- - - - -
37a65b77 by Alan Zimmerman at 2025-04-16T20:10:59+01:00
Expose initParserStateWithMacrosString
- - - - -
20ffbaba by Alan Zimmerman at 2025-04-16T20:10:59+01:00
Fix buggy lexer cppSkip
It was skipping all lines, not just ones prefixed by #
- - - - -
39aae9d4 by Alan Zimmerman at 2025-04-16T20:11:00+01:00
Fix evaluation of && to use the correct operator
- - - - -
608bf45b by Alan Zimmerman at 2025-04-16T20:11:00+01:00
Deal with closing #-} at the start of a line
- - - - -
eba2d8f4 by Alan Zimmerman at 2025-04-16T20:11:00+01:00
Add the MIN_VERSION_GLASGOW_HASKELL predefined macro
- - - - -
cf231960 by Alan Zimmerman at 2025-04-16T20:11:00+01:00
Include MIN_VERSION_GLASGOW_HASKELL in GhcCpp01.stderr
- - - - -
a92c63d3 by Alan Zimmerman at 2025-04-16T20:11:00+01:00
Use a strict map for macro defines
- - - - -
109 changed files:
- compiler/GHC.hs
- compiler/GHC/Cmm/Lexer.x
- compiler/GHC/Cmm/Parser.y
- compiler/GHC/Cmm/Parser/Monad.hs
- compiler/GHC/Driver/Backpack.hs
- compiler/GHC/Driver/Config/Parser.hs
- compiler/GHC/Driver/Downsweep.hs
- compiler/GHC/Driver/Env.hs
- compiler/GHC/Driver/Env/Types.hs
- compiler/GHC/Driver/Errors/Ppr.hs
- compiler/GHC/Driver/Errors/Types.hs
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/Main.hs
- compiler/GHC/Driver/Make.hs
- compiler/GHC/Driver/MakeAction.hs
- + compiler/GHC/Driver/Messager.hs
- compiler/GHC/Driver/Pipeline.hs
- compiler/GHC/Driver/Pipeline.hs-boot
- compiler/GHC/Driver/Pipeline/Execute.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/Iface/Load.hs
- compiler/GHC/Iface/Recomp.hs
- compiler/GHC/Linker/Deps.hs
- compiler/GHC/Linker/Loader.hs
- compiler/GHC/Parser.hs-boot
- compiler/GHC/Parser.y
- compiler/GHC/Parser/Annotation.hs
- compiler/GHC/Parser/HaddockLex.x
- compiler/GHC/Parser/Header.hs
- compiler/GHC/Parser/Lexer.x
- compiler/GHC/Parser/PostProcess.hs
- compiler/GHC/Parser/PostProcess/Haddock.hs
- + compiler/GHC/Parser/PreProcess.hs
- + compiler/GHC/Parser/PreProcess/Eval.hs
- + compiler/GHC/Parser/PreProcess/Lexer.x
- + compiler/GHC/Parser/PreProcess/Macro.hs
- + compiler/GHC/Parser/PreProcess/ParsePP.hs
- + compiler/GHC/Parser/PreProcess/Parser.y
- + compiler/GHC/Parser/PreProcess/ParserM.hs
- + compiler/GHC/Parser/PreProcess/State.hs
- compiler/GHC/Parser/Utils.hs
- compiler/GHC/Runtime/Loader.hs
- compiler/GHC/SysTools/Cpp.hs
- compiler/GHC/Unit/External.hs
- compiler/GHC/Unit/Finder.hs
- − compiler/GHC/Unit/Module/External/Graph.hs
- compiler/GHC/Unit/Module/Graph.hs
- compiler/GHC/Unit/Module/ModNodeKey.hs
- compiler/ghc.cabal.in
- docs/users_guide/debugging.rst
- ghc/GHCi/UI.hs
- hadrian/src/Rules/SourceDist.hs
- hadrian/stack.yaml.lock
- libraries/base/base.cabal.in
- libraries/base/changelog.md
- − libraries/base/src/GHC/ExecutionStack/Internal.hs
- − libraries/base/src/GHC/TypeLits/Internal.hs
- − libraries/base/src/GHC/TypeNats/Internal.hs
- libraries/ghc-internal/src/GHC/Internal/LanguageExtensions.hs
- testsuite/tests/count-deps/CountDepsParser.stdout
- testsuite/tests/driver/T4437.hs
- testsuite/tests/ghc-api/T11579.hs
- + testsuite/tests/ghc-api/fixed-nodes/InterfaceModuleGraph.hs
- + testsuite/tests/ghc-api/fixed-nodes/InterfaceModuleGraph.stdout
- testsuite/tests/ghc-api/fixed-nodes/all.T
- + testsuite/tests/ghc-cpp/GhcCpp01.hs
- + testsuite/tests/ghc-cpp/GhcCpp01.stderr
- + testsuite/tests/ghc-cpp/all.T
- testsuite/tests/interface-stability/base-exports.stdout
- testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
- testsuite/tests/interface-stability/base-exports.stdout-mingw32
- testsuite/tests/interface-stability/base-exports.stdout-ws-32
- testsuite/tests/interface-stability/template-haskell-exports.stdout
- testsuite/tests/plugins/defaulting-plugin/DefaultLifted.hs
- + testsuite/tests/printer/CppCommentPlacement.hs
- + utils/check-cpp/.ghci
- + utils/check-cpp/.gitignore
- + utils/check-cpp/Eval.hs
- + utils/check-cpp/Example1.hs
- + utils/check-cpp/Example10.hs
- + utils/check-cpp/Example11.hs
- + utils/check-cpp/Example12.hs
- + utils/check-cpp/Example13.hs
- + utils/check-cpp/Example2.hs
- + utils/check-cpp/Example3.hs
- + utils/check-cpp/Example4.hs
- + utils/check-cpp/Example5.hs
- + utils/check-cpp/Example6.hs
- + utils/check-cpp/Example7.hs
- + utils/check-cpp/Example8.hs
- + utils/check-cpp/Example9.hs
- + utils/check-cpp/Lexer.x
- + utils/check-cpp/Macro.hs
- + utils/check-cpp/Main.hs
- + utils/check-cpp/ParsePP.hs
- + utils/check-cpp/ParseSimulate.hs
- + utils/check-cpp/Parser.y
- + utils/check-cpp/ParserM.hs
- + utils/check-cpp/PreProcess.hs
- + utils/check-cpp/README.md
- + utils/check-cpp/State.hs
- + utils/check-cpp/run.sh
- utils/check-exact/Main.hs
- utils/check-exact/Parsers.hs
- utils/check-exact/Preprocess.hs
- utils/check-exact/Utils.hs
- utils/haddock/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
- utils/haddock/haddock-api/src/Haddock/Parser.hs
- utils/haddock/haddock-api/src/Haddock/Types.hs
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6ff34ae924b99fa7abe1f96b174192…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6ff34ae924b99fa7abe1f96b174192…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/splice-imports-2025] Fix IsBoot instance
by Matthew Pickering (@mpickering) 16 Apr '25
by Matthew Pickering (@mpickering) 16 Apr '25
16 Apr '25
Matthew Pickering pushed to branch wip/splice-imports-2025 at Glasgow Haskell Compiler / GHC
Commits:
1e1422c8 by Matthew Pickering at 2025-04-16T21:35:09+01:00
Fix IsBoot instance
- - - - -
1 changed file:
- compiler/GHC/Utils/Binary.hs
Changes:
=====================================
compiler/GHC/Utils/Binary.hs
=====================================
@@ -1080,10 +1080,13 @@ instance Enum a => Binary (EnumBinary a) where
deriving via (EnumBinary ImportLevel) instance Binary ImportLevel
instance Binary IsBootInterface where
- put_ bh IsBoot = put_ bh False
- put_ bh NotBoot = put_ bh True
+ put_ bh ib = put_ bh (case ib of
+ IsBoot -> True
+ NotBoot -> False)
get bh = do x <- get bh
- return $ if x then IsBoot else NotBoot
+ return $ case x of
+ True -> IsBoot
+ False -> NotBoot
{-
Finally - a reasonable portable Integer instance.
@@ -2161,4 +2164,4 @@ instance Binary a => Binary (FingerprintWithValue a) where
instance NFData a => NFData (FingerprintWithValue a) where
rnf (FingerprintWithValue fp mflags)
- = rnf fp `seq` rnf mflags `seq` ()
\ No newline at end of file
+ = rnf fp `seq` rnf mflags `seq` ()
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1e1422c8a8e163070028b4b064544e6…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1e1422c8a8e163070028b4b064544e6…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/az/ghc-cpp] Use a strict map for macro defines
by Alan Zimmerman (@alanz) 16 Apr '25
by Alan Zimmerman (@alanz) 16 Apr '25
16 Apr '25
Alan Zimmerman pushed to branch wip/az/ghc-cpp at Glasgow Haskell Compiler / GHC
Commits:
6ff34ae9 by Alan Zimmerman at 2025-04-16T20:10:15+01:00
Use a strict map for macro defines
- - - - -
3 changed files:
- compiler/GHC/Parser/PreProcess/State.hs
- + utils/check-cpp/Example12.hs
- + utils/check-cpp/Example13.hs
Changes:
=====================================
compiler/GHC/Parser/PreProcess/State.hs
=====================================
@@ -32,8 +32,8 @@ module GHC.Parser.PreProcess.State (
import Data.List.NonEmpty ((<|))
import Data.List.NonEmpty qualified as NonEmpty
-import Data.Map (Map)
-import Data.Map qualified as Map
+import Data.Map.Strict (Map)
+import Data.Map.Strict qualified as Map
import Data.Maybe (isJust)
import GHC.Base
import GHC.Data.StringBuffer
@@ -317,7 +317,7 @@ addDefine name def = do
addDefine' :: PpState -> MacroName -> MacroDef -> PpState
addDefine' s name def =
- s{pp_defines = insertMacroDef name def (pp_defines s)}
+ s{ pp_defines = insertMacroDef name def (pp_defines s)}
ppDefine :: MacroName -> MacroDef -> PP ()
ppDefine name val = addDefine name val
=====================================
utils/check-cpp/Example12.hs
=====================================
@@ -0,0 +1,6 @@
+{-# LANGUAGE
+ GHC_CPP
+ , DeriveGeneric
+#-}
+
+module Example12 where
=====================================
utils/check-cpp/Example13.hs
=====================================
@@ -0,0 +1,10 @@
+{-# LANGUAGE GHC_CPP #-}
+-- {-# OPTIONS -ddump-ghc-cpp -dkeep-comments #-}
+module Example13 where
+
+foo =
+#if MIN_VERSION_GLASGOW_HASKELL(19,13,20250101,0)
+ 'a'
+#else
+ 'b'
+#endif
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6ff34ae924b99fa7abe1f96b1741924…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6ff34ae924b99fa7abe1f96b1741924…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
16 Apr '25
Matthew Pickering pushed to branch wip/splice-imports-2025 at Glasgow Haskell Compiler / GHC
Commits:
109a58bf by Matthew Pickering at 2025-04-16T19:21:28+01:00
missing files
- - - - -
2 changed files:
- + compiler/Language/Haskell/Syntax/ImpExp/ImportLevel.hs
- + compiler/Language/Haskell/Syntax/ImpExp/IsBoot.hs
Changes:
=====================================
compiler/Language/Haskell/Syntax/ImpExp/ImportLevel.hs
=====================================
@@ -0,0 +1,10 @@
+-- | A module to define 'ImportLevel' so it can be given an Outputable instance
+-- without introducing module loops.
+module Language.Haskell.Syntax.ImpExp.ImportLevel ( ImportLevel(..) ) where
+
+
+import Prelude (Eq, Ord, Show, Enum)
+import Data.Data (Data)
+
+data ImportLevel = NormalLevel | SpliceLevel | QuoteLevel deriving (Eq, Ord, Data, Show, Enum)
+
=====================================
compiler/Language/Haskell/Syntax/ImpExp/IsBoot.hs
=====================================
@@ -0,0 +1,15 @@
+module Language.Haskell.Syntax.ImpExp.IsBoot ( IsBootInterface(..) ) where
+
+import Prelude (Eq, Ord, Show)
+import Data.Data (Data)
+import Control.DeepSeq (NFData(..), rwhnf)
+
+-- | Indicates whether a module name is referring to a boot interface (hs-boot
+-- file) or regular module (hs file). We need to treat boot modules specially
+-- when building compilation graphs, since they break cycles. Regular source
+-- files and signature files are treated equivalently.
+data IsBootInterface = NotBoot | IsBoot
+ deriving (Eq, Ord, Show, Data)
+
+instance NFData IsBootInterface where
+ rnf = rwhnf
\ No newline at end of file
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/109a58bf52f76ffaefc12b73a769106…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/109a58bf52f76ffaefc12b73a769106…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: base: remove .Internal modules (e.g. GHC.TypeLits)
by Marge Bot (@marge-bot) 16 Apr '25
by Marge Bot (@marge-bot) 16 Apr '25
16 Apr '25
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
395e0ad1 by sheaf at 2025-04-16T12:33:26-04:00
base: remove .Internal modules (e.g. GHC.TypeLits)
This commit removes the following internal modules from base,
as per CLC proposal 217:
- GHC.TypeNats.Internal
- GHC.TypeLits.Internal
- GHC.ExecutionStack.Internal
Fixes #25007
- - - - -
2bc537ad by Sylvain Henry at 2025-04-16T13:06:44-04:00
RTS: remove target info and fix host info (#24058)
The RTS isn't a compiler, hence it doesn't have a target and we remove
the reported target info displayed by "+RTS --info". We also fix the
host info displayed by "+RTS --info": the host of the RTS is the
RTS-building compiler's target, not the compiler's host (wrong when
doing cross-compilation).
- - - - -
c043a4f8 by Sylvain Henry at 2025-04-16T13:06:44-04:00
RTS: remove build info
As per the discussion in !13967, there is no reason to tag the RTS with
information about the build platform.
- - - - -
e08a689a by Patrick at 2025-04-16T13:06:49-04:00
Refactor Handling of Multiple Default Declarations
Fixes: #25912, #25914, #25934
Previously, GHC discarded all loaded defaults (tcg_default) when local
defaults were encountered during typechecking. According to the
exportable-named-default proposal (sections 2.4.2 and 2.4.3), local
defaults should be merged into tcg_default, retaining any defaults
already present while overriding where necessary.
Key Changes:
* Introduce DefaultProvenance to track the origin of default declarations
(local, imported, or built-in), replacing the original cd_module
in ClassDefaults with cd_provenance :: DefaultProvenance.
* Rename tcDefaults to tcDefaultDecls, limiting its responsibility to only
converting renamed class defaults into ClassDefaults.
* Add extendDefaultEnvWithLocalDefaults to merge local defaults into the
environment, with proper duplication checks:
- Duplicate local defaults for a class trigger an error.
- Local defaults override imported or built-in defaults.
* Update and add related notes: Note [Builtin class defaults],
Note [DefaultProvenance].
* Add regression tests: T25912, T25914, T25934.
Thanks sam and simon for the help on this patch.
Co-authored-by: sheaf <sam.derbyshire(a)gmail.com>
- - - - -
30 changed files:
- compiler/GHC/Driver/Session.hs
- compiler/GHC/IfaceToCore.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Errors/Types.hs
- compiler/GHC/Tc/Gen/Default.hs
- compiler/GHC/Tc/Gen/Export.hs
- compiler/GHC/Tc/Module.hs
- compiler/GHC/Tc/Utils/Env.hs
- compiler/GHC/Types/DefaultEnv.hs
- hadrian/src/Settings/Packages.hs
- libraries/base/base.cabal.in
- libraries/base/changelog.md
- − libraries/base/src/GHC/ExecutionStack/Internal.hs
- − libraries/base/src/GHC/TypeLits/Internal.hs
- − libraries/base/src/GHC/TypeNats/Internal.hs
- rts/RtsUtils.c
- testsuite/ghc-config/ghc-config.hs
- + testsuite/tests/default/T25912.hs
- + testsuite/tests/default/T25912.stdout
- + testsuite/tests/default/T25912_helper.hs
- + testsuite/tests/default/T25914.hs
- + testsuite/tests/default/T25934.hs
- testsuite/tests/default/all.T
- testsuite/tests/default/default-fail03.stderr
- testsuite/tests/interface-stability/base-exports.stdout
- testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
- testsuite/tests/interface-stability/base-exports.stdout-mingw32
- testsuite/tests/interface-stability/base-exports.stdout-ws-32
- testsuite/tests/linters/notes.stdout
- testsuite/tests/module/mod58.stderr
Changes:
=====================================
compiler/GHC/Driver/Session.hs
=====================================
@@ -236,6 +236,7 @@ import GHC.Prelude
import GHC.Platform
import GHC.Platform.Ways
import GHC.Platform.Profile
+import GHC.Platform.ArchOS
import GHC.Unit.Types
import GHC.Unit.Parser
@@ -3455,6 +3456,9 @@ compilerInfo dflags
("Build platform", cBuildPlatformString),
("Host platform", cHostPlatformString),
("Target platform", platformMisc_targetPlatformString $ platformMisc dflags),
+ ("target os string", stringEncodeOS (platformOS (targetPlatform dflags))),
+ ("target arch string", stringEncodeArch (platformArch (targetPlatform dflags))),
+ ("target word size in bits", show (platformWordSizeInBits (targetPlatform dflags))),
("Have interpreter", showBool $ platformMisc_ghcWithInterpreter $ platformMisc dflags),
("Object splitting supported", showBool False),
("Have native code generator", showBool $ platformNcgSupported platform),
=====================================
compiler/GHC/IfaceToCore.hs
=====================================
@@ -118,7 +118,7 @@ import GHC.Types.Var.Set
import GHC.Types.Name
import GHC.Types.Name.Set
import GHC.Types.Name.Env
-import GHC.Types.DefaultEnv ( ClassDefaults(..), DefaultEnv, mkDefaultEnv )
+import GHC.Types.DefaultEnv ( ClassDefaults(..), DefaultEnv, mkDefaultEnv, DefaultProvenance(..) )
import GHC.Types.Id
import GHC.Types.Id.Make
import GHC.Types.Id.Info
@@ -1333,7 +1333,7 @@ tcIfaceDefault this_mod IfaceDefault { ifDefaultCls = cls_name
; let warn = fmap fromIfaceWarningTxt iface_warn
; return ClassDefaults { cd_class = cls
, cd_types = tys'
- , cd_module = Just this_mod
+ , cd_provenance = DP_Imported this_mod
, cd_warn = warn } }
where
tyThingConClass :: TyThing -> Class
=====================================
compiler/GHC/Tc/Errors/Ppr.hs
=====================================
@@ -85,7 +85,7 @@ import GHC.Tc.Types.Rank (Rank(..))
import GHC.Tc.Types.TH
import GHC.Tc.Utils.TcType
-import GHC.Types.DefaultEnv (ClassDefaults(ClassDefaults, cd_types, cd_module))
+import GHC.Types.DefaultEnv (ClassDefaults(ClassDefaults, cd_types, cd_provenance), DefaultProvenance (..))
import GHC.Types.Error
import GHC.Types.Error.Codes
import GHC.Types.Hint
@@ -582,11 +582,19 @@ instance Diagnostic TcRnMessage where
TcRnMultipleDefaultDeclarations cls dup_things
-> mkSimpleDecorated $
hang (text "Multiple default declarations for class" <+> quotes (ppr cls))
- 2 (vcat (map pp dup_things))
+ 2 (pp dup_things)
where
- pp :: LDefaultDecl GhcRn -> SDoc
- pp (L locn DefaultDecl {})
- = text "here was another default declaration" <+> ppr (locA locn)
+ pp :: ClassDefaults -> SDoc
+ pp (ClassDefaults { cd_provenance = prov })
+ = case prov of
+ DP_Local { defaultDeclLoc = loc, defaultDeclH98 = isH98 }
+ -> let
+ what =
+ if isH98
+ then text "default declaration"
+ else text "named default declaration"
+ in text "conflicting" <+> what <+> text "at:" <+> ppr loc
+ _ -> empty -- doesn't happen, as local defaults override imported and built-in defaults
TcRnBadDefaultType ty deflt_clss
-> mkSimpleDecorated $
hang (text "The default type" <+> quotes (ppr ty) <+> text "is not an instance of")
@@ -7139,7 +7147,7 @@ pprPatersonCondFailure (PCF_TyFam tc) InTyFamEquation _lhs rhs =
--------------------------------------------------------------------------------
defaultTypesAndImport :: ClassDefaults -> SDoc
-defaultTypesAndImport ClassDefaults{cd_types, cd_module = Just cdm} =
+defaultTypesAndImport ClassDefaults{cd_types, cd_provenance = DP_Imported cdm} =
hang (parens $ pprWithCommas ppr cd_types)
2 (text "imported from" <+> ppr cdm)
defaultTypesAndImport ClassDefaults{cd_types} = parens (pprWithCommas ppr cd_types)
=====================================
compiler/GHC/Tc/Errors/Types.hs
=====================================
@@ -1504,7 +1504,7 @@ data TcRnMessage where
Text cases: module/mod58
-}
- TcRnMultipleDefaultDeclarations :: Class -> [LDefaultDecl GhcRn] -> TcRnMessage
+ TcRnMultipleDefaultDeclarations :: Class -> ClassDefaults -> TcRnMessage
{-| TcRnWarnClashingDefaultImports is a warning that occurs when a module imports
more than one default declaration for the same class, and they are not all
=====================================
compiler/GHC/Tc/Gen/Default.hs
=====================================
@@ -5,9 +5,10 @@
-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE LambdaCase #-}
-- | Typechecking @default@ declarations
-module GHC.Tc.Gen.Default ( tcDefaults ) where
+module GHC.Tc.Gen.Default ( tcDefaultDecls, extendDefaultEnvWithLocalDefaults ) where
import GHC.Prelude
import GHC.Hs
@@ -16,7 +17,7 @@ import GHC.Builtin.Names
import GHC.Core.Class
import GHC.Core.Predicate ( Pred (..), classifyPredType )
-import GHC.Data.Maybe ( firstJusts )
+import GHC.Data.Maybe ( firstJusts, maybeToList )
import GHC.Tc.Errors.Types
import GHC.Tc.Gen.HsType
@@ -30,20 +31,17 @@ import GHC.Tc.Utils.TcMType ( newWanted )
import GHC.Tc.Utils.TcType
import GHC.Types.Basic ( TypeOrKind(..) )
-import GHC.Types.DefaultEnv ( DefaultEnv, ClassDefaults (..), defaultEnv )
+import GHC.Types.DefaultEnv ( DefaultEnv, ClassDefaults (..), lookupDefaultEnv, insertDefaultEnv, DefaultProvenance (..) )
import GHC.Types.SrcLoc
-import GHC.Unit.Types (Module, ghcInternalUnit, moduleUnit)
+import GHC.Unit.Types (ghcInternalUnit, moduleUnit)
-import GHC.Utils.Misc (fstOf3, sndOf3)
import GHC.Utils.Outputable
import qualified GHC.LanguageExtensions as LangExt
-import Data.Function (on)
-import Data.List.NonEmpty ( NonEmpty (..), groupBy )
+import Data.List.NonEmpty ( NonEmpty (..) )
import qualified Data.List.NonEmpty as NE
-import Data.Maybe (fromMaybe)
import Data.Traversable ( for )
{- Note [Named default declarations]
@@ -86,7 +84,7 @@ The moving parts are as follows:
* The `DefaultEnv` of all defaults in scope in a module is kept in the `tcg_default`
field of `TcGblEnv`.
-* This field is populated by `GHC.Tc.Gen.Default.tcDefaults` which typechecks
+* This field is populated by `GHC.Tc.Gen.Default.tcDefaultDecls` which typechecks
any local or imported `default` declarations.
* Only a single default declaration can be in effect in any single module for
@@ -103,7 +101,7 @@ The moving parts are as follows:
in effect be `default Num (Integer, Double)` as specified by Haskell Language
Report.
- See Note [Default class defaults] in GHC.Tc.Utils.Env
+ See Note [Builtin class defaults] in GHC.Tc.Utils.Env
* Beside the defaults, the `ExtendedDefaultRules` and `OverloadedStrings`
extensions also affect the traditional `default` declarations that don't name
@@ -120,61 +118,54 @@ The moving parts are as follows:
tracked separately from `ImportAvails`, and returned separately from them by
`GHC.Rename.Names.rnImports`.
-* Class defaults are exported explicitly, as the example above shows. A module's
- exported defaults are tracked in `tcg_default_exports`, which are then
- transferred to `mg_defaults`, `md_defaults`, and `mi_defaults_`.
+* Class defaults are exported explicitly.
+ For example,
+ module M( ..., default C, ... )
+ exports the defaults for class C.
+
+ A module's exported defaults are computed by exports_from_avail,
+ tracked in tcg_default_exports, which are then transferred to mg_defaults,
+ md_defaults, and mi_defaults_.
+
+ Only defaults explicitly exported are actually exported.
+ (i.e. No defaults are exported in a module header like:
+ module M where ...)
+
See Note [Default exports] in GHC.Tc.Gen.Export
* Since the class defaults merely help the solver infer the correct types, they
leave no trace in Haskell Core.
-}
--- See Note [Named default declarations]
-tcDefaults :: [LDefaultDecl GhcRn]
- -> TcM DefaultEnv -- Defaulting types to heave
- -- into Tc monad for later use
- -- in Disambig.
-
-tcDefaults []
- = getDeclaredDefaultTys -- No default declaration, so get the
- -- default types from the envt;
- -- i.e. use the current ones
- -- (the caller will put them back there)
- -- It's important not to return defaultDefaultTys here (which
- -- we used to do) because in a TH program, tcDefaults [] is called
- -- repeatedly, once for each group of declarations between top-level
- -- splices. We don't want to carefully set the default types in
- -- one group, only for the next group to ignore them and install
- -- defaultDefaultTys
-
-tcDefaults decls
- = do { tcg_env <- getGblEnv
- ; let
- here = tcg_mod tcg_env
- is_internal_unit = moduleUnit here == ghcInternalUnit
- ; case (is_internal_unit, decls) of
- -- Some internal GHC modules contain @default ()@ to declare that no defaults can take place
- -- in the module.
- -- We shortcut the treatment of such a default declaration with no class nor types: we won't
- -- try to point 'cd_class' to 'Num' since it may not even exist yet.
- { (True, [L _ (DefaultDecl _ Nothing [])])
- -> return $ defaultEnv []
- -- Otherwise we take apart the declaration into the class constructor and its default types.
- ; _ ->
- do { h2010_dflt_clss <- getH2010DefaultClasses
- ; decls' <- mapMaybeM (declarationParts h2010_dflt_clss) decls
- ; let
- -- Find duplicate default declarations
- decl_tag (mb_cls, _, _) =
- case mb_cls of
- Nothing -> Nothing
- Just cls -> if cls `elem` h2010_dflt_clss
- then Nothing
- else Just cls
- decl_groups = groupBy ((==) `on` decl_tag) decls'
- ; decls_without_dups <- mapM (reportDuplicates here h2010_dflt_clss) decl_groups
- ; return $ defaultEnv (concat decls_without_dups)
- } } }
+-- | Typecheck a collection of default declarations. These can be either:
+--
+-- - Haskell 98 default declarations, of the form @default (Float, Double)@
+-- - Named default declarations, of the form @default Cls(Int, Char)@.
+-- See Note [Named default declarations]
+tcDefaultDecls :: [LDefaultDecl GhcRn] -> TcM [LocatedA ClassDefaults]
+tcDefaultDecls decls =
+ do
+ tcg_env <- getGblEnv
+ let here = tcg_mod tcg_env
+ is_internal_unit = moduleUnit here == ghcInternalUnit
+ case (is_internal_unit, decls) of
+ -- No default declarations
+ (_, []) -> return []
+ -- As per Remark [default () in ghc-internal] in Note [Builtin class defaults],
+ -- some modules in ghc-internal include an empty `default ()` declaration, in order
+ -- to disable built-in defaults. This is no longer necessary (see `GHC.Tc.Utils.Env.tcGetDefaultTys`),
+ -- but we must still make sure not to error if we fail to look up e.g. the 'Num'
+ -- typeclass when typechecking such a default declaration. To do this, we wrap
+ -- calls of 'tcLookupClass' in 'tryTc'.
+ (True, [L _ (DefaultDecl _ Nothing [])]) -> do
+ h2010_dflt_clss <- foldMapM (fmap maybeToList . fmap fst . tryTc . tcLookupClass) =<< getH2010DefaultNames
+ case NE.nonEmpty h2010_dflt_clss of
+ Nothing -> return []
+ Just h2010_dflt_clss' -> toClassDefaults h2010_dflt_clss' decls
+ -- Otherwise we take apart the declaration into the class constructor and its default types.
+ _ -> do
+ h2010_dflt_clss <- getH2010DefaultClasses
+ toClassDefaults h2010_dflt_clss decls
where
getH2010DefaultClasses :: TcM (NonEmpty Class)
-- All the classes subject to defaulting with a Haskell 2010 default
@@ -186,18 +177,18 @@ tcDefaults decls
-- No extensions: Num
-- OverloadedStrings: add IsString
-- ExtendedDefaults: add Show, Eq, Ord, Foldable, Traversable
- getH2010DefaultClasses
- = do { num_cls <- tcLookupClass numClassName
- ; ovl_str <- xoptM LangExt.OverloadedStrings
+ getH2010DefaultClasses = mapM tcLookupClass =<< getH2010DefaultNames
+ getH2010DefaultNames
+ = do { ovl_str <- xoptM LangExt.OverloadedStrings
; ext_deflt <- xoptM LangExt.ExtendedDefaultRules
- ; deflt_str <- if ovl_str
- then mapM tcLookupClass [isStringClassName]
- else return []
- ; deflt_interactive <- if ext_deflt
- then mapM tcLookupClass interactiveClassNames
- else return []
- ; let extra_clss = deflt_str ++ deflt_interactive
- ; return $ num_cls :| extra_clss
+ ; let deflt_str = if ovl_str
+ then [isStringClassName]
+ else []
+ ; let deflt_interactive = if ext_deflt
+ then interactiveClassNames
+ else []
+ ; let extra_clss_names = deflt_str ++ deflt_interactive
+ ; return $ numClassName :| extra_clss_names
}
declarationParts :: NonEmpty Class -> LDefaultDecl GhcRn -> TcM (Maybe (Maybe Class, LDefaultDecl GhcRn, [Type]))
declarationParts h2010_dflt_clss decl@(L locn (DefaultDecl _ mb_cls_name dflt_hs_tys))
@@ -220,20 +211,49 @@ tcDefaults decls
; return (Just cls, decl, tau_tys)
} }
- reportDuplicates :: Module -> NonEmpty Class -> NonEmpty (Maybe Class, LDefaultDecl GhcRn, [Type]) -> TcM [ClassDefaults]
- reportDuplicates here h2010_dflt_clss ((mb_cls, _, tys) :| [])
- = pure [ ClassDefaults{cd_class = c, cd_types = tys, cd_module = Just here, cd_warn = Nothing }
- | c <- case mb_cls of
- Nothing -> NE.toList h2010_dflt_clss
- Just cls -> [cls]
- ]
- -- Report an error on multiple default declarations for the same class in the same module.
- -- See Note [Disambiguation of multiple default declarations] in GHC.Tc.Module
- reportDuplicates _ (num_cls :| _) decls@((_, L locn _, _) :| _)
- = setSrcSpan (locA locn) (addErrTc $ dupDefaultDeclErr cls (sndOf3 <$> decls))
- >> pure []
+ toClassDefaults :: NonEmpty Class -> [LDefaultDecl GhcRn] -> TcM [LocatedA ClassDefaults]
+ toClassDefaults h2010_dflt_clss dfs = do
+ dfs <- mapMaybeM (declarationParts h2010_dflt_clss) dfs
+ return $ concatMap (go False) dfs
where
- cls = fromMaybe num_cls $ firstJusts (fmap fstOf3 decls)
+ go h98 = \case
+ (Nothing, rn_decl, tys) -> concatMap (go True) [(Just cls, rn_decl, tys) | cls <- NE.toList h2010_dflt_clss]
+ (Just cls, (L locn _), tys) -> [(L locn $ ClassDefaults cls tys (DP_Local (locA locn) h98) Nothing)]
+
+-- | Extend the default environment with the local default declarations
+-- and do the action in the extended environment.
+extendDefaultEnvWithLocalDefaults :: [LocatedA ClassDefaults] -> TcM a -> TcM a
+extendDefaultEnvWithLocalDefaults decls action = do
+ tcg_env <- getGblEnv
+ let default_env = tcg_default tcg_env
+ new_default_env <- insertDefaultDecls default_env decls
+ updGblEnv (\gbl -> gbl { tcg_default = new_default_env } ) $ action
+
+-- | Insert local default declarations into the default environment.
+--
+-- See 'insertDefaultDecl'.
+insertDefaultDecls :: DefaultEnv -> [LocatedA ClassDefaults] -> TcM DefaultEnv
+insertDefaultDecls = foldrM insertDefaultDecl
+-- | Insert a local default declaration into the default environment.
+--
+-- If the class already has a local default declaration in the DefaultEnv,
+-- report an error and return the original DefaultEnv. Otherwise, override
+-- any existing default declarations (e.g. imported default declarations).
+--
+-- See Note [Disambiguation of multiple default declarations] in GHC.Tc.Module
+insertDefaultDecl :: LocatedA ClassDefaults -> DefaultEnv -> TcM DefaultEnv
+insertDefaultDecl (L decl_loc new_cls_defaults ) default_env =
+ case lookupDefaultEnv default_env (className cls) of
+ Just cls_defaults
+ | DP_Local {} <- cd_provenance cls_defaults
+ -> do { setSrcSpan (locA decl_loc) (addErrTc $ TcRnMultipleDefaultDeclarations cls cls_defaults)
+ ; return default_env }
+ _ -> return $ insertDefaultEnv new_cls_defaults default_env
+ -- NB: this overrides imported and built-in default declarations
+ -- for this class, if there were any.
+ where
+ cls = cd_class new_cls_defaults
+
-- | Check that the type is an instance of at least one of the default classes.
--
@@ -289,10 +309,6 @@ simplifyDefault cls dflt_ty@(L l _)
-> Nothing
}
-dupDefaultDeclErr :: Class -> NonEmpty (LDefaultDecl GhcRn) -> TcRnMessage
-dupDefaultDeclErr cls (L _ DefaultDecl {} :| dup_things)
- = TcRnMultipleDefaultDeclarations cls dup_things
-
{- Note [Instance check for default declarations]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
When we see a named default declaration, such as:
@@ -327,4 +343,4 @@ whether each type is an instance of:
- ... or the IsString class, with -XOverloadedStrings
- ... or any of the Show, Eq, Ord, Foldable, and Traversable classes,
with -XExtendedDefaultRules
--}
\ No newline at end of file
+-}
=====================================
compiler/GHC/Tc/Gen/Export.hs
=====================================
@@ -282,7 +282,7 @@ example,
would import the above `default IsString (Text, String)` declaration into the
importing module.
-The `cd_module` field of `ClassDefaults` tracks the module whence the default was
+The `cd_provenance` field of `ClassDefaults` tracks the module whence the default was
imported from, for the purpose of warning reports. The said warning report may be
triggered by `-Wtype-defaults` or by a user-defined `WARNING` pragma attached to
the default export. In the latter case the warning text is stored in the
=====================================
compiler/GHC/Tc/Module.hs
=====================================
@@ -383,6 +383,7 @@ the actual contents of the module are wired in to GHC.
-}
{- Note [Disambiguation of multiple default declarations]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
See Note [Named default declarations] in GHC.Tc.Gen.Default
@@ -1811,9 +1812,8 @@ tcTyClsInstDecls tycl_decls deriv_decls default_decls binds
--
-- But only after we've typechecked 'default' declarations.
-- See Note [Typechecking default declarations]
- defaults <- tcDefaults default_decls ;
- updGblEnv (\gbl -> gbl { tcg_default = defaults }) $ do {
-
+ defaults <- tcDefaultDecls default_decls
+ ; extendDefaultEnvWithLocalDefaults defaults $ do {
-- Careful to quit now in case there were instance errors, so that
-- the deriving errors don't pile up as well.
=====================================
compiler/GHC/Tc/Utils/Env.hs
=====================================
@@ -128,8 +128,7 @@ import GHC.Types.SourceFile
import GHC.Types.Name
import GHC.Types.Name.Set
import GHC.Types.Name.Env
-import GHC.Types.DefaultEnv ( DefaultEnv, ClassDefaults(..),
- defaultEnv, emptyDefaultEnv, lookupDefaultEnv, unitDefaultEnv )
+import GHC.Types.DefaultEnv
import GHC.Types.Error
import GHC.Types.Id
import GHC.Types.Id.Info ( RecSelParent(..) )
@@ -971,21 +970,28 @@ isBrackStage _other = False
************************************************************************
-}
-{- Note [Default class defaults]
+{- Note [Builtin class defaults]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-In absence of user-defined `default` declarations, the set of class defaults in
-effect (i.e. `DefaultEnv`) is determined by the absence or
-presence of the `ExtendedDefaultRules` and `OverloadedStrings` extensions. In their
-absence, the only rule in effect is `default Num (Integer, Double)` as specified by
-Haskell Language Report.
-
-In GHC's internal packages `DefaultEnv` is empty to minimize cross-module dependencies:
-the `Num` class or `Integer` type may not even be available in low-level modules. If
-you don't do this, attempted defaulting in package ghc-prim causes an actual crash
-(attempting to look up the `Integer` type).
-
-A user-defined `default` declaration overrides the defaults for the specified class,
-and only for that class.
+In the absence of user-defined `default` declarations, the set of class defaults in
+effect (i.e. the `DefaultEnv`) depends on whether the `ExtendedDefaultRules` and
+`OverloadedStrings` extensions are enabled. In their absence, the only rule in effect
+is `default Num (Integer, Double)`, as specified by the Haskell 2010 report.
+
+Remark [No built-in defaults in ghc-internal]
+
+ When typechecking the ghc-internal package, we **do not** include any built-in
+ defaults. This is because, in ghc-internal, types such as 'Num' or 'Integer' may
+ not even be available (they haven't been typechecked yet).
+
+Remark [default () in ghc-internal]
+
+ Historically, modules inside ghc-internal have used a single default declaration,
+ of the form `default ()`, to work around the problem described in
+ Remark [No built-in defaults in ghc-internal].
+
+ When we typecheck such a default declaration, we must also make sure not to fail
+ if e.g. 'Num' is not in scope. We thus have special treatment for this case,
+ in 'GHC.Tc.Gen.Default.tcDefaultDecls'.
-}
tcGetDefaultTys :: TcM (DefaultEnv, -- Default classes and types
@@ -997,7 +1003,7 @@ tcGetDefaultTys
-- See also #1974
builtinDefaults cls tys = ClassDefaults{ cd_class = cls
, cd_types = tys
- , cd_module = Nothing
+ , cd_provenance = DP_Builtin
, cd_warn = Nothing }
-- see Note [Named default declarations] in GHC.Tc.Gen.Default
@@ -1005,7 +1011,8 @@ tcGetDefaultTys
; this_module <- tcg_mod <$> getGblEnv
; let this_unit = moduleUnit this_module
; if this_unit == ghcInternalUnit
- -- see Note [Default class defaults]
+ -- see Remark [No built-in defaults in ghc-internal]
+ -- in Note [Builtin class defaults] in GHC.Tc.Utils.Env
then return (defaults, extended_defaults)
else do
-- not one of the built-in units
@@ -1037,6 +1044,8 @@ tcGetDefaultTys
}
-- The Num class is already user-defaulted, no need to construct the builtin default
_ -> pure emptyDefaultEnv
+ -- Supply the built-in defaults, but make the user-supplied defaults
+ -- override them.
; let deflt_tys = mconcat [ extDef, numDef, ovlStr, defaults ]
; return (deflt_tys, extended_defaults) } }
=====================================
compiler/GHC/Types/DefaultEnv.hs
=====================================
@@ -1,7 +1,9 @@
{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE LambdaCase #-}
module GHC.Types.DefaultEnv
( ClassDefaults (..)
+ , DefaultProvenance (..)
, DefaultEnv
, emptyDefaultEnv
, isEmptyDefaultEnv
@@ -12,6 +14,8 @@ module GHC.Types.DefaultEnv
, defaultList
, plusDefaultEnv
, mkDefaultEnv
+ , insertDefaultEnv
+ , isHaskell2010Default
)
where
@@ -22,6 +26,7 @@ import GHC.Tc.Utils.TcType (Type)
import GHC.Types.Name (Name, nameUnique, stableNameCmp)
import GHC.Types.Name.Env
import GHC.Types.Unique.FM (lookupUFM_Directly)
+import GHC.Types.SrcLoc (SrcSpan)
import GHC.Unit.Module.Warnings (WarningTxt)
import GHC.Unit.Types (Module)
import GHC.Utils.Outputable
@@ -37,13 +42,73 @@ import Data.Function (on)
-- NB: this includes Haskell98 default declarations, at the 'Num' key.
type DefaultEnv = NameEnv ClassDefaults
+{- Note [DefaultProvenance]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Each `ClassDefault` is annotated with its `DefaultProvenance`, which
+says where the default came from. Specifically
+* `DP_Local loc h98`: the default came from an explicit `default` declaration in the module
+ being compiled, at location `loc`, and the boolean `h98` indicates whether
+ it was from a Haskell 98 default declaration (e.g. `default (Int, Double)`).
+* `DP_Imported M`: the default was imported, it is explicitly exported by module `M`.
+* `DP_Builtin`: the default was automatically provided by GHC.
+ see Note [Builtin class defaults] in GHC.Tc.Utils.Env
+
+These annotations are used to disambiguate multiple defaults for the same class.
+For example, consider the following modules:
+
+ module M( default C ) where { default C( ... ) }
+ module M2( default C) where { import M }
+ module N( default C () where { default C(... ) }
+
+ module A where { import M2 }
+ module B where { import M2; import N }
+ module A1 where { import N; default C ( ... ) }
+ module B2 where { default C ( ... ); default C ( ... ) }
+
+When compiling N, the default for C is annotated with DP_Local loc.
+When compiling M2, the default for C is annotated with DP_Local M.
+When compiling A, the default for C is annotated with DP_Imported M2.
+
+Cases we needed to disambiguate:
+ * Compiling B, two defaults for C: DP_Imported M2, DP_Imported N.
+ * Compiling A1, two defaults for C: DP_Imported N, DP_Local loc.
+ * Compiling B2, two defaults for C: DP_Local loc1, DP_Local loc2.
+
+For how we disambiguate these cases,
+See Note [Disambiguation of multiple default declarations] in GHC.Tc.Module.
+-}
+
+-- | The provenance of a collection of default types for a class.
+-- see Note [DefaultProvenance] for more details
+data DefaultProvenance
+ -- | A locally defined default declaration.
+ = DP_Local
+ { defaultDeclLoc :: SrcSpan -- ^ The 'SrcSpan' of the default declaration
+ , defaultDeclH98 :: Bool -- ^ Is this a Haskell 98 default declaration?
+ }
+ -- | Built-in class defaults.
+ | DP_Builtin
+ -- | Imported class defaults.
+ | DP_Imported Module -- ^ The module from which the defaults were imported
+ deriving (Eq, Data)
+
+instance Outputable DefaultProvenance where
+ ppr (DP_Local loc h98) = ppr loc <> (if h98 then text " (H98)" else empty)
+ ppr DP_Builtin = text "built-in"
+ ppr (DP_Imported mod) = ppr mod
+
+isHaskell2010Default :: DefaultProvenance -> Bool
+isHaskell2010Default = \case
+ DP_Local { defaultDeclH98 = isH98 } -> isH98
+ DP_Builtin -> True
+ DP_Imported {} -> False
+
-- | Defaulting type assignments for the given class.
data ClassDefaults
= ClassDefaults { cd_class :: Class -- ^ The class whose defaults are being defined
, cd_types :: [Type]
- , cd_module :: Maybe Module
- -- ^ @Nothing@ for built-in,
- -- @Just@ the current module or the module whence the default was imported
+ , cd_provenance :: DefaultProvenance
+ -- ^ Where the defaults came from
-- see Note [Default exports] in GHC.Tc.Gen.Export
, cd_warn :: Maybe (WarningTxt GhcRn)
-- ^ Warning emitted when the default is used
@@ -70,6 +135,9 @@ defaultList :: DefaultEnv -> [ClassDefaults]
defaultList = sortBy (stableNameCmp `on` className . cd_class) . nonDetNameEnvElts
-- sortBy recovers determinism
+insertDefaultEnv :: ClassDefaults -> DefaultEnv -> DefaultEnv
+insertDefaultEnv d env = extendNameEnv env (className $ cd_class d) d
+
lookupDefaultEnv :: DefaultEnv -> Name -> Maybe ClassDefaults
lookupDefaultEnv env = lookupUFM_Directly env . nameUnique
=====================================
hadrian/src/Settings/Packages.hs
=====================================
@@ -286,10 +286,6 @@ ghcInternalArgs = package ghcInternal ? do
rtsPackageArgs :: Args
rtsPackageArgs = package rts ? do
projectVersion <- getSetting ProjectVersion
- hostPlatform <- queryHost targetPlatformTriple
- hostArch <- queryHost queryArch
- hostOs <- queryHost queryOS
- hostVendor <- queryHost queryVendor
buildPlatform <- queryBuild targetPlatformTriple
buildArch <- queryBuild queryArch
buildOs <- queryBuild queryOS
@@ -371,18 +367,16 @@ rtsPackageArgs = package rts ? do
, input "**/RtsUtils.c" ? pure
[ "-DProjectVersion=" ++ show projectVersion
- , "-DHostPlatform=" ++ show hostPlatform
- , "-DHostArch=" ++ show hostArch
- , "-DHostOS=" ++ show hostOs
- , "-DHostVendor=" ++ show hostVendor
+ -- the RTS' host is the compiler's target (the target should be
+ -- per stage ideally...)
+ , "-DHostPlatform=" ++ show targetPlatform
+ , "-DHostArch=" ++ show targetArch
+ , "-DHostOS=" ++ show targetOs
+ , "-DHostVendor=" ++ show targetVendor
, "-DBuildPlatform=" ++ show buildPlatform
, "-DBuildArch=" ++ show buildArch
, "-DBuildOS=" ++ show buildOs
, "-DBuildVendor=" ++ show buildVendor
- , "-DTargetPlatform=" ++ show targetPlatform
- , "-DTargetArch=" ++ show targetArch
- , "-DTargetOS=" ++ show targetOs
- , "-DTargetVendor=" ++ show targetVendor
, "-DGhcUnregisterised=" ++ show (yesNo ghcUnreg)
, "-DTablesNextToCode=" ++ show (yesNo ghcEnableTNC)
, "-DRtsWay=\"rts_" ++ show way ++ "\""
=====================================
libraries/base/base.cabal.in
=====================================
@@ -170,7 +170,6 @@ Library
, GHC.Exception
, GHC.Exception.Type
, GHC.ExecutionStack
- , GHC.ExecutionStack.Internal
, GHC.Exts
, GHC.Fingerprint
, GHC.Fingerprint.Type
@@ -247,9 +246,7 @@ Library
, GHC.TopHandler
, GHC.TypeError
, GHC.TypeLits
- , GHC.TypeLits.Internal
, GHC.TypeNats
- , GHC.TypeNats.Internal
, GHC.Unicode
, GHC.Weak
, GHC.Weak.Finalize
=====================================
libraries/base/changelog.md
=====================================
@@ -17,6 +17,10 @@
* `Control.Concurrent.threadWaitWriteSTM`
* `System.Timeout.timeout`
* `GHC.Conc.Signal.runHandlers`
+ * The following internal modules have been removed from `base`, as per [CLC #217](https://github.com/haskell/core-libraries-committee/issues/217):
+ * `GHC.TypeLits.Internal`
+ * `GHC.TypeNats.Internal`
+ * `GHC.ExecutionStack.Internal`.
## 4.21.0.0 *TBA*
* Change `SrcLoc` to be a strict and unboxed (finishing [CLC proposal #55](https://github.com/haskell/core-libraries-committee/issues/55))
=====================================
libraries/base/src/GHC/ExecutionStack/Internal.hs deleted
=====================================
@@ -1,31 +0,0 @@
--- |
--- Module : GHC.Internal.ExecutionStack.Internal
--- Copyright : (c) The University of Glasgow 2013-2015
--- License : see libraries/base/LICENSE
---
--- Maintainer : ghc-devs(a)haskell.org
--- Stability : internal
--- Portability : non-portable (GHC Extensions)
---
--- Internals of the "GHC.ExecutionStack" module.
---
--- /The API of this module is unstable and not meant to be consumed by the general public./
--- If you absolutely must depend on it, make sure to use a tight upper
--- bound, e.g., @base < 4.X@ rather than @base < 5@, because the interface can
--- change rapidly without much warning.
---
--- @since 4.9.0.0
-
-module GHC.ExecutionStack.Internal {-# DEPRECATED "This module will be removed from base in the next version (v4.22)" #-} (
- -- * Internal
- Location (..)
- , SrcLoc (..)
- , StackTrace
- , stackFrames
- , stackDepth
- , collectStackTrace
- , showStackFrames
- , invalidateDebugCache
- ) where
-
-import GHC.Internal.ExecutionStack.Internal
=====================================
libraries/base/src/GHC/TypeLits/Internal.hs deleted
=====================================
@@ -1,35 +0,0 @@
-{-# LANGUAGE Safe #-}
-{-# OPTIONS_HADDOCK not-home #-}
-
--- |
---
--- Module : GHC.TypeLits.Internal
--- Copyright : (c) The University of Glasgow, 1994-2000
--- License : see libraries/base/LICENSE
---
--- Maintainer : ghc-devs(a)haskell.org
--- Stability : internal
--- Portability : non-portable (GHC extensions)
---
--- __Do not use this module.__ Use "GHC.TypeLits" instead.
---
--- This module is internal-only and was exposed by accident. It may be
--- removed without warning in a future version.
---
--- /The API of this module is unstable and is tightly coupled to GHC's internals./
--- If depend on it, make sure to use a tight upper bound, e.g., @base < 4.X@ rather
--- than @base < 5@, because the interface can change rapidly without much warning.
---
--- The technical reason for this module's existence is that it is needed
--- to prevent module cycles while still allowing these identifiers to be
--- imported in "Data.Type.Ord".
---
--- @since 4.16.0.0
-
-module GHC.TypeLits.Internal {-# DEPRECATED "This module will be removed from base in the next version (v4.22)" #-}
- (Symbol,
- CmpSymbol,
- CmpChar
- ) where
-
-import GHC.Internal.TypeLits.Internal
=====================================
libraries/base/src/GHC/TypeNats/Internal.hs deleted
=====================================
@@ -1,9 +0,0 @@
-{-# LANGUAGE Safe #-}
-{-# OPTIONS_HADDOCK not-home #-}
-
-module GHC.TypeNats.Internal {-# DEPRECATED "This module will be removed from base in the next version (v4.22)" #-}
- (Natural,
- CmpNat
- ) where
-
-import GHC.Internal.TypeNats.Internal
=====================================
rts/RtsUtils.c
=====================================
@@ -364,18 +364,10 @@ void printRtsInfo(const RtsConfig rts_config) {
printf(" [(\"GHC RTS\", \"YES\")\n");
mkRtsInfoPair("GHC version", ProjectVersion);
mkRtsInfoPair("RTS way", RtsWay);
- mkRtsInfoPair("Build platform", BuildPlatform);
- mkRtsInfoPair("Build architecture", BuildArch);
- mkRtsInfoPair("Build OS", BuildOS);
- mkRtsInfoPair("Build vendor", BuildVendor);
mkRtsInfoPair("Host platform", HostPlatform);
mkRtsInfoPair("Host architecture", HostArch);
mkRtsInfoPair("Host OS", HostOS);
mkRtsInfoPair("Host vendor", HostVendor);
- mkRtsInfoPair("Target platform", TargetPlatform);
- mkRtsInfoPair("Target architecture", TargetArch);
- mkRtsInfoPair("Target OS", TargetOS);
- mkRtsInfoPair("Target vendor", TargetVendor);
mkRtsInfoPair("Word size", TOSTRING(WORD_SIZE_IN_BITS));
// TODO(@Ericson2314) This is a joint property of the RTS and generated
// code. The compiler will soon be multi-target so it doesn't make sense to
=====================================
testsuite/ghc-config/ghc-config.hs
=====================================
@@ -1,6 +1,7 @@
import System.Environment
import System.Process
import Data.Maybe
+import Control.Monad
main :: IO ()
main = do
@@ -9,15 +10,25 @@ main = do
info <- readProcess ghc ["+RTS", "--info"] ""
let fields = read info :: [(String,String)]
getGhcFieldOrFail fields "HostOS" "Host OS"
- getGhcFieldOrFail fields "WORDSIZE" "Word size"
- getGhcFieldOrFail fields "TARGETPLATFORM" "Target platform"
- getGhcFieldOrFail fields "TargetOS_CPP" "Target OS"
- getGhcFieldOrFail fields "TargetARCH_CPP" "Target architecture"
getGhcFieldOrFail fields "RTSWay" "RTS way"
+ -- support for old GHCs (pre 9.13): infer target platform by querying the rts...
+ let query_rts = isJust (lookup "Target platform" fields)
+ when query_rts $ do
+ getGhcFieldOrFail fields "WORDSIZE" "Word size"
+ getGhcFieldOrFail fields "TARGETPLATFORM" "Target platform"
+ getGhcFieldOrFail fields "TargetOS_CPP" "Target OS"
+ getGhcFieldOrFail fields "TargetARCH_CPP" "Target architecture"
+
info <- readProcess ghc ["--info"] ""
let fields = read info :: [(String,String)]
+ unless query_rts $ do
+ getGhcFieldOrFail fields "WORDSIZE" "target word size in bits"
+ getGhcFieldOrFail fields "TARGETPLATFORM" "target platform string"
+ getGhcFieldOrFail fields "TargetOS_CPP" "target os string"
+ getGhcFieldOrFail fields "TargetARCH_CPP" "target arch string"
+
getGhcFieldOrFail fields "GhcStage" "Stage"
getGhcFieldOrFail fields "GhcDebugAssertions" "Debug on"
getGhcFieldOrFail fields "GhcWithNativeCodeGen" "Have native code generator"
=====================================
testsuite/tests/default/T25912.hs
=====================================
@@ -0,0 +1,14 @@
+{-# LANGUAGE NamedDefaults #-}
+
+module Main where
+
+import T25912_helper
+
+-- now we declare the default instances
+-- for the classes C again to check that
+-- it won't hide the default instances for class B
+default C (String)
+
+main :: IO ()
+main = do
+ print b
=====================================
testsuite/tests/default/T25912.stdout
=====================================
@@ -0,0 +1 @@
+"String"
=====================================
testsuite/tests/default/T25912_helper.hs
=====================================
@@ -0,0 +1,17 @@
+{-# LANGUAGE NamedDefaults #-}
+
+module T25912_helper ( default C, C(c), default B, b ) where
+
+class C a where
+ c :: a
+instance C Int where
+ c = 1
+instance C String where
+ c = "String"
+default C (String)
+
+class B a where
+ b :: a
+instance B String where
+ b = "String"
+default B (String)
=====================================
testsuite/tests/default/T25914.hs
=====================================
@@ -0,0 +1,5 @@
+{-# LANGUAGE NamedDefaults, OverloadedStrings #-}
+module NamedDefaultsNum where
+import Data.String
+default Num ()
+foo = "abc"
=====================================
testsuite/tests/default/T25934.hs
=====================================
@@ -0,0 +1,5 @@
+{-# LANGUAGE ExtendedDefaultRules #-}
+{-# LANGUAGE NamedDefaults #-}
+module T25934 where
+default Num (Int)
+default Show (Int)
=====================================
testsuite/tests/default/all.T
=====================================
@@ -39,3 +39,6 @@ test('T25858v2', [extra_files(['T25858v2_helper.hs'])], multimod_compile_and_run
test('T25858v3', [extra_files(['T25858v3_helper.hs'])], multimod_compile_and_run, ['T25858v3', ''])
test('T25858v4', normal, compile_and_run, [''])
test('T25882', normal, compile, [''])
+test('T25912', [extra_files(['T25912_helper.hs'])], multimod_compile_and_run, ['T25912', ''])
+test('T25914', normal, compile, [''])
+test('T25934', normal, compile, [''])
=====================================
testsuite/tests/default/default-fail03.stderr
=====================================
@@ -1,3 +1,4 @@
-default-fail03.hs:4:1: [GHC-99565]
+default-fail03.hs:4:1: error: [GHC-99565]
Multiple default declarations for class ‘Num’
- here was another default declaration default-fail03.hs:3:1-29
+ conflicting named default declaration at: default-fail03.hs:3:1-29
+
=====================================
testsuite/tests/interface-stability/base-exports.stdout
=====================================
@@ -5365,20 +5365,6 @@ module GHC.ExecutionStack where
getStackTrace :: GHC.Internal.Types.IO (GHC.Internal.Maybe.Maybe [Location])
showStackTrace :: GHC.Internal.Types.IO (GHC.Internal.Maybe.Maybe GHC.Internal.Base.String)
-module GHC.ExecutionStack.Internal where
- -- Safety: None
- type Location :: *
- data Location = Location {objectName :: GHC.Internal.Base.String, functionName :: GHC.Internal.Base.String, srcLoc :: GHC.Internal.Maybe.Maybe SrcLoc}
- type SrcLoc :: *
- data SrcLoc = SrcLoc {sourceFile :: GHC.Internal.Base.String, sourceLine :: GHC.Internal.Types.Int, sourceColumn :: GHC.Internal.Types.Int}
- type StackTrace :: *
- newtype StackTrace = ...
- collectStackTrace :: GHC.Internal.Types.IO (GHC.Internal.Maybe.Maybe StackTrace)
- invalidateDebugCache :: GHC.Internal.Types.IO ()
- showStackFrames :: [Location] -> GHC.Internal.Show.ShowS
- stackDepth :: StackTrace -> GHC.Internal.Types.Int
- stackFrames :: StackTrace -> GHC.Internal.Maybe.Maybe [Location]
-
module GHC.Exts where
-- Safety: None
(*#) :: Int# -> Int# -> Int#
@@ -9672,15 +9658,6 @@ module GHC.TypeLits where
withSomeSNat :: forall (rep :: GHC.Internal.Types.RuntimeRep) (r :: TYPE rep). GHC.Internal.Bignum.Integer.Integer -> (forall (n :: Nat). GHC.Internal.Maybe.Maybe (SNat n) -> r) -> r
withSomeSSymbol :: forall (rep :: GHC.Internal.Types.RuntimeRep) (r :: TYPE rep). GHC.Internal.Base.String -> (forall (s :: Symbol). SSymbol s -> r) -> r
-module GHC.TypeLits.Internal where
- -- Safety: Safe
- type CmpChar :: GHC.Internal.Types.Char -> GHC.Internal.Types.Char -> GHC.Internal.Types.Ordering
- type family CmpChar a b
- type CmpSymbol :: Symbol -> Symbol -> GHC.Internal.Types.Ordering
- type family CmpSymbol a b
- type Symbol :: *
- data Symbol
-
module GHC.TypeNats where
-- Safety: Safe
type (*) :: Natural -> Natural -> Natural
@@ -9727,13 +9704,6 @@ module GHC.TypeNats where
withKnownNat :: forall (n :: Nat) (rep :: GHC.Internal.Types.RuntimeRep) (r :: TYPE rep). SNat n -> (KnownNat n => r) -> r
withSomeSNat :: forall (rep :: GHC.Internal.Types.RuntimeRep) (r :: TYPE rep). Natural -> (forall (n :: Nat). SNat n -> r) -> r
-module GHC.TypeNats.Internal where
- -- Safety: Safe
- type CmpNat :: Natural -> Natural -> GHC.Internal.Types.Ordering
- type family CmpNat a b
- type Natural :: *
- data Natural = ...
-
module GHC.Unicode where
-- Safety: Safe
type GeneralCategory :: *
=====================================
testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
=====================================
@@ -5337,20 +5337,6 @@ module GHC.ExecutionStack where
getStackTrace :: GHC.Internal.Types.IO (GHC.Internal.Maybe.Maybe [Location])
showStackTrace :: GHC.Internal.Types.IO (GHC.Internal.Maybe.Maybe GHC.Internal.Base.String)
-module GHC.ExecutionStack.Internal where
- -- Safety: None
- type Location :: *
- data Location = Location {objectName :: GHC.Internal.Base.String, functionName :: GHC.Internal.Base.String, srcLoc :: GHC.Internal.Maybe.Maybe SrcLoc}
- type SrcLoc :: *
- data SrcLoc = SrcLoc {sourceFile :: GHC.Internal.Base.String, sourceLine :: GHC.Internal.Types.Int, sourceColumn :: GHC.Internal.Types.Int}
- type StackTrace :: *
- newtype StackTrace = ...
- collectStackTrace :: GHC.Internal.Types.IO (GHC.Internal.Maybe.Maybe StackTrace)
- invalidateDebugCache :: GHC.Internal.Types.IO ()
- showStackFrames :: [Location] -> GHC.Internal.Show.ShowS
- stackDepth :: StackTrace -> GHC.Internal.Types.Int
- stackFrames :: StackTrace -> GHC.Internal.Maybe.Maybe [Location]
-
module GHC.Exts where
-- Safety: None
(*#) :: Int# -> Int# -> Int#
@@ -12718,15 +12704,6 @@ module GHC.TypeLits where
withSomeSNat :: forall (rep :: GHC.Internal.Types.RuntimeRep) (r :: TYPE rep). GHC.Internal.Bignum.Integer.Integer -> (forall (n :: Nat). GHC.Internal.Maybe.Maybe (SNat n) -> r) -> r
withSomeSSymbol :: forall (rep :: GHC.Internal.Types.RuntimeRep) (r :: TYPE rep). GHC.Internal.Base.String -> (forall (s :: Symbol). SSymbol s -> r) -> r
-module GHC.TypeLits.Internal where
- -- Safety: Safe
- type CmpChar :: GHC.Internal.Types.Char -> GHC.Internal.Types.Char -> GHC.Internal.Types.Ordering
- type family CmpChar a b
- type CmpSymbol :: Symbol -> Symbol -> GHC.Internal.Types.Ordering
- type family CmpSymbol a b
- type Symbol :: *
- data Symbol
-
module GHC.TypeNats where
-- Safety: Safe
type (*) :: Natural -> Natural -> Natural
@@ -12773,13 +12750,6 @@ module GHC.TypeNats where
withKnownNat :: forall (n :: Nat) (rep :: GHC.Internal.Types.RuntimeRep) (r :: TYPE rep). SNat n -> (KnownNat n => r) -> r
withSomeSNat :: forall (rep :: GHC.Internal.Types.RuntimeRep) (r :: TYPE rep). Natural -> (forall (n :: Nat). SNat n -> r) -> r
-module GHC.TypeNats.Internal where
- -- Safety: Safe
- type CmpNat :: Natural -> Natural -> GHC.Internal.Types.Ordering
- type family CmpNat a b
- type Natural :: *
- data Natural = ...
-
module GHC.Unicode where
-- Safety: Safe
type GeneralCategory :: *
=====================================
testsuite/tests/interface-stability/base-exports.stdout-mingw32
=====================================
@@ -5505,20 +5505,6 @@ module GHC.ExecutionStack where
getStackTrace :: GHC.Internal.Types.IO (GHC.Internal.Maybe.Maybe [Location])
showStackTrace :: GHC.Internal.Types.IO (GHC.Internal.Maybe.Maybe GHC.Internal.Base.String)
-module GHC.ExecutionStack.Internal where
- -- Safety: None
- type Location :: *
- data Location = Location {objectName :: GHC.Internal.Base.String, functionName :: GHC.Internal.Base.String, srcLoc :: GHC.Internal.Maybe.Maybe SrcLoc}
- type SrcLoc :: *
- data SrcLoc = SrcLoc {sourceFile :: GHC.Internal.Base.String, sourceLine :: GHC.Internal.Types.Int, sourceColumn :: GHC.Internal.Types.Int}
- type StackTrace :: *
- newtype StackTrace = ...
- collectStackTrace :: GHC.Internal.Types.IO (GHC.Internal.Maybe.Maybe StackTrace)
- invalidateDebugCache :: GHC.Internal.Types.IO ()
- showStackFrames :: [Location] -> GHC.Internal.Show.ShowS
- stackDepth :: StackTrace -> GHC.Internal.Types.Int
- stackFrames :: StackTrace -> GHC.Internal.Maybe.Maybe [Location]
-
module GHC.Exts where
-- Safety: None
(*#) :: Int# -> Int# -> Int#
@@ -9890,15 +9876,6 @@ module GHC.TypeLits where
withSomeSNat :: forall (rep :: GHC.Internal.Types.RuntimeRep) (r :: TYPE rep). GHC.Internal.Bignum.Integer.Integer -> (forall (n :: Nat). GHC.Internal.Maybe.Maybe (SNat n) -> r) -> r
withSomeSSymbol :: forall (rep :: GHC.Internal.Types.RuntimeRep) (r :: TYPE rep). GHC.Internal.Base.String -> (forall (s :: Symbol). SSymbol s -> r) -> r
-module GHC.TypeLits.Internal where
- -- Safety: Safe
- type CmpChar :: GHC.Internal.Types.Char -> GHC.Internal.Types.Char -> GHC.Internal.Types.Ordering
- type family CmpChar a b
- type CmpSymbol :: Symbol -> Symbol -> GHC.Internal.Types.Ordering
- type family CmpSymbol a b
- type Symbol :: *
- data Symbol
-
module GHC.TypeNats where
-- Safety: Safe
type (*) :: Natural -> Natural -> Natural
@@ -9945,13 +9922,6 @@ module GHC.TypeNats where
withKnownNat :: forall (n :: Nat) (rep :: GHC.Internal.Types.RuntimeRep) (r :: TYPE rep). SNat n -> (KnownNat n => r) -> r
withSomeSNat :: forall (rep :: GHC.Internal.Types.RuntimeRep) (r :: TYPE rep). Natural -> (forall (n :: Nat). SNat n -> r) -> r
-module GHC.TypeNats.Internal where
- -- Safety: Safe
- type CmpNat :: Natural -> Natural -> GHC.Internal.Types.Ordering
- type family CmpNat a b
- type Natural :: *
- data Natural = ...
-
module GHC.Unicode where
-- Safety: Safe
type GeneralCategory :: *
=====================================
testsuite/tests/interface-stability/base-exports.stdout-ws-32
=====================================
@@ -5365,20 +5365,6 @@ module GHC.ExecutionStack where
getStackTrace :: GHC.Internal.Types.IO (GHC.Internal.Maybe.Maybe [Location])
showStackTrace :: GHC.Internal.Types.IO (GHC.Internal.Maybe.Maybe GHC.Internal.Base.String)
-module GHC.ExecutionStack.Internal where
- -- Safety: None
- type Location :: *
- data Location = Location {objectName :: GHC.Internal.Base.String, functionName :: GHC.Internal.Base.String, srcLoc :: GHC.Internal.Maybe.Maybe SrcLoc}
- type SrcLoc :: *
- data SrcLoc = SrcLoc {sourceFile :: GHC.Internal.Base.String, sourceLine :: GHC.Internal.Types.Int, sourceColumn :: GHC.Internal.Types.Int}
- type StackTrace :: *
- newtype StackTrace = ...
- collectStackTrace :: GHC.Internal.Types.IO (GHC.Internal.Maybe.Maybe StackTrace)
- invalidateDebugCache :: GHC.Internal.Types.IO ()
- showStackFrames :: [Location] -> GHC.Internal.Show.ShowS
- stackDepth :: StackTrace -> GHC.Internal.Types.Int
- stackFrames :: StackTrace -> GHC.Internal.Maybe.Maybe [Location]
-
module GHC.Exts where
-- Safety: None
(*#) :: Int# -> Int# -> Int#
@@ -9672,15 +9658,6 @@ module GHC.TypeLits where
withSomeSNat :: forall (rep :: GHC.Internal.Types.RuntimeRep) (r :: TYPE rep). GHC.Internal.Bignum.Integer.Integer -> (forall (n :: Nat). GHC.Internal.Maybe.Maybe (SNat n) -> r) -> r
withSomeSSymbol :: forall (rep :: GHC.Internal.Types.RuntimeRep) (r :: TYPE rep). GHC.Internal.Base.String -> (forall (s :: Symbol). SSymbol s -> r) -> r
-module GHC.TypeLits.Internal where
- -- Safety: Safe
- type CmpChar :: GHC.Internal.Types.Char -> GHC.Internal.Types.Char -> GHC.Internal.Types.Ordering
- type family CmpChar a b
- type CmpSymbol :: Symbol -> Symbol -> GHC.Internal.Types.Ordering
- type family CmpSymbol a b
- type Symbol :: *
- data Symbol
-
module GHC.TypeNats where
-- Safety: Safe
type (*) :: Natural -> Natural -> Natural
@@ -9727,13 +9704,6 @@ module GHC.TypeNats where
withKnownNat :: forall (n :: Nat) (rep :: GHC.Internal.Types.RuntimeRep) (r :: TYPE rep). SNat n -> (KnownNat n => r) -> r
withSomeSNat :: forall (rep :: GHC.Internal.Types.RuntimeRep) (r :: TYPE rep). Natural -> (forall (n :: Nat). SNat n -> r) -> r
-module GHC.TypeNats.Internal where
- -- Safety: Safe
- type CmpNat :: Natural -> Natural -> GHC.Internal.Types.Ordering
- type family CmpNat a b
- type Natural :: *
- data Natural = ...
-
module GHC.Unicode where
-- Safety: Safe
type GeneralCategory :: *
=====================================
testsuite/tests/linters/notes.stdout
=====================================
@@ -8,7 +8,7 @@ ref compiler/GHC/Core/Opt/Simplify/Iteration.hs:4345:8: Note [Lambda-boun
ref compiler/GHC/Core/Opt/Simplify/Utils.hs:1387:37: Note [Gentle mode]
ref compiler/GHC/Core/Opt/Specialise.hs:1761:29: Note [Arity decrease]
ref compiler/GHC/Core/TyCo/Rep.hs:1783:31: Note [What prevents a constraint from floating]
-ref compiler/GHC/Driver/DynFlags.hs:1216:52: Note [Eta-reduction in -O0]
+ref compiler/GHC/Driver/DynFlags.hs:1218:52: Note [Eta-reduction in -O0]
ref compiler/GHC/Driver/Main.hs:1901:34: Note [simpleTidyPgm - mkBootModDetailsTc]
ref compiler/GHC/Hs/Expr.hs:189:63: Note [Pending Splices]
ref compiler/GHC/Hs/Expr.hs:2194:87: Note [Lifecycle of a splice]
@@ -18,10 +18,8 @@ ref compiler/GHC/Hs/Pat.hs:151:74: Note [Lifecycle of a splice]
ref compiler/GHC/HsToCore/Pmc/Solver.hs:860:20: Note [COMPLETE sets on data families]
ref compiler/GHC/HsToCore/Quote.hs:1533:7: Note [How brackets and nested splices are handled]
ref compiler/GHC/Stg/Unarise.hs:457:32: Note [Renaming during unarisation]
-ref compiler/GHC/Tc/Gen/Default.hs:87:6: Note [Disambiguation of multiple default declarations]
-ref compiler/GHC/Tc/Gen/Default.hs:193:11: Note [Disambiguation of multiple default declarations]
ref compiler/GHC/Tc/Gen/HsType.hs:563:56: Note [Skolem escape prevention]
-ref compiler/GHC/Tc/Gen/HsType.hs:2693:7: Note [Matching a kind signature with a declaration]
+ref compiler/GHC/Tc/Gen/HsType.hs:2717:7: Note [Matching a kind signature with a declaration]
ref compiler/GHC/Tc/Gen/Pat.hs:284:20: Note [Typing patterns in pattern bindings]
ref compiler/GHC/Tc/Gen/Pat.hs:1378:7: Note [Matching polytyped patterns]
ref compiler/GHC/Tc/Gen/Sig.hs:91:10: Note [Overview of type signatures]
@@ -30,8 +28,6 @@ ref compiler/GHC/Tc/Gen/Splice.hs:543:35: Note [PendingRnSplice]
ref compiler/GHC/Tc/Gen/Splice.hs:670:7: Note [How brackets and nested splices are handled]
ref compiler/GHC/Tc/Gen/Splice.hs:909:11: Note [How brackets and nested splices are handled]
ref compiler/GHC/Tc/Instance/Family.hs:458:35: Note [Constrained family instances]
-ref compiler/GHC/Tc/Module.hs:385:3: Note [Disambiguation of multiple default declarations]
-ref compiler/GHC/Tc/Module.hs:420:7: Note [Disambiguation of multiple default declarations]
ref compiler/GHC/Tc/Solver/Rewrite.hs:1015:7: Note [Stability of rewriting]
ref compiler/GHC/Tc/TyCl.hs:1322:6: Note [Unification variables need fresh Names]
ref compiler/GHC/Tc/Types/Constraint.hs:209:9: Note [NonCanonical Semantics]
=====================================
testsuite/tests/module/mod58.stderr
=====================================
@@ -1,4 +1,4 @@
-
mod58.hs:4:1: error: [GHC-99565]
Multiple default declarations for class ‘Num’
- here was another default declaration mod58.hs:3:1-21
+ conflicting default declaration at: mod58.hs:3:1-21
+
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/65470211952668cee67c06e0ebca8d…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/65470211952668cee67c06e0ebca8d…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][master] base: remove .Internal modules (e.g. GHC.TypeLits)
by Marge Bot (@marge-bot) 16 Apr '25
by Marge Bot (@marge-bot) 16 Apr '25
16 Apr '25
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
395e0ad1 by sheaf at 2025-04-16T12:33:26-04:00
base: remove .Internal modules (e.g. GHC.TypeLits)
This commit removes the following internal modules from base,
as per CLC proposal 217:
- GHC.TypeNats.Internal
- GHC.TypeLits.Internal
- GHC.ExecutionStack.Internal
Fixes #25007
- - - - -
9 changed files:
- libraries/base/base.cabal.in
- libraries/base/changelog.md
- − libraries/base/src/GHC/ExecutionStack/Internal.hs
- − libraries/base/src/GHC/TypeLits/Internal.hs
- − libraries/base/src/GHC/TypeNats/Internal.hs
- testsuite/tests/interface-stability/base-exports.stdout
- testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
- testsuite/tests/interface-stability/base-exports.stdout-mingw32
- testsuite/tests/interface-stability/base-exports.stdout-ws-32
Changes:
=====================================
libraries/base/base.cabal.in
=====================================
@@ -170,7 +170,6 @@ Library
, GHC.Exception
, GHC.Exception.Type
, GHC.ExecutionStack
- , GHC.ExecutionStack.Internal
, GHC.Exts
, GHC.Fingerprint
, GHC.Fingerprint.Type
@@ -247,9 +246,7 @@ Library
, GHC.TopHandler
, GHC.TypeError
, GHC.TypeLits
- , GHC.TypeLits.Internal
, GHC.TypeNats
- , GHC.TypeNats.Internal
, GHC.Unicode
, GHC.Weak
, GHC.Weak.Finalize
=====================================
libraries/base/changelog.md
=====================================
@@ -17,6 +17,10 @@
* `Control.Concurrent.threadWaitWriteSTM`
* `System.Timeout.timeout`
* `GHC.Conc.Signal.runHandlers`
+ * The following internal modules have been removed from `base`, as per [CLC #217](https://github.com/haskell/core-libraries-committee/issues/217):
+ * `GHC.TypeLits.Internal`
+ * `GHC.TypeNats.Internal`
+ * `GHC.ExecutionStack.Internal`.
## 4.21.0.0 *TBA*
* Change `SrcLoc` to be a strict and unboxed (finishing [CLC proposal #55](https://github.com/haskell/core-libraries-committee/issues/55))
=====================================
libraries/base/src/GHC/ExecutionStack/Internal.hs deleted
=====================================
@@ -1,31 +0,0 @@
--- |
--- Module : GHC.Internal.ExecutionStack.Internal
--- Copyright : (c) The University of Glasgow 2013-2015
--- License : see libraries/base/LICENSE
---
--- Maintainer : ghc-devs(a)haskell.org
--- Stability : internal
--- Portability : non-portable (GHC Extensions)
---
--- Internals of the "GHC.ExecutionStack" module.
---
--- /The API of this module is unstable and not meant to be consumed by the general public./
--- If you absolutely must depend on it, make sure to use a tight upper
--- bound, e.g., @base < 4.X@ rather than @base < 5@, because the interface can
--- change rapidly without much warning.
---
--- @since 4.9.0.0
-
-module GHC.ExecutionStack.Internal {-# DEPRECATED "This module will be removed from base in the next version (v4.22)" #-} (
- -- * Internal
- Location (..)
- , SrcLoc (..)
- , StackTrace
- , stackFrames
- , stackDepth
- , collectStackTrace
- , showStackFrames
- , invalidateDebugCache
- ) where
-
-import GHC.Internal.ExecutionStack.Internal
=====================================
libraries/base/src/GHC/TypeLits/Internal.hs deleted
=====================================
@@ -1,35 +0,0 @@
-{-# LANGUAGE Safe #-}
-{-# OPTIONS_HADDOCK not-home #-}
-
--- |
---
--- Module : GHC.TypeLits.Internal
--- Copyright : (c) The University of Glasgow, 1994-2000
--- License : see libraries/base/LICENSE
---
--- Maintainer : ghc-devs(a)haskell.org
--- Stability : internal
--- Portability : non-portable (GHC extensions)
---
--- __Do not use this module.__ Use "GHC.TypeLits" instead.
---
--- This module is internal-only and was exposed by accident. It may be
--- removed without warning in a future version.
---
--- /The API of this module is unstable and is tightly coupled to GHC's internals./
--- If depend on it, make sure to use a tight upper bound, e.g., @base < 4.X@ rather
--- than @base < 5@, because the interface can change rapidly without much warning.
---
--- The technical reason for this module's existence is that it is needed
--- to prevent module cycles while still allowing these identifiers to be
--- imported in "Data.Type.Ord".
---
--- @since 4.16.0.0
-
-module GHC.TypeLits.Internal {-# DEPRECATED "This module will be removed from base in the next version (v4.22)" #-}
- (Symbol,
- CmpSymbol,
- CmpChar
- ) where
-
-import GHC.Internal.TypeLits.Internal
=====================================
libraries/base/src/GHC/TypeNats/Internal.hs deleted
=====================================
@@ -1,9 +0,0 @@
-{-# LANGUAGE Safe #-}
-{-# OPTIONS_HADDOCK not-home #-}
-
-module GHC.TypeNats.Internal {-# DEPRECATED "This module will be removed from base in the next version (v4.22)" #-}
- (Natural,
- CmpNat
- ) where
-
-import GHC.Internal.TypeNats.Internal
=====================================
testsuite/tests/interface-stability/base-exports.stdout
=====================================
@@ -5365,20 +5365,6 @@ module GHC.ExecutionStack where
getStackTrace :: GHC.Internal.Types.IO (GHC.Internal.Maybe.Maybe [Location])
showStackTrace :: GHC.Internal.Types.IO (GHC.Internal.Maybe.Maybe GHC.Internal.Base.String)
-module GHC.ExecutionStack.Internal where
- -- Safety: None
- type Location :: *
- data Location = Location {objectName :: GHC.Internal.Base.String, functionName :: GHC.Internal.Base.String, srcLoc :: GHC.Internal.Maybe.Maybe SrcLoc}
- type SrcLoc :: *
- data SrcLoc = SrcLoc {sourceFile :: GHC.Internal.Base.String, sourceLine :: GHC.Internal.Types.Int, sourceColumn :: GHC.Internal.Types.Int}
- type StackTrace :: *
- newtype StackTrace = ...
- collectStackTrace :: GHC.Internal.Types.IO (GHC.Internal.Maybe.Maybe StackTrace)
- invalidateDebugCache :: GHC.Internal.Types.IO ()
- showStackFrames :: [Location] -> GHC.Internal.Show.ShowS
- stackDepth :: StackTrace -> GHC.Internal.Types.Int
- stackFrames :: StackTrace -> GHC.Internal.Maybe.Maybe [Location]
-
module GHC.Exts where
-- Safety: None
(*#) :: Int# -> Int# -> Int#
@@ -9672,15 +9658,6 @@ module GHC.TypeLits where
withSomeSNat :: forall (rep :: GHC.Internal.Types.RuntimeRep) (r :: TYPE rep). GHC.Internal.Bignum.Integer.Integer -> (forall (n :: Nat). GHC.Internal.Maybe.Maybe (SNat n) -> r) -> r
withSomeSSymbol :: forall (rep :: GHC.Internal.Types.RuntimeRep) (r :: TYPE rep). GHC.Internal.Base.String -> (forall (s :: Symbol). SSymbol s -> r) -> r
-module GHC.TypeLits.Internal where
- -- Safety: Safe
- type CmpChar :: GHC.Internal.Types.Char -> GHC.Internal.Types.Char -> GHC.Internal.Types.Ordering
- type family CmpChar a b
- type CmpSymbol :: Symbol -> Symbol -> GHC.Internal.Types.Ordering
- type family CmpSymbol a b
- type Symbol :: *
- data Symbol
-
module GHC.TypeNats where
-- Safety: Safe
type (*) :: Natural -> Natural -> Natural
@@ -9727,13 +9704,6 @@ module GHC.TypeNats where
withKnownNat :: forall (n :: Nat) (rep :: GHC.Internal.Types.RuntimeRep) (r :: TYPE rep). SNat n -> (KnownNat n => r) -> r
withSomeSNat :: forall (rep :: GHC.Internal.Types.RuntimeRep) (r :: TYPE rep). Natural -> (forall (n :: Nat). SNat n -> r) -> r
-module GHC.TypeNats.Internal where
- -- Safety: Safe
- type CmpNat :: Natural -> Natural -> GHC.Internal.Types.Ordering
- type family CmpNat a b
- type Natural :: *
- data Natural = ...
-
module GHC.Unicode where
-- Safety: Safe
type GeneralCategory :: *
=====================================
testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
=====================================
@@ -5337,20 +5337,6 @@ module GHC.ExecutionStack where
getStackTrace :: GHC.Internal.Types.IO (GHC.Internal.Maybe.Maybe [Location])
showStackTrace :: GHC.Internal.Types.IO (GHC.Internal.Maybe.Maybe GHC.Internal.Base.String)
-module GHC.ExecutionStack.Internal where
- -- Safety: None
- type Location :: *
- data Location = Location {objectName :: GHC.Internal.Base.String, functionName :: GHC.Internal.Base.String, srcLoc :: GHC.Internal.Maybe.Maybe SrcLoc}
- type SrcLoc :: *
- data SrcLoc = SrcLoc {sourceFile :: GHC.Internal.Base.String, sourceLine :: GHC.Internal.Types.Int, sourceColumn :: GHC.Internal.Types.Int}
- type StackTrace :: *
- newtype StackTrace = ...
- collectStackTrace :: GHC.Internal.Types.IO (GHC.Internal.Maybe.Maybe StackTrace)
- invalidateDebugCache :: GHC.Internal.Types.IO ()
- showStackFrames :: [Location] -> GHC.Internal.Show.ShowS
- stackDepth :: StackTrace -> GHC.Internal.Types.Int
- stackFrames :: StackTrace -> GHC.Internal.Maybe.Maybe [Location]
-
module GHC.Exts where
-- Safety: None
(*#) :: Int# -> Int# -> Int#
@@ -12718,15 +12704,6 @@ module GHC.TypeLits where
withSomeSNat :: forall (rep :: GHC.Internal.Types.RuntimeRep) (r :: TYPE rep). GHC.Internal.Bignum.Integer.Integer -> (forall (n :: Nat). GHC.Internal.Maybe.Maybe (SNat n) -> r) -> r
withSomeSSymbol :: forall (rep :: GHC.Internal.Types.RuntimeRep) (r :: TYPE rep). GHC.Internal.Base.String -> (forall (s :: Symbol). SSymbol s -> r) -> r
-module GHC.TypeLits.Internal where
- -- Safety: Safe
- type CmpChar :: GHC.Internal.Types.Char -> GHC.Internal.Types.Char -> GHC.Internal.Types.Ordering
- type family CmpChar a b
- type CmpSymbol :: Symbol -> Symbol -> GHC.Internal.Types.Ordering
- type family CmpSymbol a b
- type Symbol :: *
- data Symbol
-
module GHC.TypeNats where
-- Safety: Safe
type (*) :: Natural -> Natural -> Natural
@@ -12773,13 +12750,6 @@ module GHC.TypeNats where
withKnownNat :: forall (n :: Nat) (rep :: GHC.Internal.Types.RuntimeRep) (r :: TYPE rep). SNat n -> (KnownNat n => r) -> r
withSomeSNat :: forall (rep :: GHC.Internal.Types.RuntimeRep) (r :: TYPE rep). Natural -> (forall (n :: Nat). SNat n -> r) -> r
-module GHC.TypeNats.Internal where
- -- Safety: Safe
- type CmpNat :: Natural -> Natural -> GHC.Internal.Types.Ordering
- type family CmpNat a b
- type Natural :: *
- data Natural = ...
-
module GHC.Unicode where
-- Safety: Safe
type GeneralCategory :: *
=====================================
testsuite/tests/interface-stability/base-exports.stdout-mingw32
=====================================
@@ -5505,20 +5505,6 @@ module GHC.ExecutionStack where
getStackTrace :: GHC.Internal.Types.IO (GHC.Internal.Maybe.Maybe [Location])
showStackTrace :: GHC.Internal.Types.IO (GHC.Internal.Maybe.Maybe GHC.Internal.Base.String)
-module GHC.ExecutionStack.Internal where
- -- Safety: None
- type Location :: *
- data Location = Location {objectName :: GHC.Internal.Base.String, functionName :: GHC.Internal.Base.String, srcLoc :: GHC.Internal.Maybe.Maybe SrcLoc}
- type SrcLoc :: *
- data SrcLoc = SrcLoc {sourceFile :: GHC.Internal.Base.String, sourceLine :: GHC.Internal.Types.Int, sourceColumn :: GHC.Internal.Types.Int}
- type StackTrace :: *
- newtype StackTrace = ...
- collectStackTrace :: GHC.Internal.Types.IO (GHC.Internal.Maybe.Maybe StackTrace)
- invalidateDebugCache :: GHC.Internal.Types.IO ()
- showStackFrames :: [Location] -> GHC.Internal.Show.ShowS
- stackDepth :: StackTrace -> GHC.Internal.Types.Int
- stackFrames :: StackTrace -> GHC.Internal.Maybe.Maybe [Location]
-
module GHC.Exts where
-- Safety: None
(*#) :: Int# -> Int# -> Int#
@@ -9890,15 +9876,6 @@ module GHC.TypeLits where
withSomeSNat :: forall (rep :: GHC.Internal.Types.RuntimeRep) (r :: TYPE rep). GHC.Internal.Bignum.Integer.Integer -> (forall (n :: Nat). GHC.Internal.Maybe.Maybe (SNat n) -> r) -> r
withSomeSSymbol :: forall (rep :: GHC.Internal.Types.RuntimeRep) (r :: TYPE rep). GHC.Internal.Base.String -> (forall (s :: Symbol). SSymbol s -> r) -> r
-module GHC.TypeLits.Internal where
- -- Safety: Safe
- type CmpChar :: GHC.Internal.Types.Char -> GHC.Internal.Types.Char -> GHC.Internal.Types.Ordering
- type family CmpChar a b
- type CmpSymbol :: Symbol -> Symbol -> GHC.Internal.Types.Ordering
- type family CmpSymbol a b
- type Symbol :: *
- data Symbol
-
module GHC.TypeNats where
-- Safety: Safe
type (*) :: Natural -> Natural -> Natural
@@ -9945,13 +9922,6 @@ module GHC.TypeNats where
withKnownNat :: forall (n :: Nat) (rep :: GHC.Internal.Types.RuntimeRep) (r :: TYPE rep). SNat n -> (KnownNat n => r) -> r
withSomeSNat :: forall (rep :: GHC.Internal.Types.RuntimeRep) (r :: TYPE rep). Natural -> (forall (n :: Nat). SNat n -> r) -> r
-module GHC.TypeNats.Internal where
- -- Safety: Safe
- type CmpNat :: Natural -> Natural -> GHC.Internal.Types.Ordering
- type family CmpNat a b
- type Natural :: *
- data Natural = ...
-
module GHC.Unicode where
-- Safety: Safe
type GeneralCategory :: *
=====================================
testsuite/tests/interface-stability/base-exports.stdout-ws-32
=====================================
@@ -5365,20 +5365,6 @@ module GHC.ExecutionStack where
getStackTrace :: GHC.Internal.Types.IO (GHC.Internal.Maybe.Maybe [Location])
showStackTrace :: GHC.Internal.Types.IO (GHC.Internal.Maybe.Maybe GHC.Internal.Base.String)
-module GHC.ExecutionStack.Internal where
- -- Safety: None
- type Location :: *
- data Location = Location {objectName :: GHC.Internal.Base.String, functionName :: GHC.Internal.Base.String, srcLoc :: GHC.Internal.Maybe.Maybe SrcLoc}
- type SrcLoc :: *
- data SrcLoc = SrcLoc {sourceFile :: GHC.Internal.Base.String, sourceLine :: GHC.Internal.Types.Int, sourceColumn :: GHC.Internal.Types.Int}
- type StackTrace :: *
- newtype StackTrace = ...
- collectStackTrace :: GHC.Internal.Types.IO (GHC.Internal.Maybe.Maybe StackTrace)
- invalidateDebugCache :: GHC.Internal.Types.IO ()
- showStackFrames :: [Location] -> GHC.Internal.Show.ShowS
- stackDepth :: StackTrace -> GHC.Internal.Types.Int
- stackFrames :: StackTrace -> GHC.Internal.Maybe.Maybe [Location]
-
module GHC.Exts where
-- Safety: None
(*#) :: Int# -> Int# -> Int#
@@ -9672,15 +9658,6 @@ module GHC.TypeLits where
withSomeSNat :: forall (rep :: GHC.Internal.Types.RuntimeRep) (r :: TYPE rep). GHC.Internal.Bignum.Integer.Integer -> (forall (n :: Nat). GHC.Internal.Maybe.Maybe (SNat n) -> r) -> r
withSomeSSymbol :: forall (rep :: GHC.Internal.Types.RuntimeRep) (r :: TYPE rep). GHC.Internal.Base.String -> (forall (s :: Symbol). SSymbol s -> r) -> r
-module GHC.TypeLits.Internal where
- -- Safety: Safe
- type CmpChar :: GHC.Internal.Types.Char -> GHC.Internal.Types.Char -> GHC.Internal.Types.Ordering
- type family CmpChar a b
- type CmpSymbol :: Symbol -> Symbol -> GHC.Internal.Types.Ordering
- type family CmpSymbol a b
- type Symbol :: *
- data Symbol
-
module GHC.TypeNats where
-- Safety: Safe
type (*) :: Natural -> Natural -> Natural
@@ -9727,13 +9704,6 @@ module GHC.TypeNats where
withKnownNat :: forall (n :: Nat) (rep :: GHC.Internal.Types.RuntimeRep) (r :: TYPE rep). SNat n -> (KnownNat n => r) -> r
withSomeSNat :: forall (rep :: GHC.Internal.Types.RuntimeRep) (r :: TYPE rep). Natural -> (forall (n :: Nat). SNat n -> r) -> r
-module GHC.TypeNats.Internal where
- -- Safety: Safe
- type CmpNat :: Natural -> Natural -> GHC.Internal.Types.Ordering
- type family CmpNat a b
- type Natural :: *
- data Natural = ...
-
module GHC.Unicode where
-- Safety: Safe
type GeneralCategory :: *
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/395e0ad17c0d309637f079a05dbdc23…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/395e0ad17c0d309637f079a05dbdc23…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/splice-imports-2025] 4 commits: base: remove .Internal modules (e.g. GHC.TypeLits)
by Matthew Pickering (@mpickering) 16 Apr '25
by Matthew Pickering (@mpickering) 16 Apr '25
16 Apr '25
Matthew Pickering pushed to branch wip/splice-imports-2025 at Glasgow Haskell Compiler / GHC
Commits:
395e0ad1 by sheaf at 2025-04-16T12:33:26-04:00
base: remove .Internal modules (e.g. GHC.TypeLits)
This commit removes the following internal modules from base,
as per CLC proposal 217:
- GHC.TypeNats.Internal
- GHC.TypeLits.Internal
- GHC.ExecutionStack.Internal
Fixes #25007
- - - - -
670a7274 by Matthew Pickering at 2025-04-16T17:34:09+01:00
Move -fno-code note into Downsweep module
This note was left behind when all the code which referred to it was
moved into the GHC.Driver.Downsweep module
- - - - -
03572517 by Matthew Pickering at 2025-04-16T17:34:10+01:00
Implement Explicit Level Imports for Template Haskell
This commit introduces the `ExplicitLevelImports` and
`ImplicitStagePersistence` language extensions as proposed in GHC
Proposal #682.
Key Features
------------
- `ExplicitLevelImports` adds two new import modifiers - `splice` and
`quote` - allowing precise control over the level at which imported
identifiers are available
- `ImplicitStagePersistence` (enabled by default) preserves existing
path-based cross-stage persistence behavior
- `NoImplicitStagePersistence` disables implicit cross-stage
persistence, requiring explicit level imports
Benefits
--------
- Improved compilation performance by reducing unnecessary code generation
- Enhanced IDE experience with faster feedback in `-fno-code` mode
- Better dependency tracking by distinguishing compile-time and runtime dependencies
- Foundation for future cross-compilation improvements
This implementation enables the separation of modules needed at
compile-time from those needed at runtime, allowing for more efficient
compilation pipelines and clearer code organization in projects using
Template Haskell.
Implementation Notes
--------------------
The level which a name is availble at is stored in the 'GRE', in the normal
GlobalRdrEnv. The function `greLevels` returns the levels which a specific GRE
is imported at. The level information for a 'Name' is computed by `getStageAndBindLevel`.
The level validity is checked by `checkCrossStageLifting`.
Instances are checked by `checkWellStagedDFun`, which computes the level an
instance by calling `checkWellStagedInstanceWhat`, which sees what is
available at by looking at the module graph.
Modifications to downsweep
--------------------------
Code generation is now only enabled for modules which are needed at
compile time.
See the Note [-fno-code mode] for more information.
Uniform error messages for level errors
---------------------------------------
All error messages to do with levels are now reported uniformly using
the `TcRnBadlyStaged` constructor.
Lift derivation changed
-----------------------
Derived lift instances will now not generate code with expression
quotations.
Before:
```
data A = A Int deriving Lift
=>
lift (A x) = [| A $(lift x) |]
```
After:
```
lift (A x) = conE 'A `appE` (lift x)
```
This is because if you attempt to derive `Lift` in a module where
`NoImplicitStagePersistence` is enabled, you would get an infinite loop
where a constructor was attempted to be persisted using the instance you
are currently defining.
GHC API Changes
---------------
The ModuleGraph now contains additional information about the type of
the edges (normal, quote or splice) between modules. This is abstracted
using the `ModuleGraphEdge` data type.
Fixes #25828
- - - - -
7bc1c1de by Matthew Pickering at 2025-04-16T17:34:10+01:00
Start on docs
- - - - -
218 changed files:
- compiler/GHC.hs
- compiler/GHC/Data/Graph/Directed/Reachability.hs
- compiler/GHC/Driver/Backpack.hs
- compiler/GHC/Driver/Downsweep.hs
- compiler/GHC/Driver/DynFlags.hs
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/Make.hs
- compiler/GHC/Driver/MakeFile.hs
- compiler/GHC/Driver/Pipeline.hs
- compiler/GHC/Driver/Pipeline/Execute.hs
- compiler/GHC/Hs/ImpExp.hs
- compiler/GHC/Iface/Recomp.hs
- compiler/GHC/Iface/Tidy.hs
- compiler/GHC/Parser.y
- compiler/GHC/Parser/Header.hs
- compiler/GHC/Parser/Lexer.x
- compiler/GHC/Rename/Env.hs
- compiler/GHC/Rename/Expr.hs
- compiler/GHC/Rename/Names.hs
- compiler/GHC/Rename/Splice.hs
- compiler/GHC/Runtime/Loader.hs
- compiler/GHC/Tc/Deriv/Generate.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Errors/Types.hs
- compiler/GHC/Tc/Gen/Head.hs
- compiler/GHC/Tc/Plugin.hs
- compiler/GHC/Tc/Solver/Monad.hs
- compiler/GHC/Tc/Types.hs
- compiler/GHC/Tc/Types/LclEnv.hs
- compiler/GHC/Tc/Utils/Backpack.hs
- compiler/GHC/Tc/Utils/Env.hs
- compiler/GHC/Tc/Utils/Monad.hs
- compiler/GHC/Types/Name/Reader.hs
- compiler/GHC/Unit/Home/PackageTable.hs
- compiler/GHC/Unit/Module/Deps.hs
- compiler/GHC/Unit/Module/Graph.hs
- compiler/GHC/Unit/Module/Imported.hs
- compiler/GHC/Unit/Module/ModSummary.hs
- + compiler/GHC/Unit/Module/Stage.hs
- compiler/GHC/Unit/Types.hs
- compiler/GHC/Utils/Binary.hs
- compiler/GHC/Utils/Outputable.hs
- compiler/Language/Haskell/Syntax/ImpExp.hs
- compiler/ghc.cabal.in
- docs/users_guide/exts/control.rst
- docs/users_guide/exts/template_haskell.rst
- libraries/base/base.cabal.in
- libraries/base/changelog.md
- − libraries/base/src/GHC/ExecutionStack/Internal.hs
- − libraries/base/src/GHC/TypeLits/Internal.hs
- − libraries/base/src/GHC/TypeNats/Internal.hs
- libraries/base/tests/IO/Makefile
- libraries/ghc-internal/src/GHC/Internal/LanguageExtensions.hs
- testsuite/tests/ado/ado004.stderr
- testsuite/tests/annotations/should_fail/annfail03.stderr
- testsuite/tests/annotations/should_fail/annfail04.stderr
- testsuite/tests/annotations/should_fail/annfail06.stderr
- testsuite/tests/annotations/should_fail/annfail09.stderr
- testsuite/tests/count-deps/CountDepsAst.stdout
- testsuite/tests/count-deps/CountDepsParser.stdout
- testsuite/tests/dependent/should_compile/T14729.stderr
- testsuite/tests/dependent/should_compile/T15743.stderr
- testsuite/tests/dependent/should_compile/T15743e.stderr
- testsuite/tests/deriving/should_compile/T14682.stderr
- testsuite/tests/determinism/determ021/determ021.stdout
- + testsuite/tests/driver/T4437.stdout
- testsuite/tests/driver/json2.stderr
- testsuite/tests/gadt/T19847a.stderr
- testsuite/tests/ghc-api/fixed-nodes/FixedNodes.hs
- testsuite/tests/ghc-api/fixed-nodes/ModuleGraphInvariants.hs
- testsuite/tests/indexed-types/should_compile/T15711.stderr
- testsuite/tests/indexed-types/should_compile/T15852.stderr
- testsuite/tests/indexed-types/should_compile/T3017.stderr
- testsuite/tests/interface-stability/base-exports.stdout
- testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
- testsuite/tests/interface-stability/base-exports.stdout-mingw32
- testsuite/tests/interface-stability/base-exports.stdout-ws-32
- testsuite/tests/interface-stability/template-haskell-exports.stdout
- testsuite/tests/module/mod185.stderr
- testsuite/tests/parser/should_compile/DumpParsedAst.stderr
- testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
- testsuite/tests/parser/should_compile/DumpSemis.stderr
- testsuite/tests/parser/should_compile/KindSigs.stderr
- testsuite/tests/parser/should_compile/T14189.stderr
- testsuite/tests/partial-sigs/should_compile/ADT.stderr
- testsuite/tests/partial-sigs/should_compile/AddAndOr1.stderr
- testsuite/tests/partial-sigs/should_compile/AddAndOr2.stderr
- testsuite/tests/partial-sigs/should_compile/AddAndOr3.stderr
- testsuite/tests/partial-sigs/should_compile/AddAndOr4.stderr
- testsuite/tests/partial-sigs/should_compile/AddAndOr5.stderr
- testsuite/tests/partial-sigs/should_compile/AddAndOr6.stderr
- testsuite/tests/partial-sigs/should_compile/BoolToBool.stderr
- testsuite/tests/partial-sigs/should_compile/DataFamilyInstanceLHS.stderr
- testsuite/tests/partial-sigs/should_compile/Defaulting1MROn.stderr
- testsuite/tests/partial-sigs/should_compile/Defaulting2MROff.stderr
- testsuite/tests/partial-sigs/should_compile/Defaulting2MROn.stderr
- testsuite/tests/partial-sigs/should_compile/Either.stderr
- testsuite/tests/partial-sigs/should_compile/EqualityConstraint.stderr
- testsuite/tests/partial-sigs/should_compile/Every.stderr
- testsuite/tests/partial-sigs/should_compile/EveryNamed.stderr
- testsuite/tests/partial-sigs/should_compile/ExpressionSig.stderr
- testsuite/tests/partial-sigs/should_compile/ExpressionSigNamed.stderr
- testsuite/tests/partial-sigs/should_compile/ExtraConstraints1.stderr
- testsuite/tests/partial-sigs/should_compile/ExtraConstraints2.stderr
- testsuite/tests/partial-sigs/should_compile/ExtraConstraints3.stderr
- testsuite/tests/partial-sigs/should_compile/ExtraNumAMROff.stderr
- testsuite/tests/partial-sigs/should_compile/ExtraNumAMROn.stderr
- testsuite/tests/partial-sigs/should_compile/Forall1.stderr
- testsuite/tests/partial-sigs/should_compile/GenNamed.stderr
- testsuite/tests/partial-sigs/should_compile/HigherRank1.stderr
- testsuite/tests/partial-sigs/should_compile/HigherRank2.stderr
- testsuite/tests/partial-sigs/should_compile/LocalDefinitionBug.stderr
- testsuite/tests/partial-sigs/should_compile/Meltdown.stderr
- testsuite/tests/partial-sigs/should_compile/MonoLocalBinds.stderr
- testsuite/tests/partial-sigs/should_compile/NamedTyVar.stderr
- testsuite/tests/partial-sigs/should_compile/NamedWildcardInDataFamilyInstanceLHS.stderr
- testsuite/tests/partial-sigs/should_compile/NamedWildcardInTypeFamilyInstanceLHS.stderr
- testsuite/tests/partial-sigs/should_compile/ParensAroundContext.stderr
- testsuite/tests/partial-sigs/should_compile/PatBind.stderr
- testsuite/tests/partial-sigs/should_compile/PatBind2.stderr
- testsuite/tests/partial-sigs/should_compile/PatternSig.stderr
- testsuite/tests/partial-sigs/should_compile/Recursive.stderr
- testsuite/tests/partial-sigs/should_compile/ScopedNamedWildcards.stderr
- testsuite/tests/partial-sigs/should_compile/ScopedNamedWildcardsGood.stderr
- testsuite/tests/partial-sigs/should_compile/ShowNamed.stderr
- testsuite/tests/partial-sigs/should_compile/SimpleGen.stderr
- testsuite/tests/partial-sigs/should_compile/SkipMany.stderr
- testsuite/tests/partial-sigs/should_compile/SomethingShowable.stderr
- testsuite/tests/partial-sigs/should_compile/TypeFamilyInstanceLHS.stderr
- testsuite/tests/partial-sigs/should_compile/Uncurry.stderr
- testsuite/tests/partial-sigs/should_compile/UncurryNamed.stderr
- testsuite/tests/partial-sigs/should_compile/WarningWildcardInstantiations.stderr
- testsuite/tests/polykinds/T15592.stderr
- testsuite/tests/polykinds/T15592b.stderr
- testsuite/tests/printer/T18052a.stderr
- testsuite/tests/quasiquotation/qq001/qq001.stderr
- testsuite/tests/quasiquotation/qq002/qq002.stderr
- testsuite/tests/quasiquotation/qq003/qq003.stderr
- testsuite/tests/quasiquotation/qq004/qq004.stderr
- + testsuite/tests/quotes/T5721.stderr
- testsuite/tests/roles/should_compile/Roles1.stderr
- testsuite/tests/roles/should_compile/Roles14.stderr
- testsuite/tests/roles/should_compile/Roles2.stderr
- testsuite/tests/roles/should_compile/Roles3.stderr
- testsuite/tests/roles/should_compile/Roles4.stderr
- testsuite/tests/roles/should_compile/T8958.stderr
- testsuite/tests/showIface/DocsInHiFile1.stdout
- testsuite/tests/showIface/DocsInHiFileTH.stdout
- testsuite/tests/showIface/HaddockIssue849.stdout
- testsuite/tests/showIface/HaddockOpts.stdout
- testsuite/tests/showIface/HaddockSpanIssueT24378.stdout
- testsuite/tests/showIface/LanguageExts.stdout
- testsuite/tests/showIface/MagicHashInHaddocks.stdout
- testsuite/tests/showIface/NoExportList.stdout
- testsuite/tests/showIface/PragmaDocs.stdout
- testsuite/tests/showIface/ReExports.stdout
- + testsuite/tests/splice-imports/ClassA.hs
- + testsuite/tests/splice-imports/InstanceA.hs
- + testsuite/tests/splice-imports/Makefile
- + testsuite/tests/splice-imports/SI01.hs
- + testsuite/tests/splice-imports/SI01A.hs
- + testsuite/tests/splice-imports/SI02.hs
- + testsuite/tests/splice-imports/SI03.hs
- + testsuite/tests/splice-imports/SI03.stderr
- + testsuite/tests/splice-imports/SI04.hs
- + testsuite/tests/splice-imports/SI05.hs
- + testsuite/tests/splice-imports/SI05.stderr
- + testsuite/tests/splice-imports/SI05A.hs
- + testsuite/tests/splice-imports/SI06.hs
- + testsuite/tests/splice-imports/SI07.hs
- + testsuite/tests/splice-imports/SI07.stderr
- + testsuite/tests/splice-imports/SI07A.hs
- + testsuite/tests/splice-imports/SI08.hs
- + testsuite/tests/splice-imports/SI08.stderr
- + testsuite/tests/splice-imports/SI08_oneshot.stderr
- + testsuite/tests/splice-imports/SI09.hs
- + testsuite/tests/splice-imports/SI10.hs
- + testsuite/tests/splice-imports/SI13.hs
- + testsuite/tests/splice-imports/SI14.hs
- + testsuite/tests/splice-imports/SI14.stderr
- + testsuite/tests/splice-imports/SI15.hs
- + testsuite/tests/splice-imports/SI15.stderr
- + testsuite/tests/splice-imports/SI16.hs
- + testsuite/tests/splice-imports/SI16.stderr
- + testsuite/tests/splice-imports/SI17.hs
- + testsuite/tests/splice-imports/SI18.hs
- + testsuite/tests/splice-imports/SI18.stderr
- + testsuite/tests/splice-imports/SI19.hs
- + testsuite/tests/splice-imports/SI19A.hs
- + testsuite/tests/splice-imports/SI20.hs
- + testsuite/tests/splice-imports/SI20.stderr
- + testsuite/tests/splice-imports/SI21.hs
- + testsuite/tests/splice-imports/SI21.stderr
- + testsuite/tests/splice-imports/SI22.hs
- + testsuite/tests/splice-imports/SI22.stderr
- + testsuite/tests/splice-imports/SI23.hs
- + testsuite/tests/splice-imports/SI23A.hs
- + testsuite/tests/splice-imports/SI24.hs
- + testsuite/tests/splice-imports/all.T
- testsuite/tests/th/T16976z.stderr
- testsuite/tests/th/T17820a.stderr
- testsuite/tests/th/T17820b.stderr
- testsuite/tests/th/T17820c.stderr
- testsuite/tests/th/T17820d.stderr
- testsuite/tests/th/T17820e.stderr
- testsuite/tests/th/T21547.stderr
- testsuite/tests/th/T23829_hasty.stderr
- testsuite/tests/th/T23829_hasty_b.stderr
- testsuite/tests/th/T23829_tardy.ghc.stderr
- testsuite/tests/th/T5795.stderr
- testsuite/tests/th/TH_Roles2.stderr
- testsuite/tests/typecheck/should_compile/T12763.stderr
- testsuite/tests/typecheck/should_compile/T18406b.stderr
- testsuite/tests/typecheck/should_compile/T18529.stderr
- testsuite/tests/typecheck/should_compile/T21023.stderr
- utils/check-exact/ExactPrint.hs
- utils/count-deps/Main.hs
- utils/haddock/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/75cb7d70b8fd85b221e07b996e93ec…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/75cb7d70b8fd85b221e07b996e93ec…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/splice-imports-2025] 3 commits: Move -fno-code note into Downsweep module
by Matthew Pickering (@mpickering) 16 Apr '25
by Matthew Pickering (@mpickering) 16 Apr '25
16 Apr '25
Matthew Pickering pushed to branch wip/splice-imports-2025 at Glasgow Haskell Compiler / GHC
Commits:
6e59256e by Matthew Pickering at 2025-04-16T16:26:54+01:00
Move -fno-code note into Downsweep module
This note was left behind when all the code which referred to it was
moved into the GHC.Driver.Downsweep module
- - - - -
c8365be9 by Matthew Pickering at 2025-04-16T16:30:03+01:00
Implement Explicit Level Imports for Template Haskell
This commit introduces the `ExplicitLevelImports` and
`ImplicitStagePersistence` language extensions as proposed in GHC
Proposal #682.
Key Features
------------
- `ExplicitLevelImports` adds two new import modifiers - `splice` and
`quote` - allowing precise control over the level at which imported
identifiers are available
- `ImplicitStagePersistence` (enabled by default) preserves existing
path-based cross-stage persistence behavior
- `NoImplicitStagePersistence` disables implicit cross-stage
persistence, requiring explicit level imports
Benefits
--------
- Improved compilation performance by reducing unnecessary code generation
- Enhanced IDE experience with faster feedback in `-fno-code` mode
- Better dependency tracking by distinguishing compile-time and runtime dependencies
- Foundation for future cross-compilation improvements
This implementation enables the separation of modules needed at
compile-time from those needed at runtime, allowing for more efficient
compilation pipelines and clearer code organization in projects using
Template Haskell.
Implementation Notes
--------------------
The level which a name is availble at is stored in the 'GRE', in the normal
GlobalRdrEnv. The function `greLevels` returns the levels which a specific GRE
is imported at. The level information for a 'Name' is computed by `getStageAndBindLevel`.
The level validity is checked by `checkCrossStageLifting`.
Instances are checked by `checkWellStagedDFun`, which computes the level an
instance by calling `checkWellStagedInstanceWhat`, which sees what is
available at by looking at the module graph.
Modifications to downsweep
--------------------------
Code generation is now only enabled for modules which are needed at
compile time.
See the Note [-fno-code mode] for more information.
Uniform error messages for level errors
---------------------------------------
All error messages to do with levels are now reported uniformly using
the `TcRnBadlyStaged` constructor.
Lift derivation changed
-----------------------
Derived lift instances will now not generate code with expression
quotations.
Before:
```
data A = A Int deriving Lift
=>
lift (A x) = [| A $(lift x) |]
```
After:
```
lift (A x) = conE 'A `appE` (lift x)
```
This is because if you attempt to derive `Lift` in a module where
`NoImplicitStagePersistence` is enabled, you would get an infinite loop
where a constructor was attempted to be persisted using the instance you
are currently defining.
GHC API Changes
---------------
The ModuleGraph now contains additional information about the type of
the edges (normal, quote or splice) between modules. This is abstracted
using the `ModuleGraphEdge` data type.
Fixes #25828
- - - - -
75cb7d70 by Matthew Pickering at 2025-04-16T17:33:46+01:00
Start on docs
- - - - -
209 changed files:
- compiler/GHC.hs
- compiler/GHC/Data/Graph/Directed/Reachability.hs
- compiler/GHC/Driver/Backpack.hs
- compiler/GHC/Driver/Downsweep.hs
- compiler/GHC/Driver/DynFlags.hs
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/Make.hs
- compiler/GHC/Driver/MakeFile.hs
- compiler/GHC/Driver/Pipeline.hs
- compiler/GHC/Driver/Pipeline/Execute.hs
- compiler/GHC/Hs/ImpExp.hs
- compiler/GHC/Iface/Recomp.hs
- compiler/GHC/Iface/Tidy.hs
- compiler/GHC/Parser.y
- compiler/GHC/Parser/Header.hs
- compiler/GHC/Parser/Lexer.x
- compiler/GHC/Rename/Env.hs
- compiler/GHC/Rename/Expr.hs
- compiler/GHC/Rename/Names.hs
- compiler/GHC/Rename/Splice.hs
- compiler/GHC/Runtime/Loader.hs
- compiler/GHC/Tc/Deriv/Generate.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Errors/Types.hs
- compiler/GHC/Tc/Gen/Head.hs
- compiler/GHC/Tc/Plugin.hs
- compiler/GHC/Tc/Solver/Monad.hs
- compiler/GHC/Tc/Types.hs
- compiler/GHC/Tc/Types/LclEnv.hs
- compiler/GHC/Tc/Utils/Backpack.hs
- compiler/GHC/Tc/Utils/Env.hs
- compiler/GHC/Tc/Utils/Monad.hs
- compiler/GHC/Types/Name/Reader.hs
- compiler/GHC/Unit/Home/PackageTable.hs
- compiler/GHC/Unit/Module/Deps.hs
- compiler/GHC/Unit/Module/Graph.hs
- compiler/GHC/Unit/Module/Imported.hs
- compiler/GHC/Unit/Module/ModSummary.hs
- + compiler/GHC/Unit/Module/Stage.hs
- compiler/GHC/Unit/Types.hs
- compiler/GHC/Utils/Binary.hs
- compiler/GHC/Utils/Outputable.hs
- compiler/Language/Haskell/Syntax/ImpExp.hs
- compiler/ghc.cabal.in
- docs/users_guide/exts/control.rst
- docs/users_guide/exts/template_haskell.rst
- libraries/base/tests/IO/Makefile
- libraries/ghc-internal/src/GHC/Internal/LanguageExtensions.hs
- testsuite/tests/ado/ado004.stderr
- testsuite/tests/annotations/should_fail/annfail03.stderr
- testsuite/tests/annotations/should_fail/annfail04.stderr
- testsuite/tests/annotations/should_fail/annfail06.stderr
- testsuite/tests/annotations/should_fail/annfail09.stderr
- testsuite/tests/count-deps/CountDepsAst.stdout
- testsuite/tests/count-deps/CountDepsParser.stdout
- testsuite/tests/dependent/should_compile/T14729.stderr
- testsuite/tests/dependent/should_compile/T15743.stderr
- testsuite/tests/dependent/should_compile/T15743e.stderr
- testsuite/tests/deriving/should_compile/T14682.stderr
- testsuite/tests/determinism/determ021/determ021.stdout
- + testsuite/tests/driver/T4437.stdout
- testsuite/tests/driver/json2.stderr
- testsuite/tests/gadt/T19847a.stderr
- testsuite/tests/ghc-api/fixed-nodes/FixedNodes.hs
- testsuite/tests/ghc-api/fixed-nodes/ModuleGraphInvariants.hs
- testsuite/tests/indexed-types/should_compile/T15711.stderr
- testsuite/tests/indexed-types/should_compile/T15852.stderr
- testsuite/tests/indexed-types/should_compile/T3017.stderr
- testsuite/tests/interface-stability/template-haskell-exports.stdout
- testsuite/tests/module/mod185.stderr
- testsuite/tests/parser/should_compile/DumpParsedAst.stderr
- testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
- testsuite/tests/parser/should_compile/DumpSemis.stderr
- testsuite/tests/parser/should_compile/KindSigs.stderr
- testsuite/tests/parser/should_compile/T14189.stderr
- testsuite/tests/partial-sigs/should_compile/ADT.stderr
- testsuite/tests/partial-sigs/should_compile/AddAndOr1.stderr
- testsuite/tests/partial-sigs/should_compile/AddAndOr2.stderr
- testsuite/tests/partial-sigs/should_compile/AddAndOr3.stderr
- testsuite/tests/partial-sigs/should_compile/AddAndOr4.stderr
- testsuite/tests/partial-sigs/should_compile/AddAndOr5.stderr
- testsuite/tests/partial-sigs/should_compile/AddAndOr6.stderr
- testsuite/tests/partial-sigs/should_compile/BoolToBool.stderr
- testsuite/tests/partial-sigs/should_compile/DataFamilyInstanceLHS.stderr
- testsuite/tests/partial-sigs/should_compile/Defaulting1MROn.stderr
- testsuite/tests/partial-sigs/should_compile/Defaulting2MROff.stderr
- testsuite/tests/partial-sigs/should_compile/Defaulting2MROn.stderr
- testsuite/tests/partial-sigs/should_compile/Either.stderr
- testsuite/tests/partial-sigs/should_compile/EqualityConstraint.stderr
- testsuite/tests/partial-sigs/should_compile/Every.stderr
- testsuite/tests/partial-sigs/should_compile/EveryNamed.stderr
- testsuite/tests/partial-sigs/should_compile/ExpressionSig.stderr
- testsuite/tests/partial-sigs/should_compile/ExpressionSigNamed.stderr
- testsuite/tests/partial-sigs/should_compile/ExtraConstraints1.stderr
- testsuite/tests/partial-sigs/should_compile/ExtraConstraints2.stderr
- testsuite/tests/partial-sigs/should_compile/ExtraConstraints3.stderr
- testsuite/tests/partial-sigs/should_compile/ExtraNumAMROff.stderr
- testsuite/tests/partial-sigs/should_compile/ExtraNumAMROn.stderr
- testsuite/tests/partial-sigs/should_compile/Forall1.stderr
- testsuite/tests/partial-sigs/should_compile/GenNamed.stderr
- testsuite/tests/partial-sigs/should_compile/HigherRank1.stderr
- testsuite/tests/partial-sigs/should_compile/HigherRank2.stderr
- testsuite/tests/partial-sigs/should_compile/LocalDefinitionBug.stderr
- testsuite/tests/partial-sigs/should_compile/Meltdown.stderr
- testsuite/tests/partial-sigs/should_compile/MonoLocalBinds.stderr
- testsuite/tests/partial-sigs/should_compile/NamedTyVar.stderr
- testsuite/tests/partial-sigs/should_compile/NamedWildcardInDataFamilyInstanceLHS.stderr
- testsuite/tests/partial-sigs/should_compile/NamedWildcardInTypeFamilyInstanceLHS.stderr
- testsuite/tests/partial-sigs/should_compile/ParensAroundContext.stderr
- testsuite/tests/partial-sigs/should_compile/PatBind.stderr
- testsuite/tests/partial-sigs/should_compile/PatBind2.stderr
- testsuite/tests/partial-sigs/should_compile/PatternSig.stderr
- testsuite/tests/partial-sigs/should_compile/Recursive.stderr
- testsuite/tests/partial-sigs/should_compile/ScopedNamedWildcards.stderr
- testsuite/tests/partial-sigs/should_compile/ScopedNamedWildcardsGood.stderr
- testsuite/tests/partial-sigs/should_compile/ShowNamed.stderr
- testsuite/tests/partial-sigs/should_compile/SimpleGen.stderr
- testsuite/tests/partial-sigs/should_compile/SkipMany.stderr
- testsuite/tests/partial-sigs/should_compile/SomethingShowable.stderr
- testsuite/tests/partial-sigs/should_compile/TypeFamilyInstanceLHS.stderr
- testsuite/tests/partial-sigs/should_compile/Uncurry.stderr
- testsuite/tests/partial-sigs/should_compile/UncurryNamed.stderr
- testsuite/tests/partial-sigs/should_compile/WarningWildcardInstantiations.stderr
- testsuite/tests/polykinds/T15592.stderr
- testsuite/tests/polykinds/T15592b.stderr
- testsuite/tests/printer/T18052a.stderr
- testsuite/tests/quasiquotation/qq001/qq001.stderr
- testsuite/tests/quasiquotation/qq002/qq002.stderr
- testsuite/tests/quasiquotation/qq003/qq003.stderr
- testsuite/tests/quasiquotation/qq004/qq004.stderr
- + testsuite/tests/quotes/T5721.stderr
- testsuite/tests/roles/should_compile/Roles1.stderr
- testsuite/tests/roles/should_compile/Roles14.stderr
- testsuite/tests/roles/should_compile/Roles2.stderr
- testsuite/tests/roles/should_compile/Roles3.stderr
- testsuite/tests/roles/should_compile/Roles4.stderr
- testsuite/tests/roles/should_compile/T8958.stderr
- testsuite/tests/showIface/DocsInHiFile1.stdout
- testsuite/tests/showIface/DocsInHiFileTH.stdout
- testsuite/tests/showIface/HaddockIssue849.stdout
- testsuite/tests/showIface/HaddockOpts.stdout
- testsuite/tests/showIface/HaddockSpanIssueT24378.stdout
- testsuite/tests/showIface/LanguageExts.stdout
- testsuite/tests/showIface/MagicHashInHaddocks.stdout
- testsuite/tests/showIface/NoExportList.stdout
- testsuite/tests/showIface/PragmaDocs.stdout
- testsuite/tests/showIface/ReExports.stdout
- + testsuite/tests/splice-imports/ClassA.hs
- + testsuite/tests/splice-imports/InstanceA.hs
- + testsuite/tests/splice-imports/Makefile
- + testsuite/tests/splice-imports/SI01.hs
- + testsuite/tests/splice-imports/SI01A.hs
- + testsuite/tests/splice-imports/SI02.hs
- + testsuite/tests/splice-imports/SI03.hs
- + testsuite/tests/splice-imports/SI03.stderr
- + testsuite/tests/splice-imports/SI04.hs
- + testsuite/tests/splice-imports/SI05.hs
- + testsuite/tests/splice-imports/SI05.stderr
- + testsuite/tests/splice-imports/SI05A.hs
- + testsuite/tests/splice-imports/SI06.hs
- + testsuite/tests/splice-imports/SI07.hs
- + testsuite/tests/splice-imports/SI07.stderr
- + testsuite/tests/splice-imports/SI07A.hs
- + testsuite/tests/splice-imports/SI08.hs
- + testsuite/tests/splice-imports/SI08.stderr
- + testsuite/tests/splice-imports/SI08_oneshot.stderr
- + testsuite/tests/splice-imports/SI09.hs
- + testsuite/tests/splice-imports/SI10.hs
- + testsuite/tests/splice-imports/SI13.hs
- + testsuite/tests/splice-imports/SI14.hs
- + testsuite/tests/splice-imports/SI14.stderr
- + testsuite/tests/splice-imports/SI15.hs
- + testsuite/tests/splice-imports/SI15.stderr
- + testsuite/tests/splice-imports/SI16.hs
- + testsuite/tests/splice-imports/SI16.stderr
- + testsuite/tests/splice-imports/SI17.hs
- + testsuite/tests/splice-imports/SI18.hs
- + testsuite/tests/splice-imports/SI18.stderr
- + testsuite/tests/splice-imports/SI19.hs
- + testsuite/tests/splice-imports/SI19A.hs
- + testsuite/tests/splice-imports/SI20.hs
- + testsuite/tests/splice-imports/SI20.stderr
- + testsuite/tests/splice-imports/SI21.hs
- + testsuite/tests/splice-imports/SI21.stderr
- + testsuite/tests/splice-imports/SI22.hs
- + testsuite/tests/splice-imports/SI22.stderr
- + testsuite/tests/splice-imports/SI23.hs
- + testsuite/tests/splice-imports/SI23A.hs
- + testsuite/tests/splice-imports/SI24.hs
- + testsuite/tests/splice-imports/all.T
- testsuite/tests/th/T16976z.stderr
- testsuite/tests/th/T17820a.stderr
- testsuite/tests/th/T17820b.stderr
- testsuite/tests/th/T17820c.stderr
- testsuite/tests/th/T17820d.stderr
- testsuite/tests/th/T17820e.stderr
- testsuite/tests/th/T21547.stderr
- testsuite/tests/th/T23829_hasty.stderr
- testsuite/tests/th/T23829_hasty_b.stderr
- testsuite/tests/th/T23829_tardy.ghc.stderr
- testsuite/tests/th/T5795.stderr
- testsuite/tests/th/TH_Roles2.stderr
- testsuite/tests/typecheck/should_compile/T12763.stderr
- testsuite/tests/typecheck/should_compile/T18406b.stderr
- testsuite/tests/typecheck/should_compile/T18529.stderr
- testsuite/tests/typecheck/should_compile/T21023.stderr
- utils/check-exact/ExactPrint.hs
- utils/count-deps/Main.hs
- utils/haddock/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5dd13cba474d8c4a089d5706b827f2…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5dd13cba474d8c4a089d5706b827f2…
You're receiving this email because of your account on gitlab.haskell.org.
1
0