drop some debugging traces and use only one flag for new codegen

diff --git a/compiler/cmm/CmmCPSZ.hs b/compiler/cmm/CmmCPSZ.hs
index 008fa5d..aac9372 100644 (file)
--- a/compiler/cmm/CmmCPSZ.hs
+++ b/compiler/cmm/CmmCPSZ.hs
@@ -47,8 +47,8 @@ protoCmmCPSZ :: HscEnv -- Compilation env including
              -> CmmZ              -- Input C-- with Procedures
              -> IO (TopSRT, [CmmZ]) -- Output CPS transformed C--
 protoCmmCPSZ hsc_env (topSRT, rst) (Cmm tops)
-  | not (dopt Opt_RunCPSZ (hsc_dflags hsc_env))
-  = return (topSRT, Cmm tops : rst)                -- Only if -frun-cps
+  | not (dopt Opt_TryNewCodeGen (hsc_dflags hsc_env))
+  = return (topSRT, Cmm tops : rst)                -- Only if -fnew-codegen
   | otherwise
   = do let dflags = hsc_dflags hsc_env
         showPass dflags "CPSZ"

diff --git a/compiler/codeGen/CgCallConv.hs b/compiler/codeGen/CgCallConv.hs
index 87c69b6..a9c591b 100644 (file)
--- a/compiler/codeGen/CgCallConv.hs
+++ b/compiler/codeGen/CgCallConv.hs
@@ -369,7 +369,7 @@ assign_regs args supply
 assign_reg :: CgRep -> AvailRegs -> Maybe (GlobalReg, AvailRegs)
 assign_reg FloatArg  (vs, f:fs, ds, ls) = Just (FloatReg f,   (vs, fs, ds, ls))
 assign_reg DoubleArg (vs, fs, d:ds, ls) = Just (DoubleReg d,  (vs, fs, ds, ls))
-assign_reg LongArg   (vs, fs, ds, l:ls) = pprTrace "longArg" (ppr l) $ Just (LongReg l,    (vs, fs, ds, ls))
+assign_reg LongArg   (vs, fs, ds, l:ls) = Just (LongReg l,    (vs, fs, ds, ls))
 assign_reg PtrArg    (v:vs, fs, ds, ls) = Just (VanillaReg v VGcPtr, (vs, fs, ds, ls))
 assign_reg NonPtrArg (v:vs, fs, ds, ls) = Just (VanillaReg v VNonGcPtr, (vs, fs, ds, ls))
     -- PtrArg and NonPtrArg both go in a vanilla register

diff --git a/compiler/codeGen/StgCmmBind.hs b/compiler/codeGen/StgCmmBind.hs
index e4960fc..b4415eb 100644 (file)
--- a/compiler/codeGen/StgCmmBind.hs
+++ b/compiler/codeGen/StgCmmBind.hs
@@ -87,8 +87,7 @@ cgTopRhsClosure id ccs _ upd_flag srt args body = do
   ; forkClosureBody (closureCodeBody True id closure_info ccs
                                      (nonVoidIds args) (length args) body fv_details)
 
-  ; pprTrace "arity for" (ppr id <+> ppr (length args) <+> ppr args) $
-    returnFC cg_id_info }
+  ; returnFC cg_id_info }
 
 ------------------------------------------------------------------------
 --             Non-top-level bindings
@@ -154,8 +153,7 @@ cgRhs name (StgRhsCon maybe_cc con args)
   = buildDynCon name maybe_cc con args
 
 cgRhs name (StgRhsClosure cc bi fvs upd_flag srt args body)
-  = pprTrace "cgRhs closure" (ppr name <+> ppr args) $
-    mkRhsClosure name cc bi (nonVoidIds fvs) upd_flag srt args body
+  = mkRhsClosure name cc bi (nonVoidIds fvs) upd_flag srt args body
 
 ------------------------------------------------------------------------
 --             Non-constructor right hand sides
@@ -421,7 +419,7 @@ bind_fv (id, off) = do { reg <- rebindToReg id; return (reg, off) }
 
 load_fvs :: LocalReg -> LambdaFormInfo -> [(LocalReg, WordOff)] -> FCode ()
 load_fvs node lf_info = mapCs (\ (reg, off) ->
-      pprTrace "get tag for" (ppr reg <+> ppr tag) $ emit $ mkTaggedObjectLoad reg node off tag)
+      emit $ mkTaggedObjectLoad reg node off tag)
   where tag = lfDynTag lf_info
 
 -----------------------------------------

diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs
index 81656fc..7e8f02c 100644 (file)
--- a/compiler/codeGen/StgCmmClosure.hs
+++ b/compiler/codeGen/StgCmmClosure.hs
@@ -337,8 +337,8 @@ tagForArity arity | isSmallFamily arity = arity
 lfDynTag :: LambdaFormInfo -> DynTag
 -- Return the tag in the low order bits of a variable bound
 -- to this LambdaForm
