- 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 (CFunction DynamicTarget)
- | entity == fsLit "wrapper" =
- return $ CImport cconv safety 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
- parse1 (' ':rest) = parse1 rest
- parse1 str@('&':_ ) = parse2 str nilFS
- parse1 str
- | ".h" `isSuffixOf` first = parse2 rest (mkFastString first)
- | otherwise = parse4 str nilFS False
- where
- (first, rest) = break (\c -> c == ' ' || c == '&') str
- -- check for address operator (indicating a label import)
- parse2 "" header = parse4 "" header False
- parse2 (' ':rest) header = parse2 rest header
- parse2 ('&':rest) header = parse3 rest header
- parse2 str header = parse4 str header False
- -- eat spaces after '&'
- parse3 (' ':rest) header = parse3 rest header
- parse3 str header = parse4 str header True
- -- check for name of C function
- parse4 "" header isLbl = build (mkExtName (unLoc v)) header isLbl
- parse4 (' ':rest) header isLbl = parse4 rest header isLbl
- parse4 str header isLbl
- | all (== ' ') rest = build (mkFastString first) header isLbl
- | otherwise = parseError loc "Malformed entity string"
- where
- (first, rest) = break (== ' ') str
- --
- build cid header False = return $
- CImport cconv safety header (CFunction (StaticTarget cid))
- build cid header True = return $
- CImport cconv safety header (CLabel cid )
-
---
--- Unravel a dotnet spec string.
---
-parseDImport :: Located FastString -> P DNCallSpec
-parseDImport (L loc entity) = parse0 comps
+ 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