-mkImport (CCall cconv) safety (entity, v, ty) = do
- importSpec <- parseCImport entity cconv safety v
- return (ForD (ForeignImport v ty importSpec))
-mkImport (DNCall ) _ (entity, v, ty) = do
- spec <- parseDImport entity
- return $ ForD (ForeignImport v ty (DNImport spec))
-
--- parse the entity string of a foreign import declaration for the `ccall' or
--- `stdcall' calling convention'
---
-parseCImport :: Located FastString
- -> CCallConv
- -> Safety
- -> Located RdrName
- -> P ForeignImport
-parseCImport (L loc entity) cconv safety v
- -- FIXME: we should allow white space around `dynamic' and `wrapper' -=chak
- | entity == FSLIT ("dynamic") =
- return $ CImport cconv safety nilFS nilFS (CFunction DynamicTarget)
- | entity == FSLIT ("wrapper") =
- return $ CImport cconv safety nilFS nilFS CWrapper
- | otherwise = parse0 (unpackFS entity)
- where
- -- using the static keyword?
- parse0 (' ': rest) = parse0 rest
- parse0 ('s':'t':'a':'t':'i':'c':rest) = parse1 rest
- parse0 rest = parse1 rest
- -- check for header file name
- parse1 "" = parse4 "" nilFS False nilFS
- parse1 (' ':rest) = parse1 rest
- parse1 str@('&':_ ) = parse2 str nilFS
- parse1 str@('[':_ ) = parse3 str nilFS False
- parse1 str
- | ".h" `isSuffixOf` first = parse2 rest (mkFastString first)
- | otherwise = parse4 str nilFS False nilFS
- where
- (first, rest) = break (\c -> c == ' ' || c == '&' || c == '[') str
- -- check for address operator (indicating a label import)
- parse2 "" header = parse4 "" header False nilFS
- parse2 (' ':rest) header = parse2 rest header
- parse2 ('&':rest) header = parse3 rest header True
- parse2 str@('[':_ ) header = parse3 str header False
- parse2 str header = parse4 str header False nilFS
- -- check for library object name
- parse3 (' ':rest) header isLbl = parse3 rest header isLbl
- parse3 ('[':rest) header isLbl =
- case break (== ']') rest of
- (lib, ']':rest) -> parse4 rest header isLbl (mkFastString lib)
- _ -> parseError loc "Missing ']' in entity"
- parse3 str header isLbl = parse4 str header isLbl nilFS
- -- check for name of C function
- parse4 "" header isLbl lib = build (mkExtName (unLoc v)) header isLbl lib
- parse4 (' ':rest) header isLbl lib = parse4 rest header isLbl lib
- parse4 str header isLbl lib
- | all (== ' ') rest = build (mkFastString first) header isLbl lib
- | otherwise = parseError loc "Malformed entity string"
- where
- (first, rest) = break (== ' ') str
- --
- build cid header False lib = return $
- CImport cconv safety header lib (CFunction (StaticTarget cid))
- build cid header True lib = return $
- CImport cconv safety header lib (CLabel cid )
-
---
--- Unravel a dotnet spec string.
---
-parseDImport :: Located FastString -> P DNCallSpec
-parseDImport (L loc entity) = parse0 comps
+mkImport cconv safety (L loc entity, v, ty)
+ | cconv == PrimCallConv = do
+ let funcTarget = CFunction (StaticTarget entity)
+ importSpec = CImport PrimCallConv safety nilFS funcTarget
+ return (ForD (ForeignImport v ty importSpec))
+ | otherwise = do
+ case parseCImport cconv safety (mkExtName (unLoc v)) (unpackFS entity) of
+ Nothing -> parseError loc "Malformed entity string"
+ Just importSpec -> return (ForD (ForeignImport v ty importSpec))
+
+-- the string "foo" is ambigous: either a header or a C identifier. The
+-- C identifier case comes first in the alternatives below, so we pick
+-- that one.
+parseCImport :: CCallConv -> Safety -> FastString -> String
+ -> Maybe ForeignImport
+parseCImport cconv safety nm str =
+ listToMaybe $ map fst $ filter (null.snd) $
+ readP_to_S parse str