X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fghci%2FByteCodeGen.lhs;h=5f9fe003054988fed405aae3fc0e4c88bcd33494;hb=877e29449aff260a2cd1fedd45aa177363b11e53;hp=cad4789cf70d6a6a082ca30d46dd0a7561e9e7b0;hpb=578d1788ceaae231a036d74777356b633c0368f6;p=ghc-hetmet.git

diff --git a/ghc/compiler/ghci/ByteCodeGen.lhs b/ghc/compiler/ghci/ByteCodeGen.lhs
index cad4789..5f9fe00 100644
--- a/ghc/compiler/ghci/ByteCodeGen.lhs
+++ b/ghc/compiler/ghci/ByteCodeGen.lhs
@@ -15,7 +15,7 @@ import ByteCodeAsm	( CompiledByteCode(..), UnlinkedBCO,
 import ByteCodeLink	( lookupStaticPtr )
 
 import Outputable
-import Name		( Name, getName, mkSystemName )
+import Name		( Name, getName, mkSystemVarName )
 import Id
 import FiniteMap
 import ForeignCall	( ForeignCall(..), CCallTarget(..), CCallSpec(..) )
@@ -28,7 +28,7 @@ import PrimOp		( PrimOp(..) )
 import CoreFVs		( freeVars )
 import Type		( isUnLiftedType, splitTyConApp_maybe )
 import DataCon		( DataCon, dataConTag, fIRST_TAG, dataConTyCon, 
-                          isUnboxedTupleCon, isNullaryDataCon, dataConWorkId,
+                          isUnboxedTupleCon, isNullaryRepDataCon, dataConWorkId,
 			  dataConRepArity )
 import TyCon		( tyConFamilySize, isDataTyCon, tyConDataCons,
 			  isUnboxedTupleTyCon )
@@ -102,7 +102,7 @@ coreExprToBCOs dflags expr
 
       -- create a totally bogus name for the top-level BCO; this
       -- should be harmless, since it's never used for anything
-      let invented_name  = mkSystemName (mkPseudoUniqueE 0) FSLIT("ExprTopLevel")
+      let invented_name  = mkSystemVarName (mkPseudoUniqueE 0) FSLIT("ExprTopLevel")
           invented_id    = mkLocalId invented_name (panic "invented_id's type")
 	  
       (BcM_State final_ctr mallocd, proto_bco) 
@@ -210,7 +210,7 @@ schemeTopBind :: (Id, AnnExpr Id VarSet) -> BcM (ProtoBCO Name)
 
 schemeTopBind (id, rhs)
   | Just data_con <- isDataConWorkId_maybe id,
-    isNullaryDataCon data_con
+    isNullaryRepDataCon data_con
   = 	-- Special case for the worker of a nullary data con.
 	-- It'll look like this:	Nil = /\a -> Nil a
 	-- If we feed it into schemeR, we'll get 
@@ -391,7 +391,7 @@ schemeE d s p (AnnLet binds (_,body))
 
 
 
-schemeE d s p (AnnCase scrut bndr [(DataAlt dc, [bind1, bind2], rhs)])
+schemeE d s p (AnnCase scrut bndr _ [(DataAlt dc, [bind1, bind2], rhs)])
    | isUnboxedTupleCon dc, VoidArg <- typeCgRep (idType bind1)
 	-- Convert 
 	--	case .... of x { (# VoidArg'd-thing, a #) -> ... }
@@ -409,7 +409,7 @@ schemeE d s p (AnnCase scrut bndr [(DataAlt dc, [bind1, bind2], rhs)])
    = --trace "automagic mashing of case alts (# a, VoidArg #)" $
      doCase d s p scrut bind1 [(DEFAULT, [], rhs)] True{-unboxed tuple-}
 
-schemeE d s p (AnnCase scrut bndr [(DataAlt dc, [bind1], rhs)])
+schemeE d s p (AnnCase scrut bndr _ [(DataAlt dc, [bind1], rhs)])
    | isUnboxedTupleCon dc
 	-- Similarly, convert
 	--	case .... of x { (# a #) -> ... }
@@ -418,7 +418,7 @@ schemeE d s p (AnnCase scrut bndr [(DataAlt dc, [bind1], rhs)])
    = --trace "automagic mashing of case alts (# a #)"  $
      doCase d s p scrut bind1 [(DEFAULT, [], rhs)] True{-unboxed tuple-}
 
-schemeE d s p (AnnCase scrut bndr alts)
+schemeE d s p (AnnCase scrut bndr _ alts)
    = doCase d s p scrut bndr alts False{-not an unboxed tuple-}
 
 schemeE d s p (AnnNote note (_, body))
@@ -541,7 +541,7 @@ mkConAppCode :: Int -> Sequel -> BCEnv
 	     -> BcM BCInstrList
 
 mkConAppCode orig_d s p con []	-- Nullary constructor
-  = ASSERT( isNullaryDataCon con )
+  = ASSERT( isNullaryRepDataCon con )
     returnBc (unitOL (PUSH_G (getName (dataConWorkId con))))
 	-- Instead of doing a PACK, which would allocate a fresh
 	-- copy of this constructor, use the single shared version.
@@ -591,9 +591,9 @@ doTailCall init_d s p fn args
   = do_pushes init_d args (map atomRep args)
   where
   do_pushes d [] reps = do
-	ASSERTM( null reps )
+	ASSERT( null reps ) return ()
         (push_fn, sz) <- pushAtom d p (AnnVar fn)
-	ASSERTM( sz == 1 )
+	ASSERT( sz == 1 ) return ()
 	returnBc (push_fn `appOL` (
 		  mkSLIDE ((d-init_d) + 1) (init_d - s) `appOL`
 		  unitOL ENTER))
@@ -612,8 +612,6 @@ doTailCall init_d s p fn args
     return (final_d, push_code `appOL` more_push_code)
 
 -- v. similar to CgStackery.findMatch, ToDo: merge
-findPushSeq (PtrArg: PtrArg: PtrArg: PtrArg: PtrArg: PtrArg: PtrArg: rest)
-  = (PUSH_APPLY_PPPPPPP, 7, rest)
 findPushSeq (PtrArg: PtrArg: PtrArg: PtrArg: PtrArg: PtrArg: rest)
   = (PUSH_APPLY_PPPPPP, 6, rest)
 findPushSeq (PtrArg: PtrArg: PtrArg: PtrArg: PtrArg: rest)