-lfDynTag (LFCon con)               = pprTrace "tagForCon" (ppr con <+> ppr (tagForCon con)) $ tagForCon con
-lfDynTag (LFReEntrant _ arity _ _) = pprTrace "reentrant" (ppr arity) $ tagForArity arity
+lfDynTag (LFCon con)               = tagForCon con
+lfDynTag (LFReEntrant _ arity _ _) = tagForArity arity
 lfDynTag _other                    = 0
 
 
@@ -508,8 +508,7 @@ getCallMethod name caf (LFReEntrant _ arity _ _) n_args
   | n_args == 0    = ASSERT( arity /= 0 )
                     ReturnIt   -- No args at all
   | n_args < arity = SlowCall  -- Not enough args
-  | otherwise      = pprTrace "getCallMethod" (ppr name <+> ppr arity) $
-                     DirectEntry (enterIdLabel name caf) arity
+  | otherwise      = DirectEntry (enterIdLabel name caf) arity
 
 getCallMethod _name _ LFUnLifted n_args
   = ASSERT( n_args == 0 ) ReturnIt

diff --git a/compiler/codeGen/StgCmmCon.hs b/compiler/codeGen/StgCmmCon.hs
index e818bd7..beff73e 100644 (file)
--- a/compiler/codeGen/StgCmmCon.hs
+++ b/compiler/codeGen/StgCmmCon.hs
@@ -210,8 +210,7 @@ bindConArgs (DataAlt con) base args
     bind_arg :: (NonVoid Id, VirtualHpOffset) -> FCode LocalReg
     bind_arg (arg, offset) 
        = do { emit $ mkTaggedObjectLoad (idToReg arg) base offset tag
-            ; pprTrace "bind_arg gets tag" (ppr arg <+> ppr tag) $
-               bindArgToReg arg }
+            ; bindArgToReg arg }
 
 bindConArgs _other_con _base args
   = ASSERT( null args ) return []

diff --git a/compiler/codeGen/StgCmmExpr.hs b/compiler/codeGen/StgCmmExpr.hs
index 3b6aac9..47bf6c4 100644 (file)
--- a/compiler/codeGen/StgCmmExpr.hs
+++ b/compiler/codeGen/StgCmmExpr.hs
@@ -396,7 +396,7 @@ cgAltRhss gc_plan bndr alts
     cg_alt (con, bndrs, _uses, rhs)
       = getCodeR                 $
        maybeAltHeapCheck gc_plan $
-       do { pprTrace "binding args for" (ppr bndr <+> ppr con) $ bindConArgs con base_reg bndrs
+       do { bindConArgs con base_reg bndrs
           ; cgExpr rhs
           ; return con }
 

diff --git a/compiler/codeGen/StgCmmLayout.hs b/compiler/codeGen/StgCmmLayout.hs
index 74bac43..5daceed 100644 (file)
--- a/compiler/codeGen/StgCmmLayout.hs
+++ b/compiler/codeGen/StgCmmLayout.hs
@@ -472,9 +472,7 @@ emitClosureProcAndInfoTable top_lvl bndr cl_info args body
         -- top-level binding, which this binding would incorrectly shadow.
         ; node <- if top_lvl then return $ idToReg (NonVoid bndr)
                   else bindToReg (NonVoid bndr) lf_info
-        ; arg_regs <-
-            pprTrace "bindArgsToRegs" (ppr args) $
-            bindArgsToRegs args
+        ; arg_regs <- bindArgsToRegs args
         ; emitClosureAndInfoTable cl_info (node : arg_regs) $ body (node, arg_regs)
         }
 

diff --git a/compiler/codeGen/StgCmmPrim.hs b/compiler/codeGen/StgCmmPrim.hs
index 6940908..8298b68 100644 (file)
--- a/compiler/codeGen/StgCmmPrim.hs
+++ b/compiler/codeGen/StgCmmPrim.hs
@@ -82,7 +82,7 @@ cgOpApp (StgPrimOp primop) args res_ty
   | primOpOutOfLine primop
   = do { cmm_args <- getNonVoidArgAmodes args
         ; let fun = CmmLit (CmmLabel (mkRtsPrimOpLabel primop))
-        ; pprTrace "cgOpApp" (ppr primop) $ emitCall PrimOp fun cmm_args }
+        ; emitCall PrimOp fun cmm_args }
 
   | ReturnsPrim VoidRep <- result_info
   = do cgPrimOp [] primop args 

diff --git a/compiler/main/HscMain.lhs b/compiler/main/HscMain.lhs
index f054d25..fee24c6 100644 (file)
--- a/compiler/main/HscMain.lhs
+++ b/compiler/main/HscMain.lhs
@@ -673,7 +673,7 @@ hscGenHardCode cgguts mod_summary
                  then do cmms <- tryNewCodeGen hsc_env this_mod data_tycons
                                  dir_imps cost_centre_info
                                  stg_binds hpc_info
-                         pprTrace "cmms" (ppr cmms) $ return cmms
+                         return cmms
                  else {-# SCC "CodeGen" #-}
                        codeGen dflags this_mod data_tycons
                                dir_imps cost_centre_info