X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FstgSyn%2FCoreToStg.lhs;h=61e67df57c1e923a30e7bf7e70df79572ae4a031;hb=79d7a7c0d17b51dfb2bb06d758b6e556550862ba;hp=8fdc00398f0afd7774b9a1cf23f3e8ef03c71fcf;hpb=1aeeeaf808e13a81bc79e3e0e26cbe11ff2196bd;p=ghc-hetmet.git

diff --git a/ghc/compiler/stgSyn/CoreToStg.lhs b/ghc/compiler/stgSyn/CoreToStg.lhs
index 8fdc003..61e67df 100644
--- a/ghc/compiler/stgSyn/CoreToStg.lhs
+++ b/ghc/compiler/stgSyn/CoreToStg.lhs
@@ -18,8 +18,8 @@ import StgSyn
 import Type
 import TyCon		( isAlgTyCon )
 import Id
-import Var		( Var, globalIdDetails, varType )
-import TyCon		( isUnboxedTupleTyCon, isPrimTyCon, isFunTyCon )
+import Var		( Var, globalIdDetails, idType )
+import TyCon		( isUnboxedTupleTyCon, isPrimTyCon, isFunTyCon, isHiBootTyCon )
 #ifdef ILX
 import MkId		( unsafeCoerceId )
 #endif
@@ -330,7 +330,8 @@ coreToStgExpr (Note other_note expr)
 
 -- Cases require a little more real work.
 
-coreToStgExpr (Case scrut bndr alts)
+-- gaw 2004
+coreToStgExpr (Case scrut bndr _ alts)
   = extendVarEnvLne [(bndr, LambdaBound)]	(
 	 mapAndUnzip3Lne vars_alt alts	`thenLne` \ (alts2, fvs_s, escs_s) ->
 	 returnLne ( alts2,
@@ -411,7 +412,8 @@ mkStgAltType scrut_ty
   = case splitTyConApp_maybe (repType scrut_ty) of
 	Just (tc,_) | isUnboxedTupleTyCon tc -> UbxTupAlt tc
 		    | isPrimTyCon tc	     -> PrimAlt tc
-		    | isAlgTyCon tc	     -> AlgAlt tc
+		    | isHiBootTyCon tc	     -> PolyAlt	-- Algebraic, but no constructors visible
+		    | isAlgTyCon tc 	     -> AlgAlt tc
 		    | isFunTyCon tc	     -> PolyAlt
 		    | otherwise		     -> pprPanic "mkStgAlts" (ppr tc)
 	Nothing				     -> PolyAlt
@@ -445,7 +447,7 @@ coreToStgApp maybe_thunk_body f args
             -- Here the free variables are "f", "x" AND the type variable "a"
             -- coreToStgArgs will deal with the arguments recursively
             if opt_RuntimeTypes then
-	      fvs `unionFVInfo` tyvarFVInfo (tyVarsOfType (varType f))
+	      fvs `unionFVInfo` tyvarFVInfo (tyVarsOfType (idType f))
 	    else fvs
 
 	-- Mostly, the arity info of a function is in the fn's IdInfo
@@ -860,15 +862,7 @@ thenLne :: LneM a -> (a -> LneM b) -> LneM b
 thenLne m k env lvs_cont 
   = k (m env lvs_cont) env lvs_cont
 
-mapLne  :: (a -> LneM b)   -> [a] -> LneM [b]
-mapLne f [] = returnLne []
-mapLne f (x:xs)
-  = f x		`thenLne` \ r  ->
-    mapLne f xs	`thenLne` \ rs ->
-    returnLne (r:rs)
-
 mapAndUnzipLne  :: (a -> LneM (b,c))   -> [a] -> LneM ([b],[c])
-
 mapAndUnzipLne f [] = returnLne ([],[])
 mapAndUnzipLne f (x:xs)
   = f x		    	`thenLne` \ (r1,  r2)  ->
@@ -876,7 +870,6 @@ mapAndUnzipLne f (x:xs)
     returnLne (r1:rs1, r2:rs2)
 
 mapAndUnzip3Lne :: (a -> LneM (b,c,d)) -> [a] -> LneM ([b],[c],[d])
-
 mapAndUnzip3Lne f []	= returnLne ([],[],[])
 mapAndUnzip3Lne f (x:xs)
   = f x		    	 `thenLne` \ (r1,  r2,  r3)  ->
@@ -884,7 +877,6 @@ mapAndUnzip3Lne f (x:xs)
     returnLne (r1:rs1, r2:rs2, r3:rs3)
 
 mapAndUnzip4Lne :: (a -> LneM (b,c,d,e)) -> [a] -> LneM ([b],[c],[d],[e])
-
 mapAndUnzip4Lne f []	= returnLne ([],[],[],[])
 mapAndUnzip4Lne f (x:xs)
   = f x		    	 `thenLne` \ (r1,  r2,  r3, r4)  ->
@@ -1030,12 +1022,12 @@ lookupFVInfo fvs id
 			Just (_,_,info) -> info
 
 allFreeIds :: FreeVarsInfo -> [(Id,HowBound)]	-- Both top level and non-top-level Ids
-allFreeIds fvs = [(id,how_bound) | (id,how_bound,_) <- rngVarEnv fvs, isId id]
+allFreeIds fvs = [(id,how_bound) | (id,how_bound,_) <- varEnvElts fvs, isId id]
 
 -- Non-top-level things only, both type variables and ids
 -- (type variables only if opt_RuntimeTypes)
 getFVs :: FreeVarsInfo -> [Var]	
-getFVs fvs = [id | (id, how_bound, _) <- rngVarEnv fvs, 
+getFVs fvs = [id | (id, how_bound, _) <- varEnvElts fvs, 
 		    not (topLevelBound how_bound) ]
 
 getFVSet :: FreeVarsInfo -> VarSet