HsFFI.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module FFICXX.Generate.Code.HsFFI where

import Data.Maybe                   ( fromMaybe, mapMaybe )
import Data.Monoid                  ( (<>) )
import Language.Haskell.Exts.Syntax ( Decl(..), ImportDecl(..) )
import System.FilePath              ( (<.>) )
--
import FFICXX.Runtime.CodeGen.Cxx   ( HeaderName(..) )
--
import FFICXX.Generate.Code.Primitive
                                    ( CFunSig(..)
                                    , accessorCFunSig
                                    , genericFuncArgs
                                    , genericFuncRet
                                    , hsFFIFuncTyp
                                    )
import FFICXX.Generate.Dependency   ( class_allparents
                                    , getClassModuleBase
                                    , getTClassModuleBase
                                    )
import FFICXX.Generate.Name         ( aliasedFuncName
                                    , ffiClassName
                                    , hscAccessorName
                                    , hscFuncName
                                    )
import FFICXX.Generate.Type.Class   ( Accessor(Getter,Setter)
                                    , Arg(..)
                                    , Class(..)
                                    , Function(..)
                                    , Selfness(NoSelf,Self)
                                    , TopLevel(..)
                                    , Variable(unVariable)
                                    , isAbstractClass
                                    , isNewFunc
                                    , isStaticFunc
                                    , virtualFuncs
                                    )
import FFICXX.Generate.Type.Module  ( ClassImportHeader(..)
                                    , ClassModule(..)
                                    , TopLevelImportHeader(..)
                                    )
import FFICXX.Generate.Util         ( toLowers )
import FFICXX.Generate.Util.HaskellSrcExts ( mkForImpCcall, mkImport )


genHsFFI :: ClassImportHeader -> [Decl ()]
genHsFFI header =
  let c = cihClass header
      -- TODO: This C header information should not be necessary according to up-to-date
      --       version of Haskell FFI.
      h = cihSelfHeader header
      -- NOTE: We need to generate FFI both for member functions at the current class level
      --       and parent level. For example, consider a class A with method foo, which a
      --       subclass of B with method bar. Then, A::foo (c_a_foo) and A::bar (c_a_bar)
      --       are made into a FFI function.
      allfns =    concatMap (virtualFuncs . class_funcs)
                            (class_allparents c)
               <> (class_funcs c)

  in    mapMaybe (hsFFIClassFunc h c) allfns
     <> concatMap
          (\v -> [hsFFIAccessor c v Getter, hsFFIAccessor c v Setter])
          (class_vars c)

hsFFIClassFunc :: HeaderName -> Class -> Function -> Maybe (Decl ())
hsFFIClassFunc headerfilename c f =
  if isAbstractClass c
  then Nothing
  else let hfile = unHdrName headerfilename
           -- 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 hsFFIFuncTyp (Just (NoSelf,c)) csig
                 else hsFFIFuncTyp (Just (Self,c)  ) csig
       in Just (mkForImpCcall (hfile <> " " <> cname) (hscFuncName c f) typ)


hsFFIAccessor ::Class -> Variable -> Accessor -> Decl ()
hsFFIAccessor c v a =
  let -- TODO: make this a separate function
      cname = ffiClassName c <> "_" <> arg_name (unVariable v) <> "_" <> (case a of Getter -> "get"; Setter -> "set")
      typ = hsFFIFuncTyp (Just (Self,c)) (accessorCFunSig (arg_type (unVariable  v)) a)
  in mkForImpCcall cname (hscAccessorName c v a) typ


-- import for FFI

genImportInFFI :: ClassModule -> [ImportDecl ()]
genImportInFFI = map mkMod . cmImportedModulesForFFI
  where mkMod (Left t)  = mkImport (getTClassModuleBase t <.> "Template")
        mkMod (Right c) = mkImport (getClassModuleBase c <.> "RawType")


----------------------------
-- for top level function --
----------------------------

genTopLevelFFI :: TopLevelImportHeader -> TopLevel -> Decl ()
genTopLevelFFI header tfn = mkForImpCcall (hfilename <> " TopLevel_" <> fname) cfname typ
  where (fname,args,ret) =
          case tfn of
            TopLevelFunction {..} -> (fromMaybe toplevelfunc_name toplevelfunc_alias, toplevelfunc_args, toplevelfunc_ret)
            TopLevelVariable {..} -> (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
        typ =hsFFIFuncTyp Nothing (CFunSig args ret)