[Git][ghc/ghc][wip/int-index/ppr-space-quote] 4 commits: Extend documentation for Data.IORef
Vladislav Zavialov (@int-index)
gitlab at gitlab.haskell.org
Mon Nov 21 05:05:20 UTC 2022
Vladislav Zavialov pushed to branch wip/int-index/ppr-space-quote at Glasgow Haskell Compiler / GHC
Commits:
f2f9ef07 by Bodigrim at 2022-11-20T18:39:30-05:00
Extend documentation for Data.IORef
- - - - -
ef511b23 by Simon Peyton Jones at 2022-11-20T18:40:05-05:00
Buglet in GHC.Tc.Module.checkBootTyCon
This lurking bug used the wrong function to compare two
types in GHC.Tc.Module.checkBootTyCon
It's hard to trigger the bug, which only came up during
!9343, so there's no regression test in this MR.
- - - - -
451aeac3 by Bodigrim at 2022-11-20T18:40:44-05:00
Add since pragmas for c_interruptible_open and hostIsThreaded
- - - - -
a5ac7e2d by Vladislav Zavialov at 2022-11-21T08:03:53+03:00
Check if the SDoc starts with a single quote (#22488)
This patch fixes pretty-printing of character literals
inside promoted lists and tuples.
When we pretty-print a promoted list or tuple whose first element
starts with a single quote, we want to add a space between the opening
bracket and the element:
'[True] -- ok
'[ 'True] -- ok
'['True] -- not ok
If we don't add the space, we accidentally produce a character
literal '['.
Before this patch, pprSpaceIfPromotedTyCon inspected the type as an AST
and tried to guess if it would be rendered with a single quote. However,
it missed the case when the inner type was itself a character literal:
'[ 'x'] -- ok
'['x'] -- not ok
Instead of adding this particular case, I opted for a more future-proof
solution: check the SDoc directly. This way we can detect if the single
quote is actually there instead of trying to predict it from the AST.
The new function is called spaceIfSingleQuote.
- - - - -
11 changed files:
- compiler/GHC/Data/FastString.hs
- compiler/GHC/Iface/Type.hs
- compiler/GHC/Tc/Module.hs
- compiler/GHC/Utils/Outputable.hs
- compiler/GHC/Utils/Ppr.hs
- libraries/base/Data/IORef.hs
- libraries/base/GHC/IORef.hs
- libraries/base/System/Posix/Internals.hs
- + testsuite/tests/printer/T22488.script
- + testsuite/tests/printer/T22488.stdout
- testsuite/tests/printer/all.T
Changes:
=====================================
compiler/GHC/Data/FastString.hs
=====================================
@@ -56,6 +56,7 @@ module GHC.Data.FastString
FastZString,
hPutFZS,
zString,
+ zStringTakeN,
lengthFZS,
-- * FastStrings
@@ -103,6 +104,7 @@ module GHC.Data.FastString
-- ** Deconstruction
unpackPtrString,
+ unpackPtrStringTakeN,
-- ** Operations
lengthPS
@@ -179,6 +181,14 @@ zString :: FastZString -> String
zString (FastZString bs) =
inlinePerformIO $ BS.unsafeUseAsCStringLen bs peekCAStringLen
+-- | @zStringTakeN n = 'take' n . 'zString'@
+-- but is performed in \(O(\min(n,l))\) rather than \(O(l)\),
+-- where \(l\) is the length of the 'FastZString'.
+zStringTakeN :: Int -> FastZString -> String
+zStringTakeN n (FastZString bs) =
+ inlinePerformIO $ BS.unsafeUseAsCStringLen bs $ \(cp, len) ->
+ peekCAStringLen (cp, min n len)
+
lengthFZS :: FastZString -> Int
lengthFZS (FastZString bs) = BS.length bs
@@ -586,7 +596,7 @@ lengthFS fs = n_chars fs
nullFS :: FastString -> Bool
nullFS fs = SBS.null $ fs_sbs fs
--- | Unpacks and decodes the FastString
+-- | Lazily unpacks and decodes the FastString
unpackFS :: FastString -> String
unpackFS fs = utf8DecodeShortByteString $ fs_sbs fs
@@ -666,6 +676,14 @@ mkPtrString# a# = PtrString (Ptr a#) (ptrStrLength (Ptr a#))
unpackPtrString :: PtrString -> String
unpackPtrString (PtrString (Ptr p#) (I# n#)) = unpackNBytes# p# n#
+-- | @unpackPtrStringTakeN n = 'take' n . 'unpackPtrString'@
+-- but is performed in \(O(\min(n,l))\) rather than \(O(l)\),
+-- where \(l\) is the length of the 'PtrString'.
+unpackPtrStringTakeN :: Int -> PtrString -> String
+unpackPtrStringTakeN n (PtrString (Ptr p#) len) =
+ case min n len of
+ I# n# -> unpackNBytes# p# n#
+
-- | Return the length of a 'PtrString'
lengthPS :: PtrString -> Int
lengthPS (PtrString _ n) = n
=====================================
compiler/GHC/Iface/Type.hs
=====================================
@@ -1450,23 +1450,20 @@ Consider this GHCi session (#14343)
Found hole: _ :: Proxy '['True]
This would be bad, because the '[' looks like a character literal.
+
+A similar issue arises if the element is a character literal (#22488)
+ ghci> type T = '[ 'x' ]
+ ghci> :kind! T
+ T :: [Char]
+ = '['x']
+
Solution: in type-level lists and tuples, add a leading space
-if the first type is itself promoted. See pprSpaceIfPromotedTyCon.
+if the first element is printed with a single quote.
-}
-------------------
--- | Prefix a space if the given 'IfaceType' is a promoted 'TyCon'.
--- See Note [Printing promoted type constructors]
-pprSpaceIfPromotedTyCon :: IfaceType -> SDoc -> SDoc
-pprSpaceIfPromotedTyCon (IfaceTyConApp tyCon _)
- = case ifaceTyConIsPromoted (ifaceTyConInfo tyCon) of
- IsPromoted -> (space <>)
- _ -> id
-pprSpaceIfPromotedTyCon _
- = id
-
-- See equivalent function in "GHC.Core.TyCo.Rep"
pprIfaceTyList :: PprPrec -> IfaceType -> IfaceType -> SDoc
-- Given a type-level list (t1 ': t2), see if we can print
@@ -1475,7 +1472,7 @@ pprIfaceTyList :: PprPrec -> IfaceType -> IfaceType -> SDoc
pprIfaceTyList ctxt_prec ty1 ty2
= case gather ty2 of
(arg_tys, Nothing)
- -> char '\'' <> brackets (pprSpaceIfPromotedTyCon ty1 (fsep
+ -> char '\'' <> brackets (spaceIfSingleQuote (fsep
(punctuate comma (map (ppr_ty topPrec) (ty1:arg_tys)))))
(arg_tys, Just tl)
-> maybeParen ctxt_prec funPrec $ hang (ppr_ty funPrec ty1)
@@ -1714,12 +1711,9 @@ pprTuple ctxt_prec sort promoted args =
IsPromoted
-> let tys = appArgsIfaceTypes args
args' = drop (length tys `div` 2) tys
- spaceIfPromoted = case args' of
- arg0:_ -> pprSpaceIfPromotedTyCon arg0
- _ -> id
in ppr_tuple_app args' $
pprPromotionQuoteI IsPromoted <>
- tupleParens sort (spaceIfPromoted (pprWithCommas pprIfaceType args'))
+ tupleParens sort (spaceIfSingleQuote (pprWithCommas pprIfaceType args'))
NotPromoted
| ConstraintTuple <- sort
=====================================
compiler/GHC/Tc/Module.hs
=====================================
@@ -1096,6 +1096,7 @@ checkBootTyCon is_boot tc1 tc2
-- Order of pattern matching matters.
subDM _ Nothing _ = True
subDM _ _ Nothing = False
+
-- If the hsig wrote:
--
-- f :: a -> a
@@ -1103,11 +1104,14 @@ checkBootTyCon is_boot tc1 tc2
--
-- this should be validly implementable using an old-fashioned
-- vanilla default method.
- subDM t1 (Just (_, GenericDM t2)) (Just (_, VanillaDM))
- = eqTypeX env t1 t2
+ subDM t1 (Just (_, GenericDM gdm_t1)) (Just (_, VanillaDM))
+ = eqType t1 gdm_t1 -- Take care (#22476). Both t1 and gdm_t1 come
+ -- from tc1, so use eqType, and /not/ eqTypeX
+
-- This case can occur when merging signatures
subDM t1 (Just (_, VanillaDM)) (Just (_, GenericDM t2))
= eqTypeX env t1 t2
+
subDM _ (Just (_, VanillaDM)) (Just (_, VanillaDM)) = True
subDM _ (Just (_, GenericDM t1)) (Just (_, GenericDM t2))
= eqTypeX env t1 t2
=====================================
compiler/GHC/Utils/Outputable.hs
=====================================
@@ -32,6 +32,7 @@ module GHC.Utils.Outputable (
interppSP, interpp'SP, interpp'SP',
pprQuotedList, pprWithCommas, quotedListWithOr, quotedListWithNor,
pprWithBars,
+ spaceIfSingleQuote,
isEmpty, nest,
ptext,
int, intWithCommas, integer, word, float, double, rational, doublePrec,
@@ -1287,6 +1288,16 @@ pprWithBars :: (a -> SDoc) -- ^ The pretty printing function to use
-- bar-separated and finally packed into a paragraph.
pprWithBars pp xs = fsep (intersperse vbar (map pp xs))
+-- Prefix the document with a space if it starts with a single quote.
+-- See Note [Printing promoted type constructors] in GHC.Iface.Type
+spaceIfSingleQuote :: SDoc -> SDoc
+spaceIfSingleQuote (SDoc m) =
+ SDoc $ \ctx ->
+ let d = m ctx
+ in if Pretty.docStartsWith '\'' d
+ then Pretty.space Pretty.<> d
+ else d
+
-- | Returns the separated concatenation of the pretty printed things.
interppSP :: Outputable a => [a] -> SDoc
interppSP xs = sep (map ppr xs)
=====================================
compiler/GHC/Utils/Ppr.hs
=====================================
@@ -93,6 +93,7 @@ module GHC.Utils.Ppr (
-- * Predicates on documents
isEmpty,
+ docStartsWith,
-- * Rendering documents
@@ -350,6 +351,38 @@ isEmpty :: Doc -> Bool
isEmpty Empty = True
isEmpty _ = False
+-- | Does the document start with the specified character?
+docStartsWith :: Char -> Doc -> Bool
+docStartsWith expected = go
+ where
+ go :: Doc -> Bool
+ go Empty = False
+ go NoDoc = False
+ go (NilAbove _) = False
+ go (Beside d1 _ _) = go d1
+ go (Above d1 _ _) = go d1
+ go (TextBeside td _ _) = go_td td
+ go (Nest _ d1) = go d1
+ go (Union d1 _d2) =
+ -- No need to check d2 because of the invariant that d1 and d2 flatten to
+ -- the same string.
+ go d1
+
+ go_td :: TextDetails -> Bool
+ go_td (Chr c) = go_chr c
+ go_td (Str s) = go_str s
+ go_td (PStr s) = go_str (unpackFS s) -- O(1) because unpackFS is lazy
+ go_td (ZStr s) = go_str (zStringTakeN 1 s)
+ go_td (LStr s) = go_str (unpackPtrStringTakeN 1 s)
+ go_td (RStr n c) = n > 0 && go_chr c
+
+ go_str :: String -> Bool
+ go_str [] = False
+ go_str (c:_) = go_chr c
+
+ go_chr :: Char -> Bool
+ go_chr c = c == expected
+
{-
Q: What is the reason for negative indentation (i.e. argument to indent
is < 0) ?
=====================================
libraries/base/Data/IORef.hs
=====================================
@@ -46,7 +46,9 @@ mkWeakIORef :: IORef a -> IO () -> IO (Weak (IORef a))
mkWeakIORef r@(IORef (STRef r#)) (IO finalizer) = IO $ \s ->
case mkWeak# r# r finalizer s of (# s1, w #) -> (# s1, Weak w #)
--- |Mutate the contents of an 'IORef'.
+-- |Mutate the contents of an 'IORef', combining 'readIORef' and 'writeIORef'.
+-- This is not an atomic update, consider using 'atomicModifyIORef' when
+-- operating in a multithreaded environment.
--
-- Be warned that 'modifyIORef' does not apply the function strictly. This
-- means if the program calls 'modifyIORef' many times, but seldom uses the
@@ -62,7 +64,9 @@ mkWeakIORef r@(IORef (STRef r#)) (IO finalizer) = IO $ \s ->
modifyIORef :: IORef a -> (a -> a) -> IO ()
modifyIORef ref f = readIORef ref >>= writeIORef ref . f
--- |Strict version of 'modifyIORef'
+-- |Strict version of 'modifyIORef'.
+-- This is not an atomic update, consider using 'atomicModifyIORef'' when
+-- operating in a multithreaded environment.
--
-- @since 4.6.0.0
modifyIORef' :: IORef a -> (a -> a) -> IO ()
@@ -90,13 +94,18 @@ modifyIORef' ref f = do
--
-- Use 'atomicModifyIORef'' or 'atomicWriteIORef' to avoid this problem.
--
+-- This function imposes a memory barrier, preventing reordering;
+-- see "Data.IORef#memmodel" for details.
+--
atomicModifyIORef :: IORef a -> (a -> (a,b)) -> IO b
atomicModifyIORef ref f = do
(_old, ~(_new, res)) <- atomicModifyIORef2 ref f
pure res
--- | Variant of 'writeIORef' with the \"barrier to reordering\" property that
--- 'atomicModifyIORef' has.
+-- | Variant of 'writeIORef'. The prefix "atomic" relates to a fact that
+-- it imposes a reordering barrier, similar to 'atomicModifyIORef'.
+-- Such a write will not be reordered with other reads
+-- or writes even on CPUs with weak memory model.
--
-- @since 4.6.0.0
atomicWriteIORef :: IORef a -> a -> IO ()
@@ -105,11 +114,15 @@ atomicWriteIORef ref a = do
pure ()
{- $memmodel
+ #memmodel#
+
+ Most modern CPU achitectures (e.g. x86/64, ARM) have a memory model which allows
+ threads to reorder reads with earlier writes to different locations,
+ e.g. see <https://www.intel.com/content/www/us/en/developer/articles/technical/intel-sdm.html the x86/64 architecture manual>,
+ 8.2.3.4 Loads May Be Reordered with Earlier Stores to Different Locations.
- In a concurrent program, 'IORef' operations may appear out-of-order
- to another thread, depending on the memory model of the underlying
- processor architecture. For example, on x86, loads can move ahead
- of stores, so in the following example:
+ Because of that, in a concurrent program, 'IORef' operations may appear out-of-order
+ to another thread. In the following example:
> import Data.IORef
> import Control.Monad (unless)
@@ -131,20 +144,23 @@ atomicWriteIORef ref a = do
it is possible that the string @"critical section"@ is printed
twice, even though there is no interleaving of the operations of the
- two threads that allows that outcome. The memory model of x86
+ two threads that allows that outcome. The memory model of x86/64
allows 'readIORef' to happen before the earlier 'writeIORef'.
+ The ARM memory order model is typically even weaker than x86/64, allowing
+ any reordering of reads and writes as long as they are independent
+ from the point of view of the current thread.
+
The implementation is required to ensure that reordering of memory
operations cannot cause type-correct code to go wrong. In
particular, when inspecting the value read from an 'IORef', the
memory writes that created that value must have occurred from the
point of view of the current thread.
- 'atomicModifyIORef' acts as a barrier to reordering. Multiple
- 'atomicModifyIORef' operations occur in strict program order. An
- 'atomicModifyIORef' is never observed to take place ahead of any
+ 'atomicWriteIORef', 'atomicModifyIORef' and 'atomicModifyIORef'' act
+ as a barrier to reordering. Multiple calls to these functions
+ occur in strict program order, never taking place ahead of any
earlier (in program order) 'IORef' operations, or after any later
'IORef' operations.
-}
-
=====================================
libraries/base/GHC/IORef.hs
=====================================
@@ -32,7 +32,27 @@ import GHC.IO
-- ---------------------------------------------------------------------------
-- IORefs
--- |A mutable variable in the 'IO' monad
+-- |A mutable variable in the 'IO' monad.
+--
+-- >>> import Data.IORef
+-- >>> r <- newIORef 0
+-- >>> readIORef r
+-- 0
+-- >>> writeIORef r 1
+-- >>> readIORef r
+-- 1
+-- >>> atomicWriteIORef r 2
+-- >>> readIORef r
+-- 2
+-- >>> modifyIORef' r (+ 1)
+-- >>> readIORef r
+-- 3
+-- >>> atomicModifyIORef' r (\a -> (a + 1, ()))
+-- >>> readIORef r
+-- 4
+--
+-- See also 'Data.STRef.STRef' and 'Control.Concurrent.MVar.MVar'.
+--
newtype IORef a = IORef (STRef RealWorld a)
deriving Eq
-- ^ Pointer equality.
@@ -43,11 +63,19 @@ newtype IORef a = IORef (STRef RealWorld a)
newIORef :: a -> IO (IORef a)
newIORef v = stToIO (newSTRef v) >>= \ var -> return (IORef var)
--- |Read the value of an 'IORef'
+-- |Read the value of an 'IORef'.
+--
+-- Beware that the CPU executing a thread can reorder reads or writes
+-- to independent locations. See "Data.IORef#memmodel" for more details.
readIORef :: IORef a -> IO a
readIORef (IORef var) = stToIO (readSTRef var)
--- |Write a new value into an 'IORef'
+-- |Write a new value into an 'IORef'.
+--
+-- This function does not create a memory barrier and can be reordered
+-- with other independent reads and writes within a thread, which may cause issues
+-- for multithreaded execution. In these cases, consider using 'Data.IORef.atomicWriteIORef'
+-- instead. See "Data.IORef#memmodel" for more details.
writeIORef :: IORef a -> a -> IO ()
writeIORef (IORef var) v = stToIO (writeSTRef var v)
@@ -116,6 +144,9 @@ data Box a = Box a
-- will increment the 'IORef' and then throw an exception in the calling
-- thread.
--
+-- This function imposes a memory barrier, preventing reordering;
+-- see "Data.IORef#memmodel" for details.
+--
-- @since 4.6.0.0
atomicModifyIORef' :: IORef a -> (a -> (a,b)) -> IO b
-- See Note [atomicModifyIORef' definition]
=====================================
libraries/base/System/Posix/Internals.hs
=====================================
@@ -379,6 +379,8 @@ foreign import ccall unsafe "HsBase.h __hscore_open"
-- it's expensive (NFS, FUSE, etc.), and we especially
-- need to be able to interrupt a blocking open call.
-- See #17912.
+--
+-- @since 4.16.0.0
c_interruptible_open :: CFilePath -> CInt -> CMode -> IO CInt
c_interruptible_open filepath oflags mode =
getMaskingState >>= \case
@@ -413,13 +415,21 @@ c_interruptible_open filepath oflags mode =
interruptible (IO $ \s -> (# yield# s, () #))
pure open_res
+-- |
+--
+-- @since 4.16.0.0
foreign import ccall interruptible "HsBase.h __hscore_open"
c_interruptible_open_ :: CFilePath -> CInt -> CMode -> IO CInt
-- | Consult the RTS to find whether it is threaded.
+--
+-- @since 4.16.0.0
hostIsThreaded :: Bool
hostIsThreaded = rtsIsThreaded_ /= 0
+-- |
+--
+-- @since 4.16.0.0
foreign import ccall unsafe "rts_isThreaded" rtsIsThreaded_ :: Int
c_safe_open :: CFilePath -> CInt -> CMode -> IO CInt
=====================================
testsuite/tests/printer/T22488.script
=====================================
@@ -0,0 +1,5 @@
+:set -XDataKinds
+type T = '[ 'x' ]
+:kind! T
+type T = '( 'x', 'y' )
+:kind! T
\ No newline at end of file
=====================================
testsuite/tests/printer/T22488.stdout
=====================================
@@ -0,0 +1,4 @@
+T :: [Char]
+= '[ 'x']
+T :: (Char, Char)
+= '( 'x', 'y')
=====================================
testsuite/tests/printer/all.T
=====================================
@@ -181,3 +181,5 @@ test('Test20315', normal, compile_fail, [''])
test('Test20846', [ignore_stderr, req_ppr_deps], makefile_test, ['Test20846'])
test('Test21355', [ignore_stderr, req_ppr_deps], makefile_test, ['Test21355'])
test('Test21805', [ignore_stderr, req_ppr_deps], makefile_test, ['Test21805'])
+
+test('T22488', normal, ghci_script, ['T22488.script'])
\ No newline at end of file
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7b758aff2973ebe939ba4b34a75f2b5a10a41234...a5ac7e2ddb01bab15746d2a7332e16842716ff48
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7b758aff2973ebe939ba4b34a75f2b5a10a41234...a5ac7e2ddb01bab15746d2a7332e16842716ff48
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20221121/99f773f8/attachment-0001.html>
More information about the ghc-commits
mailing list