X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FsimplCore%2FFoldrBuildWW.lhs;h=f7fc93390646c67f888ec85ee09ee4705559c6e7;hb=e00e72df666d771c089f1615f66f6257e44c9da1;hp=a3a8a6ab549dee836a82cf78c4f45e5025a31f95;hpb=6c381e873e222417d9a67aeec77b9555eca7b7a8;p=ghc-hetmet.git

diff --git a/ghc/compiler/simplCore/FoldrBuildWW.lhs b/ghc/compiler/simplCore/FoldrBuildWW.lhs
index a3a8a6a..f7fc933 100644
--- a/ghc/compiler/simplCore/FoldrBuildWW.lhs
+++ b/ghc/compiler/simplCore/FoldrBuildWW.lhs
@@ -8,38 +8,44 @@
 
 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		( noSrcLoc, 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}
@@ -71,6 +77,9 @@ wwExpr   (CoTyApp f ty) =
 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' ->
@@ -108,7 +117,7 @@ try_split_bind id expr =
 	|  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')]
@@ -129,7 +138,7 @@ try_split_bind 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
@@ -140,17 +149,15 @@ try_split_bind id expr =
 
 	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 noSrcLoc
+	n_id = mkSysLocal SLIT("fbww") n_new_uq n_ty noSrcLoc
 	worker_rhs
 	  = mkTyLam [] (big_args ++ [alphaTyVar]) (args++[c_id,n_id]) worker_body
 			
@@ -176,5 +183,5 @@ try_split_bind id expr =
 	else
 	returnWw  [(worker_id,worker_rhs),(wrapper_id,wrapper_rhs)]
     _ -> returnWw [(id,expr')]
+-}
 \end{code}
-