[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 2 commits: Update "GHC differences to the FFI Chapter" in user guide.
Marge Bot
gitlab at gitlab.haskell.org
Wed Mar 18 20:09:15 UTC 2020
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
d5c01480 by Andreas Klebinger at 2020-03-18T20:09:04Z
Update "GHC differences to the FFI Chapter" in user guide.
The old entry had a heavy focus on how things had been. Which is
not what I generally look for in a user guide.
I also added a small section on behaviour of nested safe ffi calls.
[skip-ci]
- - - - -
336767f9 by Sebastian Graf at 2020-03-18T20:09:10Z
PmCheck: Use ConLikeSet to model negative info
In #17911, Simon recognised many warnings stemming from over-long list
unions while coverage checking Cabal's `LicenseId` module.
This patch introduces a new `PmAltConSet` type which uses a `UniqDSet`
instead of an association list for `ConLike`s. For `PmLit`s, it will
still use an assocation list, though, because a similar map data
structure would entail a lot of busy work.
Fixes #17911.
- - - - -
3 changed files:
- compiler/GHC/HsToCore/PmCheck/Oracle.hs
- compiler/GHC/HsToCore/PmCheck/Types.hs
- docs/users_guide/exts/ffi.rst
Changes:
=====================================
compiler/GHC/HsToCore/PmCheck/Oracle.hs
=====================================
@@ -51,7 +51,6 @@ import GHC.Core.Make (mkListExpr, mkCharExpr)
import UniqSupply
import FastString
import SrcLoc
-import ListSetOps (unionLists)
import Maybes
import GHC.Core.ConLike
import GHC.Core.DataCon
@@ -613,9 +612,6 @@ Maintaining these invariants in 'addVarCt' (the core of the term oracle) and
- (Refine) If we had @x /~ K zs@, unify each y with each z in turn.
* Adding negative information. Example: Add the fact @x /~ Nothing@ (see 'addNotConCt')
- (Refut) If we have @x ~ K ys@, refute.
- - (Redundant) If we have @x ~ K2@ and @eqPmAltCon K K2 == Disjoint@
- (ex. Just and Nothing), the info is redundant and can be
- discarded.
- (COMPLETE) If K=Nothing and we had @x /~ Just@, then we get
@x /~ [Just,Nothing]@. This is vacuous by matter of comparing to the built-in
COMPLETE set, so should refute.
@@ -655,7 +651,7 @@ tmIsSatisfiable new_tm_cs = SC $ \delta -> runMaybeT $ foldlM addTmCt delta new_
-- * Looking up VarInfo
emptyVarInfo :: Id -> VarInfo
-emptyVarInfo x = VI (idType x) [] [] NoPM
+emptyVarInfo x = VI (idType x) [] emptyPmAltConSet NoPM
lookupVarInfo :: TmState -> Id -> VarInfo
-- (lookupVarInfo tms x) tells what we know about 'x'
@@ -754,7 +750,7 @@ TyCon, so tc_rep = tc_fam afterwards.
canDiverge :: Delta -> Id -> Bool
canDiverge delta at MkDelta{ delta_tm_st = ts } x
| VI _ pos neg _ <- lookupVarInfo ts x
- = null neg && all pos_can_diverge pos
+ = isEmptyPmAltConSet neg && all pos_can_diverge pos
where
pos_can_diverge (PmAltConLike (RealDataCon dc), _, [y])
-- See Note [Divergence of Newtype matches]
@@ -793,8 +789,8 @@ lookupRefuts :: Uniquable k => Delta -> k -> [PmAltCon]
lookupRefuts MkDelta{ delta_tm_st = ts@(TmSt (SDIE env) _) } k =
case lookupUDFM env k of
Nothing -> []
- Just (Indirect y) -> vi_neg (lookupVarInfo ts y)
- Just (Entry vi) -> vi_neg vi
+ Just (Indirect y) -> pmAltConSetElems (vi_neg (lookupVarInfo ts y))
+ Just (Entry vi) -> pmAltConSetElems (vi_neg vi)
isDataConSolution :: (PmAltCon, [TyVar], [Id]) -> Bool
isDataConSolution (PmAltConLike (RealDataCon _), _, _) = True
@@ -937,7 +933,7 @@ addNotConCt delta at MkDelta{ delta_tm_st = TmSt env reps } x nalt = do
| any (implies nalt) pos = neg
-- See Note [Completeness checking with required Thetas]
| hasRequiredTheta nalt = neg
- | otherwise = unionLists neg [nalt]
+ | otherwise = extendPmAltConSet neg nalt
let vi_ext = vi{ vi_neg = neg' }
-- 3. Make sure there's at least one other possible constructor
vi' <- case nalt of
@@ -1129,7 +1125,7 @@ equate delta at MkDelta{ delta_tm_st = TmSt env reps } x y
delta_pos <- foldlM add_fact delta_refs (vi_pos vi_x)
-- Do the same for negative info
let add_refut delta nalt = addNotConCt delta y nalt
- delta_neg <- foldlM add_refut delta_pos (vi_neg vi_x)
+ delta_neg <- foldlM add_refut delta_pos (pmAltConSetElems (vi_neg vi_x))
-- vi_cache will be updated in addNotConCt, so we are good to
-- go!
pure delta_neg
@@ -1144,7 +1140,7 @@ addConCt :: Delta -> Id -> PmAltCon -> [TyVar] -> [Id] -> MaybeT DsM Delta
addConCt delta at MkDelta{ delta_tm_st = TmSt env reps } x alt tvs args = do
VI ty pos neg cache <- lift (initLookupVarInfo delta x)
-- First try to refute with a negative fact
- guard (all ((/= Equal) . eqPmAltCon alt) neg)
+ guard (not (elemPmAltConSet alt neg))
-- Then see if any of the other solutions (remember: each of them is an
-- additional refinement of the possible values x could take) indicate a
-- contradiction
@@ -1160,11 +1156,8 @@ addConCt delta at MkDelta{ delta_tm_st = TmSt env reps } x alt tvs args = do
let tm_cts = zipWithEqual "addConCt" PmVarCt args other_args
MaybeT $ addPmCts delta (listToBag ty_cts `unionBags` listToBag tm_cts)
Nothing -> do
- -- Filter out redundant negative facts (those that compare Just False to
- -- the new solution)
- let neg' = filter ((== PossiblyOverlap) . eqPmAltCon alt) neg
let pos' = (alt, tvs, args):pos
- pure delta{ delta_tm_st = TmSt (setEntrySDIE env x (VI ty pos' neg' cache)) reps}
+ pure delta{ delta_tm_st = TmSt (setEntrySDIE env x (VI ty pos' neg cache)) reps}
equateTys :: [Type] -> [Type] -> [PmCt]
equateTys ts us =
@@ -1553,7 +1546,7 @@ provideEvidence = go
[]
-- When there are literals involved, just print negative info
-- instead of listing missed constructors
- | notNull [ l | PmAltLit l <- neg ]
+ | notNull [ l | PmAltLit l <- pmAltConSetElems neg ]
-> go xs n delta
[] -> try_instantiate x xs n delta
=====================================
compiler/GHC/HsToCore/PmCheck/Types.hs
=====================================
@@ -24,6 +24,10 @@ module GHC.HsToCore.PmCheck.Types (
-- * Caching partially matched COMPLETE sets
ConLikeSet, PossibleMatches(..),
+ -- * PmAltConSet
+ PmAltConSet, emptyPmAltConSet, isEmptyPmAltConSet, elemPmAltConSet,
+ extendPmAltConSet, pmAltConSetElems,
+
-- * A 'DIdEnv' where entries may be shared
Shared(..), SharedDIdEnv(..), emptySDIE, lookupSDIE, sameRepresentativeSDIE,
setIndirectSDIE, setEntrySDIE, traverseSDIE,
@@ -49,6 +53,7 @@ import Name
import GHC.Core.DataCon
import GHC.Core.ConLike
import Outputable
+import ListSetOps (unionLists)
import Maybes
import GHC.Core.Type
import GHC.Core.TyCon
@@ -152,6 +157,33 @@ eqConLike _ _ = PossiblyOverlap
data PmAltCon = PmAltConLike ConLike
| PmAltLit PmLit
+data PmAltConSet = PACS !ConLikeSet ![PmLit]
+
+emptyPmAltConSet :: PmAltConSet
+emptyPmAltConSet = PACS emptyUniqDSet []
+
+isEmptyPmAltConSet :: PmAltConSet -> Bool
+isEmptyPmAltConSet (PACS cls lits) = isEmptyUniqDSet cls && null lits
+
+-- | Whether there is a 'PmAltCon' in the 'PmAltConSet' that compares 'Equal' to
+-- the given 'PmAltCon' according to 'eqPmAltCon'.
+elemPmAltConSet :: PmAltCon -> PmAltConSet -> Bool
+elemPmAltConSet (PmAltConLike cl) (PACS cls _ ) = elementOfUniqDSet cl cls
+elemPmAltConSet (PmAltLit lit) (PACS _ lits) = elem lit lits
+
+extendPmAltConSet :: PmAltConSet -> PmAltCon -> PmAltConSet
+extendPmAltConSet (PACS cls lits) (PmAltConLike cl)
+ = PACS (addOneToUniqDSet cls cl) lits
+extendPmAltConSet (PACS cls lits) (PmAltLit lit)
+ = PACS cls (unionLists lits [lit])
+
+pmAltConSetElems :: PmAltConSet -> [PmAltCon]
+pmAltConSetElems (PACS cls lits)
+ = map PmAltConLike (uniqDSetToList cls) ++ map PmAltLit lits
+
+instance Outputable PmAltConSet where
+ ppr = ppr . pmAltConSetElems
+
-- | We can't in general decide whether two 'PmAltCon's match the same set of
-- values. In addition to the reasons in 'eqPmLit' and 'eqConLike', a
-- 'PmAltConLike' might or might not represent the same value as a 'PmAltLit'.
@@ -475,7 +507,7 @@ data VarInfo
-- However, no more than one RealDataCon in the list, otherwise contradiction
-- because of generativity.
- , vi_neg :: ![PmAltCon]
+ , vi_neg :: !PmAltConSet
-- ^ Negative info: A list of 'PmAltCon's that it cannot match.
-- Example, assuming
--
@@ -489,6 +521,9 @@ data VarInfo
-- between 'vi_pos' and 'vi_neg'.
-- See Note [Why record both positive and negative info?]
+ -- It's worth having an actual set rather than a simple association list,
+ -- because files like Cabal's `LicenseId` define relatively huge enums
+ -- that lead to quadratic or worse behavior.
, vi_cache :: !PossibleMatches
-- ^ A cache of the associated COMPLETE sets. At any time a superset of
=====================================
docs/users_guide/exts/ffi.rst
=====================================
@@ -37,31 +37,51 @@ Guaranteed call safety
~~~~~~~~~~~~~~~~~~~~~~
The Haskell 2010 Report specifies that ``safe`` FFI calls must allow foreign
-calls to safely call into Haskell code. In practice, this means that the
-garbage collector must be able to run while these calls are in progress,
-moving heap-allocated Haskell values around arbitrarily.
+calls to safely call into Haskell code. In practice, this means that called
+functions also have to assume heap-allocated Haskell values may move around
+arbitrarily in order to allow for GC.
This greatly constrains library authors since it implies that it is not safe to
pass any heap object reference to a ``safe`` foreign function call. For
-instance, it is often desirable to pass an :ref:`unpinned <pinned-byte-arrays>`
+instance, it is often desirable to pass :ref:`unpinned <pinned-byte-arrays>`
``ByteArray#``\s directly to native code to avoid making an otherwise-unnecessary
-copy. However, this can only be done safely if the array is guaranteed not to be
-moved by the garbage collector in the middle of the call.
+copy. However, this can not be done safely for ``safe`` calls since the array might
+be moved by the garbage collector in the middle of the call.
-The Chapter does *not* require implementations to refrain from doing the
-same for ``unsafe`` calls, so strictly Haskell 2010-conforming programs
+The Chapter *does* allow for implementations to move objects around during
+``unsafe`` calls as well. So strictly Haskell 2010-conforming programs
cannot pass heap-allocated references to ``unsafe`` FFI calls either.
+GHC, since version 8.4, **guarantees** that garbage collection will never occur
+during an ``unsafe`` call, even in the bytecode interpreter, and further guarantees
+that ``unsafe`` calls will be performed in the calling thread. Making it safe to
+pass heap-allocated objects to unsafe functions.
+
In previous releases, GHC would take advantage of the freedom afforded by the
Chapter by performing ``safe`` foreign calls in place of ``unsafe`` calls in
the bytecode interpreter. This meant that some packages which worked when
-compiled would fail under GHCi (e.g. :ghc-ticket:`13730`).
+compiled would fail under GHCi (e.g. :ghc-ticket:`13730`). But this is no
+longer the case in recent releases.
+
+Interactions between ``safe`` calls and bound threads
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+A ``safe`` call calling into haskell is run on a bound thread by
+the RTS. This means any nesting of ``safe`` calls will be executed on
+the same operating system thread. *Sequential* ``safe`` calls however
+do not enjoy this luxury and may be run on arbitrary OS threads.
-However, since version 8.4 this is no longer the case: GHC **guarantees** that
-garbage collection will never occur during an ``unsafe`` call, even in the
-bytecode interpreter, and further guarantees that ``unsafe`` calls will be
-performed in the calling thread.
+This behaviour is considered an implementation detail and code relying on
+thread local state should instead use one of the interfaces provided
+in :base-ref:`Control.Concurrent.` to make this explicit.
+For information on what bound threads are,
+see the documentation for the :base-ref:`Control.Concurrent.`.
+
+For more details on the implementation see the Paper:
+"Extending the Haskell Foreign Function Interface with Concurrency".
+Last known to be accessible `here
+<https://www.microsoft.com/en-us/research/wp-content/uploads/2004/09/conc-ffi.pdf>`_.
.. _ffi-ghcexts:
@@ -100,7 +120,7 @@ restrictions:
of heap objects record writes for the purpose of garbage collection.
An array of heap objects is passed to a foreign C function, the
runtime does not record any writes. Consequently, it is not safe to
- write to an array of heap objects in a foreign function.
+ write to an array of heap objects in a foreign function.
Since the runtime has no facilities for tracking mutation of a
``MutableByteArray#``, these can be safely mutated in any foreign
function.
@@ -169,7 +189,7 @@ In other situations, the C function may need knowledge of the RTS
closure types. The following example sums the first element of
each ``ByteArray#`` (interpreting the bytes as an array of ``CInt``)
element of an ``ArrayArray##`` [3]_::
-
+
// C source, must include the RTS to make the struct StgArrBytes
// available along with its fields: ptrs and payload.
#include "Rts.h"
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/677442333b9cce270a05f70e29dcd5df36f26d2b...336767f94b296377c59e73e8183e0d4934791485
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/677442333b9cce270a05f70e29dcd5df36f26d2b...336767f94b296377c59e73e8183e0d4934791485
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/20200318/69eafb61/attachment-0001.html>
More information about the ghc-commits
mailing list