%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
\section[FoldrBuildWW]{Spliting suitable functions into Workers and Wrappers}
\begin{code}
-#include "HsVersions.h"
-
module FoldrBuildWW ( mkFoldrBuildWW ) where
-IMP_Ubiq(){-uitous-}
+#include "HsVersions.h"
-import CoreSyn ( SYN_IE(CoreBinding) )
+-- Just a stub for now
+import CoreSyn ( CoreBind )
import UniqSupply ( UniqSupply )
-import Util ( panic{-ToDo:rm?-} )
+import Panic ( panic )
--import Type ( cloneTyVarFromTemplate, mkTyVarTy,
-- splitFunTyExpandingDicts, eqTyCon, mkForallTy )
--import TysPrim ( alphaTy )
--import TyVar ( alphaTyVar )
--
---import Type ( SYN_IE(Type) ) -- **** CAN SEE THE CONSTRUCTORS ****
+--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
+-- mkSysLocal, idType
-- )
--import IdInfo
--import Maybes
---import SrcLoc ( mkUnknownSrcLoc, SrcLoc )
+--import SrcLoc ( noSrcLoc, SrcLoc )
--import Util
\end{code}
\begin{code}
mkFoldrBuildWW
:: UniqSupply
- -> [CoreBinding]
- -> [CoreBinding]
+ -> [CoreBind]
+ -> [CoreBind]
mkFoldrBuildWW = panic "mkFoldrBuildWW (ToDo)"
wwExpr (CoTyApp f ty) =
wwExpr f `thenWw` \ f' ->
returnWw (CoTyApp f' ty)
-wwExpr (SCC lab e) =
- wwExpr e `thenWw` \ e' ->
- returnWw (SCC lab e')
-wwExpr (Coerce c ty e) =
+wwExpr (Note note e) =
wwExpr e `thenWw` \ e' ->
- returnWw (Coerce c ty e')
+ returnWw (Note note 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) = collectBinders expr'
+ (big_args,args,body) = collectBinders expr'
in
if length args /= length consum -- funny number of arguments
then returnWw [(id,expr')]
-- f_wrk /\ t1 .. tn t_new \ v1 .. vn c n -> foldr <exprTy> <nTy> c n e
-- f /\ t1 .. tn \ v1 .. vn
-- -> build exprTy (\ c n -> f_wrk t1 .. tn t_new v1 .. vn c n)
- pprTrace "WW:" (ppr PprDebug id) (returnWw ())
+ pprTrace "WW:" (ppr id) (returnWw ())
`thenWw` \ () ->
getUniqueWw `thenWw` \ ty_new_uq ->
getUniqueWw `thenWw` \ worker_new_uq ->
worker_ty = mkForallTy (templ ++ [alphaTyVar])
(foldr mkFunTy n_ty_templ (arg_tys++[c_ty_templ,n_ty_templ]))
- wrapper_id = addInlinePragma id
+ wrapper_id = setInlinePragma id IWantToBeINLINEd
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
+ n_id = mkSysLocal SLIT("fbww") n_new_uq n_ty
worker_rhs
= mkTyLam [] (big_args ++ [alphaTyVar]) (args++[c_id,n_id]) worker_body