module FoldrBuildWW ( mkFoldrBuildWW ) where
-IMPORT_Trace
-import Outputable
-import Pretty
-import Type ( cloneTyVarFromTemplate, mkTyVarTy,
- splitTypeWithDictsAsArgs, eqTyCon, mkForallTy )
-import TysPrim ( alphaTy )
-import TyVar ( alphaTyVar )
-
-import Type ( Type(..) ) -- **** CAN SEE THE CONSTRUCTORS ****
-import UniqSupply ( runBuiltinUs )
-import WwLib -- share the same monad (is this eticit ?)
-import PrelInfo ( listTyCon, mkListTy, nilDataCon, consDataCon,
- foldrId, buildId
- )
-import Id ( getIdFBTypeInfo, mkWorkerId, getIdInfo,
- replaceIdInfo, mkSysLocal, idType
- )
-import IdInfo
-import Maybes
-import SrcLoc ( mkUnknownSrcLoc, SrcLoc )
-import Util
+IMP_Ubiq(){-uitous-}
+
+import CoreSyn ( SYN_IE(CoreBinding) )
+import UniqSupply ( UniqSupply )
+import Util ( panic{-ToDo:rm?-} )
+
+--import Type ( cloneTyVarFromTemplate, mkTyVarTy,
+-- splitFunTyExpandingDicts, eqTyCon, mkForallTy )
+--import TysPrim ( alphaTy )
+--import TyVar ( alphaTyVar )
+--
+--import Type ( SYN_IE(Type) ) -- **** CAN SEE THE CONSTRUCTORS ****
+--import UniqSupply ( runBuiltinUs )
+--import WwLib -- share the same monad (is this eticit ?)
+--import PrelInfo ( listTyCon, mkListTy, nilDataCon, consDataCon,
+-- foldrId, buildId
+-- )
+--import Id ( getIdFBTypeInfo, mkWorkerId, getIdInfo,
+-- replaceIdInfo, mkSysLocal, idType
+-- )
+--import IdInfo
+--import Maybes
+--import SrcLoc ( mkUnknownSrcLoc, SrcLoc )
+--import Util
\end{code}
\begin{code}
mkFoldrBuildWW
- :: (GlobalSwitch -> Bool)
- -> UniqSupply
+ :: UniqSupply
-> [CoreBinding]
-> [CoreBinding]
-mkFoldrBuildWW switch us top_binds =
+
+mkFoldrBuildWW = panic "mkFoldrBuildWW (ToDo)"
+
+{- LATER:
+mkFoldrBuildWW us top_binds =
(mapWw wwBind top_binds `thenWw` \ top_binds2 ->
- returnWw (concat top_binds2)) us switch
+ returnWw (concat top_binds2)) us
\end{code}
\begin{code}
wwExpr (SCC lab e) =
wwExpr e `thenWw` \ e' ->
returnWw (SCC lab e')
+wwExpr (Coerce c ty e) =
+ wwExpr e `thenWw` \ e' ->
+ returnWw (Coerce c ty e')
wwExpr (Let bnds e) =
wwExpr e `thenWw` \ e' ->
wwBind bnds `thenWw` \ bnds' ->
| FBGoodProd == prod ->
{- || any (== FBGoodConsum) consum -}
let
- (use_args,big_args,args,body) = digForLambdas expr'
+ (use_args,big_args,args,body) = collectBinders expr'
in
if length args /= length consum -- funny number of arguments
then returnWw [(id,expr')]
n_ty = alphaTy
n_ty_templ = alphaTy
- (templ,arg_tys,res) = splitTypeWithDictsAsArgs (idType id)
+ (templ,arg_tys,res) = splitFunTyExpandingDicts (idType id)
expr_ty = getListTy res
getListTy res = panic "FoldrBuildWW:getListTy:ToDo" {-LATER:case res of
UniData lty [ty] | lty `eqTyCon` listTyCon -> ty
worker_ty = mkForallTy (templ ++ [alphaTyVar])
(foldr mkFunTy n_ty_templ (arg_tys++[c_ty_templ,n_ty_templ]))
- wrapper_id = id `replaceIdInfo`
- (getIdInfo id `addInfo_UF`
- iWantToBeINLINEd UnfoldAlways)
+ wrapper_id = addInlinePragma id
worker_id = mkWorkerId worker_new_uq id worker_ty
noIdInfo
-- TODO : CHECK if mkWorkerId is thr
-- right function to use ..
-- Now the bodies
- c_id = mkSysLocal SLIT("_fbww") c_new_uq c_ty mkUnknownSrcLoc
- n_id = mkSysLocal SLIT("_fbww") n_new_uq n_ty mkUnknownSrcLoc
+ c_id = mkSysLocal SLIT("fbww") c_new_uq c_ty mkUnknownSrcLoc
+ n_id = mkSysLocal SLIT("fbww") n_new_uq n_ty mkUnknownSrcLoc
worker_rhs
= mkTyLam [] (big_args ++ [alphaTyVar]) (args++[c_id,n_id]) worker_body
else
returnWw [(worker_id,worker_rhs),(wrapper_id,wrapper_rhs)]
_ -> returnWw [(id,expr')]
+-}
\end{code}
-