projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Interruptible FFI calls with pthread_kill and CancelSynchronousIO. v4
[ghc-hetmet.git]
/
compiler
/
hsSyn
/
Convert.lhs
diff --git
a/compiler/hsSyn/Convert.lhs
b/compiler/hsSyn/Convert.lhs
index
2a4fa72
..
fc5f897
100644
(file)
--- a/
compiler/hsSyn/Convert.lhs
+++ b/
compiler/hsSyn/Convert.lhs
@@
-7,7
+7,8
@@
This module converts Template Haskell syntax into HsSyn
\begin{code}
module Convert( convertToHsExpr, convertToPat, convertToHsDecls,
\begin{code}
module Convert( convertToHsExpr, convertToPat, convertToHsDecls,
- convertToHsType, thRdrNameGuesses ) where
+ convertToHsType, convertToHsPred,
+ thRdrNameGuesses ) where
import HsSyn as Hs
import qualified Class
import HsSyn as Hs
import qualified Class
@@
-58,6
+59,10
@@
convertToHsType :: SrcSpan -> TH.Type -> Either Message (LHsType RdrName)
convertToHsType loc t
= initCvt loc $ wrapMsg "type" t $ cvtType t
convertToHsType loc t
= initCvt loc $ wrapMsg "type" t $ cvtType t
+convertToHsPred :: SrcSpan -> TH.Pred -> Either Message (LHsPred RdrName)
+convertToHsPred loc t
+ = initCvt loc $ wrapMsg "type" t $ cvtPred t
+
-------------------------------------------------------------------
newtype CvtM a = CvtM { unCvtM :: SrcSpan -> Either Message a }
-- Push down the source location;
-------------------------------------------------------------------
newtype CvtM a = CvtM { unCvtM :: SrcSpan -> Either Message a }
-- Push down the source location;
@@
-370,6
+375,7
@@
cvtForD (ImportF callconv safety from nm ty)
Unsafe -> PlayRisky
Safe -> PlaySafe False
Threadsafe -> PlaySafe True
Unsafe -> PlayRisky
Safe -> PlaySafe False
Threadsafe -> PlaySafe True
+ Interruptible -> PlayInterruptible
cvtForD (ExportF callconv as nm ty)
= do { nm' <- vNameL nm
cvtForD (ExportF callconv as nm ty)
= do { nm' <- vNameL nm
@@
-400,7
+406,7
@@
cvtInlineSpec Nothing
= defaultInlinePragma
cvtInlineSpec (Just (TH.InlineSpec inline conlike opt_activation))
= InlinePragma { inl_act = opt_activation', inl_rule = matchinfo
= defaultInlinePragma
cvtInlineSpec (Just (TH.InlineSpec inline conlike opt_activation))
= InlinePragma { inl_act = opt_activation', inl_rule = matchinfo
- , inl_inline = inline, inl_sat = Nothing }
+ , inl_inline = inl_spec, inl_sat = Nothing }
where
matchinfo = cvtRuleMatchInfo conlike
opt_activation' = cvtActivation opt_activation
where
matchinfo = cvtRuleMatchInfo conlike
opt_activation' = cvtActivation opt_activation
@@
-408,6
+414,10
@@
cvtInlineSpec (Just (TH.InlineSpec inline conlike opt_activation))
cvtRuleMatchInfo False = FunLike
cvtRuleMatchInfo True = ConLike
cvtRuleMatchInfo False = FunLike
cvtRuleMatchInfo True = ConLike
+ inl_spec | inline = Inline
+ | otherwise = NoInline
+ -- Currently we have no way to say Inlinable
+
cvtActivation Nothing | inline = AlwaysActive
| otherwise = NeverActive
cvtActivation (Just (False, phase)) = ActiveBefore phase
cvtActivation Nothing | inline = AlwaysActive
| otherwise = NeverActive
cvtActivation (Just (False, phase)) = ActiveBefore phase
@@
-589,11
+599,12
@@
cvtLit (WordPrimL w) = do { force w; return $ HsWordPrim w }
cvtLit (FloatPrimL f) = do { force f; return $ HsFloatPrim f }
cvtLit (DoublePrimL f) = do { force f; return $ HsDoublePrim f }
cvtLit (CharL c) = do { force c; return $ HsChar c }
cvtLit (FloatPrimL f) = do { force f; return $ HsFloatPrim f }
cvtLit (DoublePrimL f) = do { force f; return $ HsDoublePrim f }
cvtLit (CharL c) = do { force c; return $ HsChar c }
-cvtLit (StringL s)
- = do { let { s' = mkFastString s }
- ; force s'
- ; return $ HsString s'
- }
+cvtLit (StringL s) = do { let { s' = mkFastString s }
+ ; force s'
+ ; return $ HsString s' }
+cvtLit (StringPrimL s) = do { let { s' = mkFastString s }
+ ; force s'
+ ; return $ HsStringPrim s' }
cvtLit _ = panic "Convert.cvtLit: Unexpected literal"
-- cvtLit should not be called on IntegerL, RationalL
-- That precondition is established right here in
cvtLit _ = panic "Convert.cvtLit: Unexpected literal"
-- cvtLit should not be called on IntegerL, RationalL
-- That precondition is established right here in