diff options
| author | Duncan Coutts <duncan@well-typed.com> | 2009-06-09 10:45:36 +0000 |
|---|---|---|
| committer | Duncan Coutts <duncan@well-typed.com> | 2009-06-09 10:45:36 +0000 |
| commit | a4005d2d0c18ffa72ba7bd0fa052666e70e8c16e (patch) | |
| tree | f8baa0e8726b7b43033c5a469d27e946ff537a21 | |
| parent | 71aa4a4723e95b4f27fccf93dcc0a33000010974 (diff) | |
| download | haskell-a4005d2d0c18ffa72ba7bd0fa052666e70e8c16e.tar.gz | |
Lexing and parsing for "foreign import prim"
We only allow simple function label imports, not the normal complicated
business with "wrapper" "dynamic" or data label "&var" imports.
| -rw-r--r-- | compiler/parser/Lexer.x | 3 | ||||
| -rw-r--r-- | compiler/parser/Parser.y.pp | 3 | ||||
| -rw-r--r-- | compiler/parser/RdrHsSyn.lhs | 7 |
3 files changed, 12 insertions, 1 deletions
diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x index 4d8e0f0acd..5cc85ae06b 100644 --- a/compiler/parser/Lexer.x +++ b/compiler/parser/Lexer.x @@ -484,6 +484,7 @@ data Token | ITunsafe | ITstdcallconv | ITccallconv + | ITprimcallconv | ITdotnet | ITmdo | ITfamily @@ -631,6 +632,7 @@ isSpecial ITthreadsafe = True isSpecial ITunsafe = True isSpecial ITccallconv = True isSpecial ITstdcallconv = True +isSpecial ITprimcallconv = True isSpecial ITmdo = True isSpecial ITfamily = True isSpecial ITgroup = True @@ -692,6 +694,7 @@ reservedWordsFM = listToUFM $ ( "unsafe", ITunsafe, bit ffiBit), ( "stdcall", ITstdcallconv, bit ffiBit), ( "ccall", ITccallconv, bit ffiBit), + ( "prim", ITprimcallconv, bit ffiBit), ( "dotnet", ITdotnet, bit ffiBit), ( "rec", ITrec, bit arrowsBit), diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp index 47b049eaee..ef48bb457a 100644 --- a/compiler/parser/Parser.y.pp +++ b/compiler/parser/Parser.y.pp @@ -246,6 +246,7 @@ incorrect. 'family' { L _ ITfamily } 'stdcall' { L _ ITstdcallconv } 'ccall' { L _ ITccallconv } + 'prim' { L _ ITprimcallconv } 'dotnet' { L _ ITdotnet } 'proc' { L _ ITproc } -- for arrow notation extension 'rec' { L _ ITrec } -- for arrow notation extension @@ -952,6 +953,7 @@ fdecl : 'import' callconv safety fspec callconv :: { CallConv } : 'stdcall' { CCall StdCallConv } | 'ccall' { CCall CCallConv } + | 'prim' { CCall PrimCallConv} | 'dotnet' { DNCall } safety :: { Safety } @@ -1902,6 +1904,7 @@ special_id | 'dynamic' { L1 (fsLit "dynamic") } | 'stdcall' { L1 (fsLit "stdcall") } | 'ccall' { L1 (fsLit "ccall") } + | 'prim' { L1 (fsLit "prim") } special_sym :: { Located FastString } special_sym : '!' { L1 (fsLit "!") } diff --git a/compiler/parser/RdrHsSyn.lhs b/compiler/parser/RdrHsSyn.lhs index 3ca1b29bf3..c1c5972b6f 100644 --- a/compiler/parser/RdrHsSyn.lhs +++ b/compiler/parser/RdrHsSyn.lhs @@ -64,7 +64,7 @@ import BasicTypes ( maxPrecedence, Activation, RuleMatchInfo, alwaysInlineSpec, neverInlineSpec ) import Lexer ( P, failSpanMsgP, extension, standaloneDerivingEnabled, bangPatEnabled ) import TysWiredIn ( unitTyCon ) -import ForeignCall ( CCallConv, Safety, CCallTarget(..), CExportSpec(..), +import ForeignCall ( CCallConv(..), Safety, CCallTarget(..), CExportSpec(..), DNCallSpec(..), DNKind(..), CLabelString ) import OccName ( srcDataName, varName, isDataOcc, isTcOcc, occNameString ) @@ -957,6 +957,11 @@ mkImport :: CallConv -> Safety -> (Located FastString, Located RdrName, LHsType RdrName) -> P (HsDecl RdrName) +mkImport (CCall cconv) safety (entity, v, ty) + | cconv == PrimCallConv = do + let funcTarget = CFunction (StaticTarget (unLoc entity)) + importSpec = CImport PrimCallConv safety nilFS nilFS funcTarget + return (ForD (ForeignImport v ty importSpec)) mkImport (CCall cconv) safety (entity, v, ty) = do importSpec <- parseCImport entity cconv safety v return (ForD (ForeignImport v ty importSpec)) |