Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
0f0c1b5b
Commit
0f0c1b5b
authored
Jul 11, 2011
by
Ian Lynagh
Browse files
Make an extension for interruptible FFI calls
parent
aa390568
Changes
4
Hide whitespace changes
Inline
Side-by-side
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
f
fiBit),
( "interruptible", ITinterruptible, bit
interruptibleF
fiBit),
( "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>
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment