[add 'capi' foreign function call type, simplify type of E.FromHs monad, check for more FFI related errors
John Meacham <john@repetae.net>**20120209091611
 Ignore-this: 1945b5336e6001d6da6cd63a77bd1efd
] hunk ./src/C/FFI.hs 16
-data CallConv = CCall | StdCall | Primitive | DotNet deriving(Eq,Ord,Show)
+data CallConv = CCall | StdCall | CApi | Primitive | DotNet deriving(Eq,Ord,Show)
hunk ./src/C/Prims.hs 13
+{-
hunk ./src/C/Prims.hs 24
+-}
hunk ./src/E/FromHs.hs 10
+import Control.Monad.Error
hunk ./src/E/FromHs.hs 15
+import Text.Printf
hunk ./src/E/FromHs.hs 243
-createFunc :: Monad t =>  DataTable -> [E] -> ([TVr] -> (E -> E,E)) -> Ce t E
-createFunc dataTable es ee = do
+createFunc :: [E] -> ([TVr] -> (E -> E,E)) -> C E
+createFunc es ee = do
+    dataTable <- getDataTable
hunk ./src/E/FromHs.hs 247
-        eti <- lookupExtTypeInfo dataTable te
+        eti <- ffiTypeInfo ExtTypeVoid te return
hunk ./src/E/FromHs.hs 297
-convertE :: MonadWarn m => TiData -> ClassHierarchy -> Map.Map Name Type
-    -> DataTable -> SrcLoc -> HsExp -> m E
+convertE :: TiData -> ClassHierarchy -> Map.Map Name Type
+    -> DataTable -> SrcLoc -> HsExp -> IO E
hunk ./src/E/FromHs.hs 315
-newtype Ce t a = Ce (RWST CeEnv [Warning] Int t a)
-    deriving(Monad,Functor,MonadTrans,MonadIO,MonadReader CeEnv,MonadState Int)
+newtype C a = Ce (RWST CeEnv [Warning] Int IO a)
+    deriving(Monad,Functor,MonadIO,MonadReader CeEnv,MonadState Int,MonadError IOError)
hunk ./src/E/FromHs.hs 318
-instance Monad t => MonadWarn (Ce t) where
+instance MonadWarn C where
hunk ./src/E/FromHs.hs 321
-instance Monad t => MonadSrcLoc (Ce t) where
+instance MonadSrcLoc C where
hunk ./src/E/FromHs.hs 324
-instance Monad t => MonadSetSrcLoc (Ce t) where
+instance MonadSetSrcLoc C where
hunk ./src/E/FromHs.hs 327
-instance Monad m => UniqueProducer (Ce m) where
+instance UniqueProducer C where
hunk ./src/E/FromHs.hs 333
-instance Monad m => DataTableMonad (Ce m) where
+instance DataTableMonad C where
hunk ./src/E/FromHs.hs 336
-applyCoersion :: Monad m => CoerceTerm -> E -> Ce m E
+applyCoersion :: CoerceTerm -> E -> C E
hunk ./src/E/FromHs.hs 351
-convertDecls :: MonadWarn m => TiData -> IdMap Properties
+convertDecls :: TiData -> IdMap Properties
hunk ./src/E/FromHs.hs 353
-    -> [HsDecl] -> m [(Name,TVr,E)]
+    -> [HsDecl] -> IO [(Name,TVr,E)]
hunk ./src/E/FromHs.hs 376
-    marshallToC :: UniqueProducer m => DataTable -> E -> E -> m E
-    marshallToC dataTable e te = do
-        eti <- lookupExtTypeInfo dataTable te
+    --marshallToC ::oducer m => E -> E -> m E
+    marshallToC e te = do
+        ffiTypeInfo Unknown te $ \eti -> do
hunk ./src/E/FromHs.hs 389
-    marshallFromC :: Monad m => DataTable -> E -> E -> m E
-    marshallFromC dataTable ce te = do
-        eti <- lookupExtTypeInfo dataTable te
+    --marshallFromC :: Monad m =>  E -> E -> m E
+    marshallFromC ce te = do
+        ffiTypeInfo Unknown te $ \eti -> do
hunk ./src/E/FromHs.hs 404
-    ccallHelper :: Monad m => ([ExtType] -> ExtType -> Bool -> [E] -> E -> E) -> E -> Ce m E
+    ccallHelper :: ([ExtType] -> ExtType -> Bool -> [E] -> E -> E) -> E -> C E
hunk ./src/E/FromHs.hs 406
-        let --(ts,rt) = argTypes' ty
-          --  (isIO,rt') =  extractIO' rt
-            (ts,isIO,rt') = extractIO' ty
+        let (ts,isIO,rt') = extractIO' ty
hunk ./src/E/FromHs.hs 408
-        pt <- lookupExtTypeInfo dataTable rt'
-        cts <- mapM (lookupExtTypeInfo dataTable) (filter (not . sortKindLike) ts)
+        ffiTypeInfo Unknown rt' $ \pt -> do
+        cts <- forM  (filter (not . sortKindLike) ts) $ \t -> do ffiTypeInfo ExtTypeVoid t $ return
hunk ./src/E/FromHs.hs 411
-        let cFun = createFunc dataTable (map tvrType es)
+        let cFun = createFunc (map tvrType es)
hunk ./src/E/FromHs.hs 450
-    cDecl,cDecl' :: Monad m => HsDecl -> Ce m [(Name,TVr,E)]
-    cDecl' d = withSrcLoc (srcLoc d) $ cDecl d
+    cDecl,cDecl' :: HsDecl -> C [(Name,TVr,E)]
+    cDecl' d = withSrcLoc (srcLoc d) $ catchError (cDecl d) (\(_ :: IOError) -> return [])
hunk ./src/E/FromHs.hs 469
-        eti <- lookupExtTypeInfo dataTable rt
+        ffiTypeInfo [] rt $ \eti -> do
hunk ./src/E/FromHs.hs 503
-        pt <- lookupExtTypeInfo dataTable rt'
+        ffiTypeInfo [] rt' $ \pt -> do
hunk ./src/E/FromHs.hs 506
-        let cFun = createFunc dataTable (map tvrType es)
+        let cFun = createFunc (map tvrType es)
hunk ./src/E/FromHs.hs 540
-            eti <- lookupExtTypeInfo dataTable ty
+            ffiTypeInfo (Unknown,undefined,undefined) ty $ \eti -> do
+--            eti <- lookupExtTypeInfo dataTable ty
hunk ./src/E/FromHs.hs 547
-            e <- marshallFromC dataTable (EVar v) ty
+            e <- marshallFromC (EVar v) ty
hunk ./src/E/FromHs.hs 553
---        argCTys <- mapM (liftM (\(_,st,_) -> st) . lookupCType' dataTable) argTys
-
- --       argTvrs <- newVars argCTys
---        argEs <- sequence [(marshallFromC dataTable (EVar v) et) | v <- argTvrs | et <- argTys]
-
hunk ./src/E/FromHs.hs 557
-                  False -> marshallToC dataTable inner retTy
+                  False -> marshallToC inner retTy
hunk ./src/E/FromHs.hs 561
-                                            else marshallToC dataTable (EVar ret) retTy
+                                            else marshallToC (EVar ret) retTy
hunk ./src/E/FromHs.hs 622
-    cExpr :: Monad m => HsExp -> Ce m E
+    cExpr :: HsExp -> C E
hunk ./src/E/FromHs.hs 706
-    cMatchs :: Monad m => [E] -> [([HsPat],HsRhs,[HsDecl])] -> E -> Ce m E
+    cMatchs :: [E] -> [([HsPat],HsRhs,[HsDecl])] -> E -> C E
hunk ./src/E/FromHs.hs 805
-tidyPat ::
-    Monad m
-    => HsPat
+tidyPat
+    :: HsPat
hunk ./src/E/FromHs.hs 808
-    -> Ce m (HsPat,E -> E)
+    -> C (HsPat,E -> E)
hunk ./src/E/FromHs.hs 850
-tidyHeads ::
-    Monad m
-    => E
+tidyHeads
+    :: E
hunk ./src/E/FromHs.hs 853
-    -> Ce m [(HsPat,[HsPat],E->E)]  -- pulls the head off of each pattern, tidying it up perhaps
+    -> C [(HsPat,[HsPat],E->E)]  -- pulls the head off of each pattern, tidying it up perhaps
hunk ./src/E/FromHs.hs 859
-convertMatches ::
-    Monad m
-    => [E]               -- input expressions we are matching against.
+convertMatches
+    :: [E]               -- input expressions we are matching against.
hunk ./src/E/FromHs.hs 863
-    -> Ce m E
+    -> C E
hunk ./src/E/FromHs.hs 874
-        match :: Monad m => [E] -> [([HsPat],E->E)] -> E -> Ce m E
+        match :: [E] -> [([HsPat],E->E)] -> E -> C E
hunk ./src/E/FromHs.hs 1027
+
+ffiTypeInfo bad t cont = do
+    dataTable <- getDataTable
+    case lookupExtTypeInfo dataTable t of
+        Just r -> cont r
+        Nothing -> do
+            sl <- getSrcLoc
+            liftIO $ warn sl InvalidFFIType $ printf "Type '%s' cannot be used in a foreign declaration" (pprint t :: String)
+            return bad
hunk ./src/E/Main.hs 127
+    processIOErrors
hunk ./src/FrontEnd/ParseUtils.hs 405
+        g s _  ("capi":rs)  = g s CCall rs
hunk ./src/FrontEnd/Warning.hs 90
+    | InvalidFFIType
hunk ./src/FrontEnd/Warning.hs 108
+    f InvalidFFIType {} = True