checkDictTy :: LHsType RdrName -> P (LHsType RdrName)
checkDictTy (L spn ty) = check ty []
where
- check (HsTyVar t) args | not (isRdrTyVar t)
- = return (L spn (HsPredTy (HsClassP t args)))
+ check (HsTyVar tc) args | isRdrTc tc = done tc args
+ check (HsOpTy t1 (L _ tc) t2) args | isRdrTc tc = done tc (t1:t2:args)
check (HsAppTy l r) args = check (unLoc l) (r:args)
check (HsParTy t) args = check (unLoc t) args
check _ _ = parseError spn "Malformed instance header"
+ done tc args = return (L spn (HsPredTy (HsClassP tc args)))
+
checkTParams :: Bool -- Type/data family
-> [LHsType RdrName]
-> P ([LHsTyVarBndr RdrName], Maybe [LHsType RdrName])
-> P (HsDecl RdrName)
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))
+ let funcTarget = CFunction (StaticTarget entity Nothing)
+ 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"
listToMaybe $ map fst $ filter (null.snd) $
readP_to_S parse str
where
- parse = choice [
+ parse = do
+ skipSpaces
+ r <- choice [
string "dynamic" >> return (mk nilFS (CFunction DynamicTarget)),
string "wrapper" >> return (mk nilFS CWrapper),
optional (string "static" >> skipSpaces) >>
(mk nilFS <$> cimp nm) +++
(do h <- munch1 hdr_char; skipSpaces; mk (mkFastString h) <$> cimp nm)
- ]
+ ]
+ skipSpaces
+ return r
mk = CImport cconv safety
id_char c = isAlphaNum c || c == '_'
cimp nm = (ReadP.char '&' >> skipSpaces >> CLabel <$> cid)
- +++ ((CFunction . StaticTarget) <$> cid)
+ +++ ((\c -> CFunction (StaticTarget c Nothing)) <$> cid)
where
cid = return nm +++
(do c <- satisfy (\c -> isAlpha c || c == '_')