remove old functionSignature..

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

@@ -24,7 +24,7 @@ import qualified Data.List as L (foldr1)
 import FFICXX.Generate.Code.Primitive
   ( accessorSignature,
     cxx2HsType,
-    functionSignature',
+    functionSignature,
     functionSignatureTMF,
     hsFuncXformer,
   )
@@ -132,21 +132,21 @@ genHsFrontInstNew c = do
         -- cann = maybe "" id $ M.lookup (PkgMethod, constructorName c) amap
         -- newfuncann = mkComment 0 cann
         rhs = app (mkVar (hsFuncXformer f)) (mkVar (hscFuncName c f))
-     in mkFun_ (aliasedFuncName c f) (functionSignature' c f) [] rhs
+     in mkFun_ (aliasedFuncName c f) (functionSignature c f) [] rhs
 
 genHsFrontInstNonVirtual :: Class -> [HsDecl GhcPs]
 genHsFrontInstNonVirtual c =
   flip concatMap nonvirtualFuncs $ \f ->
     let rhs = app (mkVar (hsFuncXformer f)) (mkVar (hscFuncName c f))
-     in mkFun_ (aliasedFuncName c f) (functionSignature' c f) [] rhs
+     in mkFun_ (aliasedFuncName c f) (functionSignature c f) [] rhs
   where
     nonvirtualFuncs = nonVirtualNotNewFuncs (class_funcs c)
 
 genHsFrontInstStatic :: Class -> [HsDecl GhcPs]
 genHsFrontInstStatic c =
   flip concatMap (staticFuncs (class_funcs c)) $ \f ->
     let rhs = app (mkVar (hsFuncXformer f)) (mkVar (hscFuncName c f))
-     in mkFun_ (aliasedFuncName c f) (functionSignature' c f) [] rhs
+     in mkFun_ (aliasedFuncName c f) (functionSignature c f) [] rhs
 
 genHsFrontInstVariables :: Class -> [HsDecl GhcPs]
 genHsFrontInstVariables c =

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

@@ -21,7 +21,7 @@ import qualified Data.List as L
 import qualified Data.List.NonEmpty as NE
 import FFICXX.Generate.Code.Primitive
   ( classConstraints,
-    functionSignature',
+    functionSignature,
   )
 import FFICXX.Generate.Dependency.Graph
   ( getCyclicDepSubmodules,
@@ -111,7 +111,7 @@ genHsFrontDecl isHsBoot c = do
   let cdecl = TyClD noExtField (mkClass (classConstraints c) (typeclassName c) [mkTBind "a"] body)
       -- for hs-boot, we only have instance head.
       cdecl' = TyClD noExtField (mkClass (cxTuple []) (typeclassName c) [mkTBind "a"] [])
-      sigdecl f = mkFunSig (hsFuncName c f) (functionSignature' c f)
+      sigdecl f = mkFunSig (hsFuncName c f) (functionSignature c f)
       body = map sigdecl . virtualFuncs . class_funcs $ c
   if isHsBoot
     then return cdecl'

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

@@ -15,7 +15,7 @@ import FFICXX.Generate.Code.Cpp
     genTmplVarCpp,
   )
 import FFICXX.Generate.Code.Primitive
-  ( functionSignatureTT',
+  ( functionSignatureTT,
     tmplAccessorToTFun,
   )
 import FFICXX.Generate.Dependency (calculateDependency)
@@ -115,7 +115,7 @@ genTmplImplementation t =
           app (v "mkTFunc") $
             let typs = if nparams == 1 then map v tvars else [tupleE (map v tvars)]
              in tupleE (typs ++ [v "suffix", lam, v "tyf"])
-        sig' = functionSignatureTT' t f
+        sig' = functionSignatureTT t f
         tassgns =
           fmap
             (\(i, tp) -> pbind_ (p tp) (v "pure" `app` (v ("typ" ++ show i))))

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

@@ -9,7 +9,7 @@ where
 
 import FFICXX.Generate.Code.HsCast (castBody)
 import FFICXX.Generate.Code.Primitive
-  ( functionSignatureT',
+  ( functionSignatureT,
     tmplAccessorToTFun,
   )
 import FFICXX.Generate.Dependency (calculateDependency)
@@ -84,7 +84,7 @@ genTmplInterface t =
     vfs = tclass_vars t
     rawtype = foldl1 tyapp (tycon rname : map mkTVar tps)
     hightype = foldl1 tyapp (tycon hname : map mkTVar tps)
-    sigdecl f = mkFunSig (hsTmplFuncName t f) (functionSignatureT' t f)
+    sigdecl f = mkFunSig (hsTmplFuncName t f) (functionSignatureT t f)
     sigdeclV vf =
       let f_g = tmplAccessorToTFun vf Getter
           f_s = tmplAccessorToTFun vf Setter

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

@@ -1054,24 +1054,8 @@ extractArgRetTypes' mc isvirtual (CFunSig args ret) =
         Void -> pure Ex.unit_tycon
         _ -> error ("No such c type : " <> show typ)
 
--- OLD
-functionSignature :: Class -> Function -> Type ()
+functionSignature :: Class -> Function -> HsType GhcPs
 functionSignature c f =
-  let HsFunSig typs assts =
-        extractArgRetTypes
-          (Just c)
-          (isVirtualFunc f)
-          (CFunSig (genericFuncArgs f) (genericFuncRet f))
-      ctxt = cxTuple assts
-      arg0
-        | isVirtualFunc f = (mkTVar "a" :)
-        | isNonVirtualFunc f = (mkTVar (fst (hsClassName c)) :)
-        | otherwise = id
-   in tyForall Nothing (Just ctxt) (foldr1 tyfun (arg0 typs))
-
--- NEW
-functionSignature' :: Class -> Function -> HsType GhcPs
-functionSignature' c f =
   let HsFunSig' typs assts =
         extractArgRetTypes'
           (Just c)
@@ -1084,73 +1068,31 @@ functionSignature' c f =
         | otherwise = id
    in Ex.qualTy ctxt (foldr1 Ex.tyfun (arg0 typs))
 
--- OLD
-functionSignatureT :: TemplateClass -> TemplateFunction -> Type ()
-functionSignatureT t TFun {..} =
-  let (hname, _) = hsTemplateClassName t
-      slf = foldl1 tyapp (tycon hname : map mkTVar (tclass_params t))
-      ctyp = convertCpp2HS Nothing tfun_ret
-      lst = slf : map (convertCpp2HS Nothing . arg_type) tfun_args
-   in foldr1 tyfun (lst <> [tyapp (tycon "IO") ctyp])
-functionSignatureT t TFunNew {..} =
-  let ctyp = convertCpp2HS Nothing (TemplateType t)
-      lst = map (convertCpp2HS Nothing . arg_type) tfun_new_args
-   in foldr1 tyfun (lst <> [tyapp (tycon "IO") ctyp])
-functionSignatureT t TFunDelete =
-  let ctyp = convertCpp2HS Nothing (TemplateType t)
-   in ctyp `tyfun` (tyapp (tycon "IO") unit_tycon)
-functionSignatureT t TFunOp {..} =
-  let (hname, _) = hsTemplateClassName t
-      slf = foldl1 tyapp (tycon hname : map mkTVar (tclass_params t))
-      ctyp = convertCpp2HS Nothing tfun_ret
-      lst = slf : map (convertCpp2HS Nothing . arg_type) (argsFromOpExp tfun_opexp)
-   in foldr1 tyfun (lst <> [tyapp (tycon "IO") ctyp])
-
 -- NEW
-functionSignatureT' :: TemplateClass -> TemplateFunction -> HsType GhcPs
-functionSignatureT' t TFun {..} =
+functionSignatureT :: TemplateClass -> TemplateFunction -> HsType GhcPs
+functionSignatureT t TFun {..} =
   let (hname, _) = hsTemplateClassName t
       slf = foldl1 Ex.tyapp (Ex.tycon hname : map Ex.mkTVar (tclass_params t))
       ctyp = cxx2HsType Nothing tfun_ret
       lst = slf : map (cxx2HsType Nothing . arg_type) tfun_args
    in foldr1 Ex.tyfun (lst <> [Ex.tyapp (Ex.tycon "IO") (Ex.tyParen ctyp)])
-functionSignatureT' t TFunNew {..} =
+functionSignatureT t TFunNew {..} =
   let ctyp = cxx2HsType Nothing (TemplateType t)
       lst = map (cxx2HsType Nothing . arg_type) tfun_new_args
    in foldr1 Ex.tyfun (lst <> [Ex.tyapp (Ex.tycon "IO") (Ex.tyParen ctyp)])
-functionSignatureT' t TFunDelete =
+functionSignatureT t TFunDelete =
   let ctyp = cxx2HsType Nothing (TemplateType t)
    in ctyp `Ex.tyfun` (Ex.tyapp (Ex.tycon "IO") Ex.unit_tycon)
-functionSignatureT' t TFunOp {..} =
+functionSignatureT t TFunOp {..} =
   let (hname, _) = hsTemplateClassName t
       slf = foldl1 Ex.tyapp (Ex.tycon hname : fmap Ex.mkTVar (tclass_params t))
       ctyp = cxx2HsType Nothing tfun_ret
       lst = slf : map (cxx2HsType Nothing . arg_type) (argsFromOpExp tfun_opexp)
    in foldr1 Ex.tyfun (lst <> [Ex.tyapp (Ex.tycon "IO") (Ex.tyParen ctyp)])
 
 -- TODO: rename this and combine this with functionSignatureTMF
--- OLD
-functionSignatureTT :: TemplateClass -> TemplateFunction -> Type ()
-functionSignatureTT t f = foldr1 tyfun (lst <> [tyapp (tycon "IO") ctyp])
-  where
-    (hname, _) = hsTemplateClassName t
-    ctyp = case f of
-      TFun {..} -> convertCpp2HS4Tmpl e Nothing spls tfun_ret
-      TFunNew {} -> convertCpp2HS4Tmpl e Nothing spls (TemplateType t)
-      TFunDelete -> unit_tycon
-      TFunOp {..} -> convertCpp2HS4Tmpl e Nothing spls tfun_ret
-    e = foldl1 tyapp (tycon hname : spls)
-    spls = map (tySplice . parenSplice . mkVar) $ tclass_params t
-    lst =
-      case f of
-        TFun {..} -> e : map (convertCpp2HS4Tmpl e Nothing spls . arg_type) tfun_args
-        TFunNew {..} -> map (convertCpp2HS4Tmpl e Nothing spls . arg_type) tfun_new_args
-        TFunDelete -> [e]
-        TFunOp {..} -> e : map (convertCpp2HS4Tmpl e Nothing spls . arg_type) (argsFromOpExp tfun_opexp)
-
--- NEW
-functionSignatureTT' :: TemplateClass -> TemplateFunction -> HsType GhcPs
-functionSignatureTT' t f = foldr1 Ex.tyfun (lst <> [Ex.tyapp (Ex.tycon "IO") (Ex.tyParen ctyp)])
+functionSignatureTT :: TemplateClass -> TemplateFunction -> HsType GhcPs
+functionSignatureTT t f = foldr1 Ex.tyfun (lst <> [Ex.tyapp (Ex.tycon "IO") (Ex.tyParen ctyp)])
   where
     (hname, _) = hsTemplateClassName t
     ctyp = case f of
@@ -1168,7 +1110,6 @@ functionSignatureTT' t f = foldr1 Ex.tyfun (lst <> [Ex.tyapp (Ex.tycon "IO") (Ex
         TFunOp {..} -> e : map (cxx2HsType4Tmpl e Nothing spls . arg_type) (argsFromOpExp tfun_opexp)
 
 -- TODO: rename this and combine this with functionSignatureTT
--- NEW
 functionSignatureTMF :: Class -> TemplateMemberFunction -> HsType GhcPs
 functionSignatureTMF c f =
   foldr1 Ex.tyfun (lst <> [Ex.tyapp (Ex.tycon "IO") ctyp])