FFI safety is now explicitly given (#229)

User should now specify unsafe/safe/interruptible explicitly.
constructors and destructors are always unsafe (this should be taken granted. C++ library should not call Haskell back inside constructor/destructors). Accessor functions (getter/setter) are also unsafe.
On the other hand, calling an instance of std::function (which is hard-coded in FFICXX.Runtime.Function.TH) should be unconditionally safe.

* unsafe testing
* introduce C FFI Safety
* ordinary function safety is handled.
* Safety in fficxx-runtime
* template haskell gen now handles Safety
* Add Safety parameter in TFun. and update stdcxx
* update examples with Safety parameter
* upgrade template TH code generation with FFISafety
* calling std::function should be safe!

fficxx-multipkg-test/template-dep/Gen.hs

@@ -58,6 +58,7 @@ import FFICXX.Generate.Type.Config
 import FFICXX.Generate.Type.Module
 import FFICXX.Generate.Type.PackageInterface
 import FFICXX.Runtime.CodeGen.Cxx (HeaderName (..), Namespace (..))
+import FFICXX.Runtime.Types (FFISafety (..))
 import System.Directory (getCurrentDirectory)
 import System.Environment (getArgs)
 import System.FilePath ((</>))
@@ -104,7 +105,8 @@ tT1 cabal =
               tfun_new_alias = Nothing
             },
           TFun
