X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FstgSyn%2FStgSyn.lhs;h=bac7e8a57c0fecbf21fdcf4d2f414a4c247d41a9;hb=26741ec416bae2c502ef00a2ba0e79050a32cb67;hp=456a7f8e56e47d9deb239432eadb05b445bc0549;hpb=6c381e873e222417d9a67aeec77b9555eca7b7a8;p=ghc-hetmet.git

diff --git a/ghc/compiler/stgSyn/StgSyn.lhs b/ghc/compiler/stgSyn/StgSyn.lhs
index 456a7f8..bac7e8a 100644
--- a/ghc/compiler/stgSyn/StgSyn.lhs
+++ b/ghc/compiler/stgSyn/StgSyn.lhs
@@ -13,7 +13,7 @@ suited to spineless tagless code generation.
 
 module StgSyn (
 	GenStgArg(..),
-	GenStgLiveVars(..),
+	SYN_IE(GenStgLiveVars),
 
 	GenStgBinding(..), GenStgExpr(..), GenStgRhs(..),
 	GenStgCaseAlts(..), GenStgCaseDefault(..),
@@ -26,42 +26,33 @@ module StgSyn (
 	combineStgBinderInfo,
 
 	-- a set of synonyms for the most common (only :-) parameterisation
-	StgArg(..), StgLiveVars(..),
-	StgBinding(..), StgExpr(..), StgRhs(..),
-	StgCaseAlts(..), StgCaseDefault(..),
+	SYN_IE(StgArg), SYN_IE(StgLiveVars),
+	SYN_IE(StgBinding), SYN_IE(StgExpr), SYN_IE(StgRhs),
+	SYN_IE(StgCaseAlts), SYN_IE(StgCaseDefault),
 
 	pprPlainStgBinding,
 	getArgPrimRep,
 	isLitLitArg,
 	stgArity,
-	collectExportedStgBinders
-
-	-- and to make the interface self-sufficient...
+	collectFinalStgBinders
     ) where
 
-import Ubiq{-uitous-}
+IMP_Ubiq(){-uitous-}
 
-{-
-import PrelInfo		( getPrimOpResultInfo, PrimOpResultInfo(..),
-			  PrimOp, PrimRep
-			  IF_ATTACK_PRAGMAS(COMMA tagOf_PrimOp)
-			  IF_ATTACK_PRAGMAS(COMMA pprPrimOp)
-			)
-import HsSyn		( HsBinds, HsExpr, GRHS, GRHSsAndBinds, InPat )
-import Type
-import Literal		( literalPrimRep, isLitLitLit,
-			  Literal(..) -- (..) for pragmas
+import CostCentre	( showCostCentre )
+import Id		( externallyVisibleId, idPrimRep, GenId{-instance NamedThing-} )
+import Literal		( literalPrimRep, isLitLitLit, Literal{-instance Outputable-} )
+import Name		( isSymLexeme )
+import Outputable	( ifPprDebug, interppSP, interpp'SP,
+			  Outputable(..){-instance * Bool-}
 			)
-import Id		( idType, getIdPrimRep, toplevelishId,
-			  isTopLevId, Id, IdInfo
-			)
-import Maybes		( Maybe(..), catMaybes )
-import Outputable
-import Pretty
-import CostCentre	( showCostCentre, CostCentre )
-import UniqSet
-import Util
--}
+import PprStyle		( PprStyle(..) )
+import PprType		( GenType{-instance Outputable-} )
+import Pretty		-- all of it
+import PrimOp		( PrimOp{-instance Outputable-} )
+import Unique		( pprUnique )
+import UniqSet		( isEmptyUniqSet, uniqSetToList, SYN_IE(UniqSet) )
+import Util		( panic )
 \end{code}
 
 %************************************************************************
@@ -79,6 +70,7 @@ with respect to binder and occurrence information (just as in
 data GenStgBinding bndr occ
   = StgNonRec	bndr (GenStgRhs bndr occ)
   | StgRec	[(bndr, GenStgRhs bndr occ)]
+  | StgCoerceBinding bndr occ
 \end{code}
 
 %************************************************************************
@@ -94,8 +86,8 @@ data GenStgArg occ
 \end{code}
 
 \begin{code}
-getArgPrimRep (StgVarArg  local) = getIdPrimRep local
-getArgPrimRep (StgLitArg  lit)	= literalPrimRep lit
+getArgPrimRep (StgVarArg  local) = idPrimRep local
+getArgPrimRep (StgLitArg  lit)	 = literalPrimRep lit
 
 isLitLitArg (StgLitArg x) = isLitLitLit x
 isLitLitArg _		  = False
@@ -484,17 +476,17 @@ final pre-codegen STG code, so as to be sure we have the
 latest/greatest pragma info.
 
 \begin{code}
-collectExportedStgBinders
+collectFinalStgBinders
 	:: [StgBinding]	-- input program
-	-> [Id]			-- exported top-level Ids
+	-> [Id]		-- final externally-visible top-level Ids
 
-collectExportedStgBinders binds
+collectFinalStgBinders binds
   = ex [] binds
   where
     ex es [] = es
 
     ex es ((StgNonRec b _) : binds)
-      = if not (isExported b) then
+      = if not (externallyVisibleId b) then
 	    ex es binds
 	else
 	    ex (b:es) binds
@@ -523,6 +515,10 @@ pprStgBinding sty (StgNonRec bndr rhs)
   = ppHang (ppCat [ppr sty bndr, ppEquals])
     	 4 (ppBeside (ppr sty rhs) ppSemi)
 
+pprStgBinding sty (StgCoerceBinding bndr occ)
+  = ppHang (ppCat [ppr sty bndr, ppEquals, ppStr "{-Coerce-}"])
+    	 4 (ppBeside (ppr sty occ) ppSemi)
+
 pprStgBinding sty (StgRec pairs)
   = ppAboves ((ifPprDebug sty (ppStr "{- StgRec -}")) :
 	      (map (ppr_bind sty) pairs))
@@ -659,7 +655,7 @@ pprStgExpr sty (StgCase expr lvs_whole lvs_rhss uniq alts)
 		   4 (ppBeside (ppr sty expr) ppSemi)
 	  where
 	    ppr_con sty con
-	      = if isOpLexeme con
+	      = if isSymLexeme con
 		then ppBesides [ppLparen, ppr sty con, ppRparen]
 		else ppr sty con
 
@@ -710,7 +706,7 @@ pprStgRhs sty (StgRhsClosure cc bi free_vars upd_flag args body)
 
 pprStgRhs sty (StgRhsCon cc con args)
   = ppBesides [ ppStr (showCostCentre sty True{-as String-} cc),
-		ppSP, ppr sty con, ppStr " [", interppSP sty args, ppStr "]" ]
+		ppSP, ppr sty con, ppStr "! [", interppSP sty args, ppStr "]" ]
 
 --------------
 pp_binder_info PprForUser _ = ppNil