module FFICXX.Generate.Code.HsFFI where
import Data.Char (toLower)
import System.FilePath ((<.>))
import FFICXX.Generate.Util
import FFICXX.Generate.Type.Class
genHsFFI :: ClassImportHeader -> String
genHsFFI header =
let c = cihClass header
h = cihSelfHeader header
allfns = concatMap (virtualFuncs . class_funcs)
(class_allparents c)
++ (class_funcs c)
in intercalateWith connRet2 (hsFFIClassFunc h c) allfns
genAllHsFFI :: [ClassImportHeader] -> String
genAllHsFFI = intercalateWith connRet2 genHsFFI
ffistub :: String
ffistub = "foreign import ccall \"$headerfilename$ $classname$_$funcname$\" $hsfuncname$ \n :: $hsargs$"
ffiTemplate :: String
ffiTemplate = "foreign import ccall \"$headerfilename$ $funcname$\" $hsfuncname$ \n :: $hsargs$"
hsFFIClassFunc :: FilePath -> Class -> Function -> String
hsFFIClassFunc headerfilename c f = if isAbstractClass c
then ""
else if (isNewFunc f || isStaticFunc f)
then render ffistub
[ ("headerfilename",headerfilename)
, ("classname",class_name c)
, ("funcname", aliasedFuncName c f)
, ("hsfuncname",hscFuncName c f)
, ("hsargs", hsFuncTypNoSelf c f) ]
else render ffistub
[ ("headerfilename",headerfilename)
, ("classname",class_name c)
, ("funcname", aliasedFuncName c f)
, ("hsfuncname",hscFuncName c f)
, ("hsargs", hsFuncTyp c f) ]
genTopLevelFuncFFI :: TopLevelImportHeader -> TopLevelFunction -> String
genTopLevelFuncFFI header tfn =
case tfn of
TopLevelFunction {..} ->
let fname = maybe toplevelfunc_name id toplevelfunc_alias
(x:xs) = fname
headerfilename = tihHeaderFileName header <.> "h"
hfname = toLower x : xs
cfname = "c_" ++ toLowers hfname
args = toplevelfunc_args
ret = toplevelfunc_ret
argstr = concatMap ((++ " -> ") . hsargtype . fst) args ++ hsrettype ret
in render ffiTemplate
[ ("headerfilename",headerfilename)
, ("funcname", "TopLevel_" ++ fname)
, ("hsfuncname",cfname)
, ("hsargs", argstr) ]
TopLevelVariable {..} ->
let fname = maybe toplevelvar_name id toplevelvar_alias
(x:xs) = fname
headerfilename = tihHeaderFileName header <.> "h"
hfname = toLower x : xs
cfname = "c_" ++ toLowers hfname
args = []
ret = toplevelvar_ret
argstr = concatMap ((++ " -> ") . hsargtype . fst) args ++ hsrettype ret
in render ffiTemplate
[ ("headerfilename",headerfilename)
, ("funcname", "TopLevel_" ++ fname)
, ("hsfuncname",cfname)
, ("hsargs", argstr) ]
where hsargtype (CT ctype _) = hsCTypeName ctype
hsargtype (CPT x _) = hsCppTypeName x
hsargtype SelfType = "genTopLevelFuncFFI : no self for top level function "
hsargtype _ = error "undefined hsargtype"
hsrettype Void = "IO ()"
hsrettype SelfType = "genTopLevelFuncFFI : no self for top level function "
hsrettype (CT ctype _) = "IO " ++ hsCTypeName ctype
hsrettype (CPT x _ ) = "IO " ++ hsCppTypeName x