-            { tfun_ret = Void,
+            { tfun_safety = FFIUnsafe,
+              tfun_ret = Void,
               tfun_name = "method",
               tfun_oname = "method",
               tfun_args = []
@@ -126,7 +128,8 @@ tT2 cabal =
               tfun_new_alias = Nothing
             },
           TFun
-            { tfun_ret = Void,
+            { tfun_safety = FFIUnsafe,
+              tfun_ret = Void,
               tfun_name = "callT1",
               tfun_oname = "callT1",
               tfun_args =

fficxx-multipkg-test/template-member/Gen.hs

@@ -58,6 +58,7 @@ import FFICXX.Generate.Type.Config
 import FFICXX.Generate.Type.Module
 import FFICXX.Generate.Type.PackageInterface
 import FFICXX.Runtime.CodeGen.Cxx (HeaderName (..), Namespace (..))
+import FFICXX.Runtime.Types (FFISafety (..))
 import System.Directory (getCurrentDirectory)
 import System.Environment (getArgs)
 import System.FilePath ((</>))
@@ -109,9 +110,9 @@ string =
     mempty
     (Just (ClassAlias {caHaskellName = "CppString", caFFIName = "string"}))
     [ Constructor [cstring "p"] Nothing,
-      NonVirtual cstring_ "c_str" [] Nothing,
-      NonVirtual (cppclassref_ string) "append" [cppclassref string "str"] Nothing,
-      NonVirtual (cppclassref_ string) "erase" [] Nothing
+      NonVirtual FFIUnsafe cstring_ "c_str" [] Nothing,
+      NonVirtual FFIUnsafe (cppclassref_ string) "append" [cppclassref string "str"] Nothing,
+      NonVirtual FFIUnsafe (cppclassref_ string) "erase" [] Nothing
     ]
     []
     []
@@ -125,10 +126,10 @@ t_vector =
     (FormSimple "std::vector")
     ["tp1"]
     [ TFunNew [] Nothing,
-      TFun void_ "push_back" "push_back" [Arg (TemplateParam "tp1") "x"],
-      TFun void_ "pop_back" "pop_back" [],
-      TFun (TemplateParam "tp1") "at" "at" [int "n"],
-      TFun int_ "size" "size" [],
+      TFun FFIUnsafe void_ "push_back" "push_back" [Arg (TemplateParam "tp1") "x"],
+      TFun FFIUnsafe void_ "pop_back" "pop_back" [],
+      TFun FFIUnsafe (TemplateParam "tp1") "at" "at" [int "n"],
+      TFun FFIUnsafe int_ "size" "size" [],
       TFunDelete
     ]
     []
@@ -142,9 +143,9 @@ t_unique_ptr =
     ["tp1"]
     [ TFunNew [] (Just "newUniquePtr0"),
       TFunNew [Arg (TemplateParamPointer "tp1") "p"] Nothing,
-      TFun (TemplateParamPointer "tp1") "get" "get" [],
-      TFun (TemplateParamPointer "tp1") "release" "release" [],
-      TFun void_ "reset" "reset" [],
+      TFun FFIUnsafe (TemplateParamPointer "tp1") "get" "get" [],
+      TFun FFIUnsafe (TemplateParamPointer "tp1") "release" "release" [],
+      TFun FFIUnsafe void_ "reset" "reset" [],
       TFunDelete
     ]
     []
@@ -190,14 +191,16 @@ classA cabal =
       class_vars = [],
       class_tmpl_funcs =
         [ TemplateMemberFunction
-            { tmf_params = ["tp1"],
+            { tmf_safety = FFIUnsafe,
+              tmf_params = ["tp1"],
               tmf_ret = void_,
               tmf_name = "method",
               tmf_args = [Arg (TemplateParamPointer "tp1") "x"],
               tmf_alias = Nothing
             },
           TemplateMemberFunction
-            { tmf_params = ["tp1"],
+            { tmf_safety = FFIUnsafe,
+              tmf_params = ["tp1"],
               tmf_ret = void_,
               tmf_name = "method2",
               tmf_args =
@@ -227,7 +230,7 @@ classT1 cabal =
       class_alias = Nothing,
       class_funcs =
         [ Constructor [] Nothing,
-          NonVirtual void_ "print" [] Nothing
+          NonVirtual FFIUnsafe void_ "print" [] Nothing
         ],
       class_vars = [],
       class_tmpl_funcs = [],
@@ -244,7 +247,7 @@ classT2 cabal =
       class_alias = Nothing,
       class_funcs =
         [ Constructor [] Nothing,
-          NonVirtual void_ "print" [] Nothing
+          NonVirtual FFIUnsafe void_ "print" [] Nothing
         ],
       class_vars = [],
       class_tmpl_funcs = [],

fficxx-multipkg-test/template-toplevel/Gen.hs

@@ -58,6 +58,7 @@ import FFICXX.Generate.Type.Config
 import FFICXX.Generate.Type.Module
 import FFICXX.Generate.Type.PackageInterface
 import FFICXX.Runtime.CodeGen.Cxx (HeaderName (..), Namespace (..))
+import FFICXX.Runtime.Types (FFISafety (..))
 import System.Directory (getCurrentDirectory)
 import System.Environment (getArgs)
 import System.FilePath ((</>))
@@ -111,10 +112,10 @@ t_vector =
     (FormSimple "std::vector")
     ["tp1"]
     [ TFunNew [] Nothing,
-      TFun void_ "push_back" "push_back" [Arg (TemplateParam "tp1") "x"],
-      TFun void_ "pop_back" "pop_back" [],
-      TFun (TemplateParam "tp1") "at" "at" [int "n"],
-      TFun int_ "size" "size" [],
+      TFun FFIUnsafe void_ "push_back" "push_back" [Arg (TemplateParam "tp1") "x"],
+      TFun FFIUnsafe void_ "pop_back" "pop_back" [],
+      TFun FFIUnsafe (TemplateParam "tp1") "at" "at" [int "n"],
+      TFun FFIUnsafe int_ "size" "size" [],
       TFunDelete
     ]
     []
@@ -155,14 +156,16 @@ toplevels :: [TopLevel]
 toplevels =
   [ TLOrdinary
       TopLevelFunction
-        { toplevelfunc_ret = Void,
+        { toplevelfunc_safety = FFIUnsafe,
+          toplevelfunc_ret = Void,
           toplevelfunc_name = "ordinary",
           toplevelfunc_args = [],
           toplevelfunc_alias = Nothing
         },
     TLTemplate
       ( TopLevelTemplateFunction
-          { topleveltfunc_params = ["t1"],
+          { topleveltfunc_safety = FFIUnsafe,
+            topleveltfunc_params = ["t1"],
             topleveltfunc_ret =
               TemplateAppMove (TemplateAppInfo t_vector [TArg_TypeParam "t1"] "std::vector<t1>"),
             topleveltfunc_name = "return_vector",

fficxx-runtime/fficxx-runtime.cabal

@@ -9,7 +9,7 @@ License-file:   LICENSE
 Author:         Ian-Woo Kim
 Maintainer:     Ian-Woo Kim <ianwookim@gmail.com>
 Build-Type:     Simple
-Tested-With:    GHC == 9.2.7 || == 9.4.5 || == 9.6.2
+Tested-With:    GHC == 9.6.2
 Category:       FFI Tools
 Extra-Source-Files:
   ChangeLog.md
@@ -31,8 +31,7 @@ Library
                    FFICXX.Runtime.Function.Template
                    FFICXX.Runtime.Function.TH
                    FFICXX.Runtime.TH
-
-
+                   FFICXX.Runtime.Types
   Include-dirs:    csrc
   Install-includes: MacroPatternMatch.h
                     Function.h

fficxx-runtime/src/FFICXX/Runtime/Function/TH.hs

@@ -10,11 +10,13 @@ import FFICXX.Runtime.Function.Template (Function)
 import FFICXX.Runtime.TH
   ( FunctionParamInfo (..),
     con,
+    mkDelete,
     mkInstance,
     mkMember,
     mkNew,
     mkTFunc,
   )
+import FFICXX.Runtime.Types (FFISafety (..))
 import Foreign.Ptr (FunPtr)
 import Language.Haskell.TH (forImpD, safe)
 import Language.Haskell.TH.Syntax
@@ -45,23 +47,23 @@ mkWrapper (typ, suffix) =
 
 t_newFunction :: Type -> String -> Q Exp
 t_newFunction typ suffix =
-  mkTFunc (typ, suffix, \n -> "Function_new_" <> n, tyf)
+  mkTFunc FFIUnsafe (typ, suffix, \n -> "Function_new_" <> n, tyf)
   where
     tyf _n =
       let t = pure typ
        in [t|FunPtr $(t) -> IO (Function $(t))|]
 
-t_call :: Type -> String -> Q Exp
-t_call typ suffix =
-  mkTFunc (typ, suffix, \n -> "Function_call_" <> n, tyf)
+t_call :: FFISafety -> Type -> String -> Q Exp
+t_call safety typ suffix =
+  mkTFunc safety (typ, suffix, \n -> "Function_call_" <> n, tyf)
   where
     tyf _n =
       let t = pure typ
        in [t|Function $(t) -> $(t)|]
 
 t_deleteFunction :: Type -> String -> Q Exp
 t_deleteFunction typ suffix =
-  mkTFunc (typ, suffix, \n -> "Function_delete_" <> n, tyf)
+  mkTFunc FFIUnsafe (typ, suffix, \n -> "Function_delete_" <> n, tyf)
   where
     tyf _n =
       let t = pure typ
@@ -73,8 +75,9 @@ genFunctionInstanceFor qtyp param =
     let suffix = fpinfoSuffix param
     typ <- qtyp
     f1 <- mkNew "newFunction" t_newFunction typ suffix
-    f2 <- mkMember "call" t_call typ suffix
-    f3 <- mkMember "deleteFunction" t_deleteFunction typ suffix
+    -- NOTE: The indirected function call should be safe.
+    f2 <- mkMember "call" (t_call FFISafe) typ suffix
+    f3 <- mkDelete "deleteFunction" t_deleteFunction typ suffix
     wrap <- mkWrapper (typ, suffix)
     addModFinalizer
       ( addForeignSource

fficxx-runtime/src/FFICXX/Runtime/TH.hs

@@ -2,9 +2,9 @@
 
 module FFICXX.Runtime.TH where
 
---
 import FFICXX.Runtime.CodeGen.Cxx (HeaderName, Namespace)
-import Language.Haskell.TH (forImpD, safe, varE)
+import FFICXX.Runtime.Types (FFISafety (..))
+import Language.Haskell.TH (forImpD, interruptible, safe, unsafe, varE)
 import Language.Haskell.TH.Syntax
   ( Body (NormalB),
     Callconv (CCall),
@@ -54,13 +54,18 @@ con = ConT . mkNameS
 mkInstance :: Cxt -> Type -> [Dec] -> Dec
 mkInstance = InstanceD Nothing
 
-mkTFunc :: (types, String, String -> String, types -> Q Type) -> Q Exp
-mkTFunc (typs, suffix, nf, tyf) =
+mkTFunc :: FFISafety -> (types, String, String -> String, types -> Q Type) -> Q Exp
+mkTFunc safety (typs, suffix, nf, tyf) =
   do
     let fn = nf suffix
     let fn' = "c_" <> fn
     n <- newName fn'
-    d <- forImpD CCall safe fn n (tyf typs)
+    let safety_modifier =
+          case safety of
+            FFIUnsafe -> unsafe
+            FFISafe -> safe
+            FFIInterruptible -> interruptible
+    d <- forImpD CCall safety_modifier fn n (tyf typs)
     addTopDecls [d]
     [|$(varE n)|]
 

fficxx-runtime/src/FFICXX/Runtime/Types.hs

@@ -0,0 +1,7 @@
+module FFICXX.Runtime.Types
+  ( FFISafety (..),
+  )
+where
+
+data FFISafety = FFIUnsafe | FFISafe | FFIInterruptible
+  deriving (Show)

fficxx-test/fficxx-test.cabal

@@ -1,6 +1,6 @@
 Cabal-Version:  3.0
 Name:           fficxx-test
-Version:        0.7.0.1
+Version:        0.8.0.0
 Synopsis:       test for fficxx
 Description:    test for fficxx (with stdcxx)
 License:        BSD-2-Clause

fficxx/src/FFICXX/Generate/Builder.hs

@@ -159,7 +159,7 @@ simpleBuilder cfg sbc = do
   putStrLn "Generating Enum.hsc"
   gen
     (topLevelMod <.> "Enum" <.> "hsc")
-    (exactPrint (C.buildEnumHsc mempty (topLevelMod <> ".Enum") enums))
+    (exactPrint (C.buildEnumHsc (topLevelMod <> ".Enum") enums))
   --
   putStrLn "Generating RawType.hs"
   for_ mods $ \m ->

fficxx/src/FFICXX/Generate/Code/HsEnum.hs

@@ -4,12 +4,10 @@ module FFICXX.Generate.Code.HsEnum
   )
 where
 
-import Control.Monad.Reader (Reader)
 import FFICXX.Generate.Name
   ( enumDataConstructorNames,
     enumDataTypeName,
   )
-import FFICXX.Generate.Type.Annotate (AnnotateMap)
 import FFICXX.Generate.Type.Class (EnumType (..))
 import FFICXX.Generate.Util.GHCExactPrint
   ( DeclGroup,
@@ -31,7 +29,7 @@ import FFICXX.Generate.Util.GHCExactPrint
 import GHC.Hs (GhcPs)
 import GHC.Parser.Annotation (DeltaPos (..))
 import Language.Haskell.Syntax
-  ( HsDecl (DocD, TyClD),
+  ( HsDecl (TyClD),
     HsLocalBindsLR (..),
     noExtField,
   )

fficxx/src/FFICXX/Generate/Code/HsFFI.hs

@@ -10,6 +10,7 @@ import FFICXX.Generate.Code.Primitive
     genericFuncArgs,
     genericFuncRet,
     hsFFIFunType,
+    toGHCSafety,
   )
 import FFICXX.Generate.Dependency
   ( class_allparents,
@@ -29,6 +30,7 @@ import FFICXX.Generate.Type.Class
     Selfness (NoSelf, Self),
     TLOrdinary (..),
     Variable (unVariable),
+    getFunSafety,
     isAbstractClass,
     isNewFunc,
     isStaticFunc,
@@ -45,9 +47,8 @@ import FFICXX.Generate.Util.GHCExactPrint
     mkImport,
   )
 import FFICXX.Runtime.CodeGen.Cxx (HeaderName (..))
-import GHC.Hs
-  ( GhcPs,
-  )
+import FFICXX.Runtime.Types (FFISafety (FFIUnsafe))
+import GHC.Hs (GhcPs)
 import Language.Haskell.Syntax
   ( ForeignDecl,
     ImportDecl,
@@ -80,14 +81,15 @@ hsFFIClassFunc headerfilename c f =
     then Nothing
     else
       let hfile = unHdrName headerfilename
+          safety = getFunSafety f
           -- TODO: Make this a separate function
           cname = ffiClassName c <> "_" <> aliasedFuncName c f
           csig = CFunSig (genericFuncArgs f) (genericFuncRet f)
           typ =
             if (isNewFunc f || isStaticFunc f)
               then hsFFIFunType (Just (NoSelf, c)) csig
               else hsFFIFunType (Just (Self, c)) csig
-       in Just (mkForImpCcall (hfile <> " " <> cname) (hscFuncName c f) typ)
+       in Just (mkForImpCcall (toGHCSafety safety) (hfile <> " " <> cname) (hscFuncName c f) typ)
 
 hsFFIAccessor :: Class -> Variable -> Accessor -> ForeignDecl GhcPs
 hsFFIAccessor c v a =
@@ -97,7 +99,7 @@ hsFFIAccessor c v a =
         hsFFIFunType
           (Just (Self, c))
           (accessorCFunSig (arg_type (unVariable v)) a)
-   in mkForImpCcall cname (hscAccessorName c v a) typ
+   in mkForImpCcall (toGHCSafety FFIUnsafe) cname (hscAccessorName c v a) typ
 
 -- import for FFI
 genImportInFFI :: ClassModule -> [ImportDecl GhcPs]
@@ -108,12 +110,23 @@ genImportInFFI = fmap (mkImport . subModuleName) . cmImportedSubmodulesForFFI
 ----------------------------
 
 genTopLevelFFI :: TopLevelImportHeader -> TLOrdinary -> ForeignDecl GhcPs
-genTopLevelFFI header tfn = mkForImpCcall (hfilename <> " TopLevel_" <> fname) cfname typ
+genTopLevelFFI header tfn =
+  mkForImpCcall (toGHCSafety safety) (hfilename <> " TopLevel_" <> fname) cfname typ
   where
-    (fname, args, ret) =
+    (safety, fname, args, ret) =
       case tfn of
-        TopLevelFunction {..} -> (fromMaybe toplevelfunc_name toplevelfunc_alias, toplevelfunc_args, toplevelfunc_ret)
-        TopLevelVariable {..} -> (fromMaybe toplevelvar_name toplevelvar_alias, [], toplevelvar_ret)
+        TopLevelFunction {..} ->
+          ( toplevelfunc_safety,
+            fromMaybe toplevelfunc_name toplevelfunc_alias,
+            toplevelfunc_args,
+            toplevelfunc_ret
+          )
+        TopLevelVariable {..} ->
+          ( FFIUnsafe,
+            fromMaybe toplevelvar_name toplevelvar_alias,
+            [],
+            toplevelvar_ret
+          )
     hfilename = tihHeaderFileName header <.> "h"
     -- TODO: This must be exposed as a top-level function
     cfname = "c_" <> toLowers fname