Skip to content

GitLab

Commit 0f0c1b5b authored by Ian Lynagh's avatar Ian Lynagh
Browse files

Make an extension for interruptible FFI calls

parent aa390568
Hide whitespace changes
Inline Side-by-side
Showing with 40 additions and 27 deletions
compiler/main/DynFlags.hs
View file @ 0f0c1b5b
......@@ -357,6 +357,7 @@ data ExtensionFlag
| Opt_ExtendedDefaultRules -- Use GHC's extended rules for defaulting
| Opt_ForeignFunctionInterface
| Opt_UnliftedFFITypes
| Opt_InterruptibleFFI
| Opt_GHCForeignImportPrim
| Opt_ParallelArrays -- Syntactic support for parallel arrays
| Opt_Arrows -- Arrow-notation syntax
......@@ -1823,6 +1824,7 @@ xFlags = [
( "MonadComprehensions", AlwaysAllowed, Opt_MonadComprehensions, nop),
( "ForeignFunctionInterface", RestrictedFunction, Opt_ForeignFunctionInterface, nop ),
( "UnliftedFFITypes", AlwaysAllowed, Opt_UnliftedFFITypes, nop ),
( "InterruptibleFFI", AlwaysAllowed, Opt_InterruptibleFFI, nop ),
( "GHCForeignImportPrim", AlwaysAllowed, Opt_GHCForeignImportPrim, nop ),
( "LiberalTypeSynonyms", AlwaysAllowed, Opt_LiberalTypeSynonyms, nop ),
( "Rank2Types", AlwaysAllowed, Opt_Rank2Types, nop ),
......
compiler/parser/Lexer.x
View file @ 0f0c1b5b
......@@ -663,7 +663,7 @@ reservedWordsFM = listToUFM $
( "dynamic", ITdynamic, bit ffiBit),
( "safe", ITsafe, bit ffiBit .|. bit safeHaskellBit),
( "threadsafe", ITthreadsafe, bit ffiBit), -- ToDo: remove
( "interruptible", ITinterruptible, bit ffiBit),
( "interruptible", ITinterruptible, bit interruptibleFfiBit),
( "unsafe", ITunsafe, bit ffiBit),
( "stdcall", ITstdcallconv, bit ffiBit),
( "ccall", ITccallconv, bit ffiBit),
......@@ -1762,8 +1762,10 @@ setAlrExpectingOCurly b = P $ \s -> POk (s {alr_expecting_ocurly = b}) ()
ffiBit :: Int
ffiBit = 1
interruptibleFfiBit :: Int
interruptibleFfiBit = 2
parrBit :: Int
parrBit = 2
parrBit = 3
arrowsBit :: Int
arrowsBit = 4
thBit :: Int
......@@ -1880,31 +1882,32 @@ mkPState flags buf loc =
alr_justClosedExplicitLetBlock = False
}
where
bitmap = ffiBit `setBitIf` xopt Opt_ForeignFunctionInterface flags
.|. parrBit `setBitIf` xopt Opt_ParallelArrays flags
.|. arrowsBit `setBitIf` xopt Opt_Arrows flags
.|. thBit `setBitIf` xopt Opt_TemplateHaskell flags
.|. qqBit `setBitIf` xopt Opt_QuasiQuotes flags
.|. ipBit `setBitIf` xopt Opt_ImplicitParams flags
.|. explicitForallBit `setBitIf` xopt Opt_ExplicitForAll flags
.|. bangPatBit `setBitIf` xopt Opt_BangPatterns flags
.|. tyFamBit `setBitIf` xopt Opt_TypeFamilies flags
.|. haddockBit `setBitIf` dopt Opt_Haddock flags
.|. magicHashBit `setBitIf` xopt Opt_MagicHash flags
.|. kindSigsBit `setBitIf` xopt Opt_KindSignatures flags
.|. recursiveDoBit `setBitIf` xopt Opt_RecursiveDo flags
.|. recBit `setBitIf` xopt Opt_DoRec flags
.|. recBit `setBitIf` xopt Opt_Arrows flags
.|. unicodeSyntaxBit `setBitIf` xopt Opt_UnicodeSyntax flags
.|. unboxedTuplesBit `setBitIf` xopt Opt_UnboxedTuples flags
.|. datatypeContextsBit `setBitIf` xopt Opt_DatatypeContexts flags
.|. transformComprehensionsBit `setBitIf` xopt Opt_TransformListComp flags
.|. transformComprehensionsBit `setBitIf` xopt Opt_MonadComprehensions flags
.|. rawTokenStreamBit `setBitIf` dopt Opt_KeepRawTokenStream flags
.|. alternativeLayoutRuleBit `setBitIf` xopt Opt_AlternativeLayoutRule flags
.|. relaxedLayoutBit `setBitIf` xopt Opt_RelaxedLayout flags
bitmap = ffiBit `setBitIf` xopt Opt_ForeignFunctionInterface flags
.|. interruptibleFfiBit `setBitIf` xopt Opt_InterruptibleFFI flags
.|. parrBit `setBitIf` xopt Opt_ParallelArrays flags
.|. arrowsBit `setBitIf` xopt Opt_Arrows flags
.|. thBit `setBitIf` xopt Opt_TemplateHaskell flags
.|. qqBit `setBitIf` xopt Opt_QuasiQuotes flags
.|. ipBit `setBitIf` xopt Opt_ImplicitParams flags
.|. explicitForallBit `setBitIf` xopt Opt_ExplicitForAll flags
.|. bangPatBit `setBitIf` xopt Opt_BangPatterns flags
.|. tyFamBit `setBitIf` xopt Opt_TypeFamilies flags
.|. haddockBit `setBitIf` dopt Opt_Haddock flags
.|. magicHashBit `setBitIf` xopt Opt_MagicHash flags
.|. kindSigsBit `setBitIf` xopt Opt_KindSignatures flags
.|. recursiveDoBit `setBitIf` xopt Opt_RecursiveDo flags
.|. recBit `setBitIf` xopt Opt_DoRec flags
.|. recBit `setBitIf` xopt Opt_Arrows flags
.|. unicodeSyntaxBit `setBitIf` xopt Opt_UnicodeSyntax flags
.|. unboxedTuplesBit `setBitIf` xopt Opt_UnboxedTuples flags
.|. datatypeContextsBit `setBitIf` xopt Opt_DatatypeContexts flags
.|. transformComprehensionsBit `setBitIf` xopt Opt_TransformListComp flags
.|. transformComprehensionsBit `setBitIf` xopt Opt_MonadComprehensions flags
.|. rawTokenStreamBit `setBitIf` dopt Opt_KeepRawTokenStream flags
.|. alternativeLayoutRuleBit `setBitIf` xopt Opt_AlternativeLayoutRule flags
.|. relaxedLayoutBit `setBitIf` xopt Opt_RelaxedLayout flags
.|. nondecreasingIndentationBit `setBitIf` xopt Opt_NondecreasingIndentation flags
.|. safeHaskellBit `setBitIf` safeHaskellOn flags
.|. safeHaskellBit `setBitIf` safeHaskellOn flags
--
setBitIf :: Int -> Bool -> Int
b `setBitIf` cond | cond = bit b
......
docs/users_guide/ffi-chap.xml
View file @ 0f0c1b5b
......@@ -101,7 +101,9 @@ OK:
The problem is that it is not possible in general to
interrupt a foreign call safely. However, GHC does provide
a way to interrupt blocking system calls which works for
most system calls on both Unix and Windows. A foreign call
most system calls on both Unix and Windows. When the
<literal>InterruptibleFFI</literal> extension is enabled,
a foreign call
can be annotated with <literal>interruptible</literal> instead
of <literal>safe</literal> or <literal>unsafe</literal>:
......
docs/users_guide/flags.xml
View file @ 0f0c1b5b
......@@ -932,6 +932,12 @@
<entry>dynamic</entry>
<entry><option>-XNoUnliftedFFITypes</option></entry>
</row>
<row>
<entry><option>-XInterruptibleFFI</option></entry>
<entry>Enable interruptible FFI.</entry>
<entry>dynamic</entry>
<entry><option>-XNoInterruptibleFFI</option></entry>
</row>
<row>
<entry><option>-XLiberalTypeSynonyms</option></entry>
<entry>Enable <link linkend="type-synonyms">liberalised type synonyms</link>.</entry>
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment