diff --git a/ghc/compiler/Makefile b/ghc/compiler/Makefile
index 3623c964c85b41f147c53be251a48ed860e2f2e3..3b745ad7370c568ea0b6efd9f31137b55924fb57 100644
--- a/ghc/compiler/Makefile
+++ b/ghc/compiler/Makefile
@@ -44,10 +44,6 @@ DIRS = \
   reader profiling parser
 
 
-ifeq ($(GhcWithDeforester),YES)
-  DIRS += deforest
-endif
-
 ifeq ($(GhcWithNativeCodeGen),YES)
 DIRS += nativeGen
 else
@@ -145,13 +141,6 @@ else
 SRC_HC_OPTS += -recomp
 endif
 
-ifeq ($(GhcWithDeforester),NO)
- ifeq "$(Ghc2_0)" "NO"
-  SRC_MKDEPENDHS_OPTS += -DOMIT_DEFORESTER
- endif
-SRC_HC_OPTS += -DOMIT_DEFORESTER
-endif
-
 SRC_HC_OPTS += $(GhcHcOpts)
 
 # 	Special flags for particular modules
diff --git a/ghc/compiler/basicTypes/Id.lhs b/ghc/compiler/basicTypes/Id.lhs
index 49c76ccc1e8b7289ede930fbcb89f61c36e4ffd2..1e72ae4319805fdb48edf2ba18852a531a5fbeae 100644
--- a/ghc/compiler/basicTypes/Id.lhs
+++ b/ghc/compiler/basicTypes/Id.lhs
@@ -98,7 +98,6 @@ module Id (
 	addIdDemandInfo,
 	addIdStrictness,
 	addIdUpdateInfo,
-	addIdDeforestInfo,
 	getIdArity,
 	getIdDemandInfo,
 	getIdInfo,
@@ -845,18 +844,6 @@ addIdArity (Id u n ty details pinfo info) arity
   = Id u n ty details pinfo (info `addArityInfo` arity)
 \end{code}
 
-%************************************************************************
-%*									*
-\subsection[Id-arities]{Deforestation related functions}
-%*									*
-%************************************************************************
-
-\begin{code}
-addIdDeforestInfo :: Id -> DeforestInfo -> Id
-addIdDeforestInfo (Id u n ty details pinfo info) def_info
-  = Id u n ty details pinfo (info `addDeforestInfo` def_info)
-\end{code}
-
 %************************************************************************
 %*									*
 \subsection[constructor-funs]{@DataCon@-related functions (incl.~tuples)}
diff --git a/ghc/compiler/basicTypes/IdInfo.lhs b/ghc/compiler/basicTypes/IdInfo.lhs
index 2843e29ded18e20a2ff42656ed7a91b1b3655f6e..b9e81f9d6c2c34d56379bc55be9f3e4bcbe44472 100644
--- a/ghc/compiler/basicTypes/IdInfo.lhs
+++ b/ghc/compiler/basicTypes/IdInfo.lhs
@@ -37,9 +37,6 @@ module IdInfo (
 	UpdateInfo, SYN_IE(UpdateSpec),
 	mkUpdateInfo, updateInfo, updateInfoMaybe, ppUpdateInfo, addUpdateInfo,
 
-	DeforestInfo(..),
-	deforestInfo, ppDeforestInfo, addDeforestInfo,
-
 	ArgUsageInfo, ArgUsage(..), SYN_IE(ArgUsageType),
 	mkArgUsageInfo, argUsageInfo, addArgUsageInfo, getArgUsage,
 
@@ -109,9 +106,6 @@ data IdInfo
 
 	UpdateInfo		-- Which args should be updated
 
-	DeforestInfo            -- Whether its definition should be
-				-- unfolded during deforestation
-
 	ArgUsageInfo		-- how this Id uses its arguments
 
 	FBTypeInfo		-- the Foldr/Build W/W property of this function.
@@ -119,7 +113,7 @@ data IdInfo
 
 \begin{code}
 noIdInfo = IdInfo UnknownArity UnknownDemand nullSpecEnv NoStrictnessInfo noUnfolding
-		  NoUpdateInfo Don'tDeforest NoArgUsageInfo NoFBTypeInfo 
+		  NoUpdateInfo NoArgUsageInfo NoFBTypeInfo 
 \end{code}
 
 Simply turgid.  But BE CAREFUL: don't @apply_to_Id@ if that @Id@
@@ -127,7 +121,7 @@ will in turn @apply_to_IdInfo@ of the self-same @IdInfo@.  (A very
 nasty loop, friends...)
 \begin{code}
 apply_to_IdInfo ty_fn idinfo@(IdInfo arity demand spec strictness unfold
-			      update deforest arg_usage fb_ww)
+			      update arg_usage fb_ww)
   | isNullSpecEnv spec
   = idinfo
   | otherwise
@@ -137,7 +131,7 @@ apply_to_IdInfo ty_fn idinfo@(IdInfo arity demand spec strictness unfold
 Variant of the same thing for the typechecker.
 \begin{code}
 applySubstToIdInfo s0 (IdInfo arity demand spec strictness unfold
-			      update deforest arg_usage fb_ww)
+			      update arg_usage fb_ww)
   = panic "IdInfo:applySubstToIdInfo"
 \end{code}
 
@@ -148,12 +142,11 @@ ppIdInfo :: PprStyle
 	 -> Doc
 
 ppIdInfo sty specs_please
-    	 (IdInfo arity demand specenv strictness unfold update deforest arg_usage fbtype)
+    	 (IdInfo arity demand specenv strictness unfold update arg_usage fbtype)
   = hsep [
 		    -- order is important!:
 		    ppArityInfo sty arity,
 		    ppUpdateInfo sty update,
-		    ppDeforestInfo sty deforest,
 
 		    ppStrictnessInfo sty strictness,
 
@@ -186,9 +179,9 @@ exactArity   = ArityExactly
 atLeastArity = ArityAtLeast
 unknownArity = UnknownArity
 
-arityInfo (IdInfo arity _ _ _ _ _ _ _ _) = arity
+arityInfo (IdInfo arity _ _ _ _ _ _ _) = arity
 
-addArityInfo (IdInfo _ a c d e f g h i) arity	     = IdInfo arity a c d e f g h i
+addArityInfo (IdInfo _ a b c d e f g) arity	     = IdInfo arity a b c d e f g
 
 ppArityInfo sty UnknownArity	     = empty
 ppArityInfo sty (ArityExactly arity) = hsep [ptext SLIT("_A_"), int arity]
@@ -226,9 +219,9 @@ willBeDemanded _		      = False
 \end{code}
 
 \begin{code}
-demandInfo (IdInfo _ demand _ _ _ _ _ _ _) = demand
+demandInfo (IdInfo _ demand _ _ _ _ _ _) = demand
 
-addDemandInfo (IdInfo a _ c d e f g h i) demand = IdInfo a demand c d e f g h i
+addDemandInfo (IdInfo a _ c d e f g h) demand = IdInfo a demand c d e f g h
 
 ppDemandInfo PprInterface _	      = empty
 ppDemandInfo sty UnknownDemand	      = text "{-# L #-}"
@@ -244,10 +237,10 @@ ppDemandInfo sty (DemandedAsPer info) = hsep [text "{-#", text (showList [info]
 See SpecEnv.lhs
 
 \begin{code}
-specInfo (IdInfo _ _ spec _ _ _ _ _ _) = spec
+specInfo (IdInfo _ _ spec _ _ _ _ _) = spec
 
 addSpecInfo id_info spec | isNullSpecEnv spec = id_info
-addSpecInfo (IdInfo a b _ d e f g h i) spec   = IdInfo a b spec d e f g h i
+addSpecInfo (IdInfo a b _ d e f g h) spec   = IdInfo a b spec d e f g h
 \end{code}
 
 %************************************************************************
@@ -307,10 +300,10 @@ mkBottomStrictnessInfo = BottomGuaranteed
 bottomIsGuaranteed BottomGuaranteed = True
 bottomIsGuaranteed other    	    = False
 
-strictnessInfo (IdInfo _ _ _ strict _ _ _ _ _) = strict
+strictnessInfo (IdInfo _ _ _ strict _ _ _ _) = strict
 
 addStrictnessInfo id_info 		     NoStrictnessInfo = id_info
-addStrictnessInfo (IdInfo a b d _ e f g h i) strict	      = IdInfo a b d strict e f g h i
+addStrictnessInfo (IdInfo a b d _ e f g h) strict	      = IdInfo a b d strict e f g h
 
 ppStrictnessInfo sty NoStrictnessInfo = empty
 ppStrictnessInfo sty BottomGuaranteed = ptext SLIT("_bot_")
@@ -334,9 +327,9 @@ workerExists other			      = False
 %************************************************************************
 
 \begin{code}
-unfoldInfo (IdInfo _ _ _ _ unfolding _ _ _ _) = unfolding
+unfoldInfo (IdInfo _ _ _ _ unfolding _ _ _) = unfolding
 
-addUnfoldInfo (IdInfo a b d e _ f g h i) uf = IdInfo a b d e uf f g h i
+addUnfoldInfo (IdInfo a b d e _ f g h) uf = IdInfo a b d e uf f g h
 \end{code}
 
 %************************************************************************
@@ -378,43 +371,16 @@ instance Text UpdateInfo where
 	ok_digit c | c >= '0' && c <= '2' = ord c - ord '0'
 		   | otherwise = panic "IdInfo: not a digit while reading update pragma"
 
-updateInfo (IdInfo _ _ _ _ _ update _ _ _) = update
+updateInfo (IdInfo _ _ _ _ _ update _ _) = update
 
 addUpdateInfo id_info			 NoUpdateInfo = id_info
-addUpdateInfo (IdInfo a b d e f _ g h i) upd_info     = IdInfo a b d e f upd_info g h i
+addUpdateInfo (IdInfo a b d e f _ g h) upd_info     = IdInfo a b d e f upd_info g h
 
 ppUpdateInfo sty NoUpdateInfo	       = empty
 ppUpdateInfo sty (SomeUpdateInfo [])   = empty
 ppUpdateInfo sty (SomeUpdateInfo spec) = (<>) (ptext SLIT("_U_ ")) (hcat (map int spec))
 \end{code}
 
-%************************************************************************
-%*                                                                    *
-\subsection[deforest-IdInfo]{Deforestation info about an @Id@}
-%*                                                                    *
-%************************************************************************
-
-The deforest info says whether this Id is to be unfolded during
-deforestation.  Therefore, when the deforest pragma is true, we must
-also have the unfolding information available for this Id.
-
-\begin{code}
-data DeforestInfo
-  = Don'tDeforest                     -- just a bool, might extend this
-  | DoDeforest                                -- later.
-  -- deriving (Eq, Ord)
-\end{code}
-
-\begin{code}
-deforestInfo (IdInfo _ _ _ _ _ _ deforest _ _) = deforest
-
-addDeforestInfo id_info 		   Don'tDeforest = id_info
-addDeforestInfo (IdInfo a b d e f g _ h i) deforest	 = IdInfo a b d e f g deforest h i
-
-ppDeforestInfo sty Don'tDeforest = empty
-ppDeforestInfo sty DoDeforest    = ptext SLIT("_DEFOREST_")
-\end{code}
-
 %************************************************************************
 %*									*
 \subsection[argUsage-IdInfo]{Argument Usage info about an @Id@}
@@ -442,10 +408,10 @@ getArgUsage (SomeArgUsageInfo u)  = u
 \end{code}
 
 \begin{code}
-argUsageInfo (IdInfo _ _ _ _ _  _ _ au _) = au
+argUsageInfo (IdInfo _ _ _ _ _ _ au _) = au
 
 addArgUsageInfo id_info			   NoArgUsageInfo = id_info
-addArgUsageInfo (IdInfo a b d e f g h _ i) au_info	  = IdInfo a b d e f g h au_info i
+addArgUsageInfo (IdInfo a b d e f g _ h) au_info	  = IdInfo a b d e f g au_info h
 
 ppArgUsageInfo sty NoArgUsageInfo	  = empty
 ppArgUsageInfo sty (SomeArgUsageInfo aut) = (<>) (ptext SLIT("_L_ ")) (ppArgUsageType aut)
@@ -485,10 +451,10 @@ getFBType (SomeFBTypeInfo u)  = Just u
 \end{code}
 
 \begin{code}
-fbTypeInfo (IdInfo _ _ _ _ _ _ _ _ fb) = fb
+fbTypeInfo (IdInfo _ _ _ _ _ _ _ fb) = fb
 
 addFBTypeInfo id_info NoFBTypeInfo = id_info
-addFBTypeInfo (IdInfo a b d e f g h i _) fb_info = IdInfo a b d e f g h i fb_info
+addFBTypeInfo (IdInfo a b d e f g h _) fb_info = IdInfo a b d e f g h fb_info
 
 ppFBTypeInfo sty NoFBTypeInfo = empty
 ppFBTypeInfo sty (SomeFBTypeInfo (FBType cons prod))
diff --git a/ghc/compiler/hsSyn/HsBinds.lhs b/ghc/compiler/hsSyn/HsBinds.lhs
index e39e4944ed3ca3d6d4a92ec1549995ffc33efae2..c298d940d89bebe3926b963482d5960058989f1a 100644
--- a/ghc/compiler/hsSyn/HsBinds.lhs
+++ b/ghc/compiler/hsSyn/HsBinds.lhs
@@ -246,9 +246,6 @@ data Sig name
   | InlineSig	name		  -- INLINE f
 		SrcLoc
 
-  | DeforestSig name            -- Deforest using this function definition
-	      	SrcLoc
-
   | MagicUnfoldingSig
 		name		-- Associate the "name"d function with
 		FAST_STRING	-- the compiler-builtin unfolding (known
@@ -268,9 +265,6 @@ ppr_sig sty (ClassOpSig var _ ty _)
       = sep [ppr sty (getOccName var) <+> ptext SLIT("::"),
 	     nest 4 (ppr sty ty)]
 
-ppr_sig sty (DeforestSig var _)
-      = hsep [text "{-# DEFOREST", ppr sty var, text "#-}"]
-
 ppr_sig sty (SpecSig var ty using _)
       = sep [ hsep [text "{-# SPECIALIZE", ppr sty var, ptext SLIT("::")],
 	      nest 4 (hsep [ppr sty ty, pp_using using, text "#-}"])
diff --git a/ghc/compiler/hsSyn/HsDecls.lhs b/ghc/compiler/hsSyn/HsDecls.lhs
index f780f12c740a4bbf70b8c54d796f69323025ee03..d4c904f4e9cf44cc6ee4f568326a4e4f239db9cc 100644
--- a/ghc/compiler/hsSyn/HsDecls.lhs
+++ b/ghc/compiler/hsSyn/HsDecls.lhs
@@ -381,7 +381,6 @@ data HsIdInfo name
   | HsStrictness	(HsStrictnessInfo name)
   | HsUnfold		Bool (UfExpr name)	-- True <=> INLINE pragma
   | HsUpdate		UpdateInfo
-  | HsDeforest		DeforestInfo
   | HsArgUsage		ArgUsageInfo
   | HsFBType		FBTypeInfo
 	-- ToDo: specialisations
diff --git a/ghc/compiler/hsSyn/HsPragmas.lhs b/ghc/compiler/hsSyn/HsPragmas.lhs
index 26075b3c0cfb5795237373ae4b96d773b58257af..cc3733ebe49acb15c093863df0d202c76b02c0ba 100644
--- a/ghc/compiler/hsSyn/HsPragmas.lhs
+++ b/ghc/compiler/hsSyn/HsPragmas.lhs
@@ -91,7 +91,6 @@ data GenPragmas name
   = NoGenPragmas
   | GenPragmas	(Maybe Int)		-- arity (maybe)
 		(Maybe UpdateInfo)	-- update info (maybe)
-		DeforestInfo		-- deforest info
 		(ImpStrictness name)	-- strictness, worker-wrapper
 		(ImpUnfolding name)	-- unfolding (maybe)
 		[([Maybe (HsType name)], -- Specialisations: types to which spec'd;
diff --git a/ghc/compiler/main/CmdLineOpts.lhs b/ghc/compiler/main/CmdLineOpts.lhs
index e00c7781f705470f2ec82643f0a1c296c478e173..d1fe78aedb7ba0fe64f5b7cb8a82a3c28001e2f2 100644
--- a/ghc/compiler/main/CmdLineOpts.lhs
+++ b/ghc/compiler/main/CmdLineOpts.lhs
@@ -25,7 +25,6 @@ module CmdLineOpts (
 	opt_CompilingGhcInternals,
 	opt_D_dump_absC,
 	opt_D_dump_asm,
-	opt_D_dump_deforest,
 	opt_D_dump_deriv,
 	opt_D_dump_ds,
 	opt_D_dump_flatC,
@@ -170,7 +169,6 @@ data CoreToDo		-- These are diff core-to-core passes,
   | CoreDoStaticArgs
   | CoreDoStrictness
   | CoreDoSpecialising
-  | CoreDoDeforest
   | CoreDoFoldrBuildWorkerWrapper
   | CoreDoFoldrBuildWWAnal
 \end{code}
@@ -279,7 +277,6 @@ opt_CompilingGhcInternals	= maybeToBool maybe_CompilingGhcInternals
 maybe_CompilingGhcInternals	= lookup_str "-fcompiling-ghc-internals="
 opt_D_dump_absC			= lookUp  SLIT("-ddump-absC")
 opt_D_dump_asm			= lookUp  SLIT("-ddump-asm")
-opt_D_dump_deforest		= lookUp  SLIT("-ddump-deforest")
 opt_D_dump_deriv		= lookUp  SLIT("-ddump-deriv")
 opt_D_dump_ds			= lookUp  SLIT("-ddump-ds")
 opt_D_dump_flatC		= lookUp  SLIT("-ddump-flatC")
@@ -412,7 +409,6 @@ classifyOpts = sep argv [] [] -- accumulators...
 	  "-fstatic-args"    -> CORE_TD(CoreDoStaticArgs)
 	  "-fstrictness"     -> CORE_TD(CoreDoStrictness)
 	  "-fspecialise"     -> CORE_TD(CoreDoSpecialising)
-	  "-fdeforest"	     -> CORE_TD(CoreDoDeforest)
 	  "-ffoldr-build-worker-wrapper"  -> CORE_TD(CoreDoFoldrBuildWorkerWrapper)
 	  "-ffoldr-build-ww-anal"  -> CORE_TD(CoreDoFoldrBuildWWAnal)
 
diff --git a/ghc/compiler/parser/binding.ugn b/ghc/compiler/parser/binding.ugn
index 25c78021bb681a028608478e0c5214d4c3b346df..2f6bccaa2de6b4029eefa44164d0990b66ddae15 100644
--- a/ghc/compiler/parser/binding.ugn
+++ b/ghc/compiler/parser/binding.ugn
@@ -74,9 +74,6 @@ type binding;
 	inline_uprag: <	ginline_id   : qid;
 			ginline_line : long; >;
 
-	deforest_uprag: < gdeforest_id : qid;
-			gdeforest_line : long; >;
-
 	magicuf_uprag:< gmagicuf_id   : qid;
 			gmagicuf_str  : stringId;
 			gmagicuf_line : long; >;
diff --git a/ghc/compiler/parser/hslexer.flex b/ghc/compiler/parser/hslexer.flex
index 3b0268ca8c659a1ae86aa795a482c85a1b776364..432625aa16c6c23a57be22c62d5cf427b615b213 100644
--- a/ghc/compiler/parser/hslexer.flex
+++ b/ghc/compiler/parser/hslexer.flex
@@ -329,10 +329,6 @@ NL  	    	    	[\n\r]
 			      PUSH_STATE(UserPragma);
 			      RETURN(MAGIC_UNFOLDING_UPRAGMA);
 			    }
-<Code,GlaExt>"{-#"{WS}*"DEFOREST" {
-                              PUSH_STATE(UserPragma);
-                              RETURN(DEFOREST_UPRAGMA);
-			    }
 <Code,GlaExt>"{-#"{WS}*"GENERATE_SPECS" {
 			      /* these are handled by hscpp */
 			      nested_comments =1;
diff --git a/ghc/compiler/parser/hsparser.y b/ghc/compiler/parser/hsparser.y
index 58db2df53fa576d32c45dd49888895b3e13e80c7..72d4472b57f0e3406377be324ac9083f2aa0ea84 100644
--- a/ghc/compiler/parser/hsparser.y
+++ b/ghc/compiler/parser/hsparser.y
@@ -185,7 +185,7 @@ BOOLEAN inpat;
 
 %token  INTERFACE_UPRAGMA SPECIALISE_UPRAGMA
 %token  INLINE_UPRAGMA MAGIC_UNFOLDING_UPRAGMA
-%token  DEFOREST_UPRAGMA END_UPRAGMA 
+%token  END_UPRAGMA 
 %token  SOURCE_UPRAGMA
 
 /**********************************************************************
@@ -613,12 +613,6 @@ decl	: qvarsk DCOLON sigtype
 		  PREVPATT = NULL; FN = NULL; SAMEFN = 0;
 		}
 
-        |  DEFOREST_UPRAGMA qvark END_UPRAGMA
-                {
-		  $$ = mkdeforest_uprag($2, startlineno);
- 		  PREVPATT = NULL; FN = NULL; SAMEFN = 0;
-		}
-
 	/* end of user-specified pragmas */
 
 	|  valdef
diff --git a/ghc/compiler/parser/printtree.c b/ghc/compiler/parser/printtree.c
index b72b9778cfe77792df072544b1a4808b0a7dbd79..11184880f8474815c77e52e8ebebb6cbd33a9a59 100644
--- a/ghc/compiler/parser/printtree.c
+++ b/ghc/compiler/parser/printtree.c
@@ -534,11 +534,6 @@ prbind(b)
 			  plineno(ginline_line(b));
 			  pqid(ginline_id(b));
 			  break;
-	case deforest_uprag:
-			  PUTTAGSTR("Sd");
-			  plineno(gdeforest_line(b));
-			  pqid(gdeforest_id(b));
-			  break;
 	case magicuf_uprag:
 			  PUTTAGSTR("Su");
 			  plineno(gmagicuf_line(b));
@@ -744,7 +739,6 @@ ppragma(p)
       case igen_pragma:		PUTTAGSTR("Pg");
 				ppragma(gprag_arity(p));
 				ppragma(gprag_update(p));
-				ppragma(gprag_deforest(p));
 				ppragma(gprag_strictness(p));
 				ppragma(gprag_unfolding(p));
 				plist(ppragma, gprag_specs(p));
@@ -755,8 +749,6 @@ ppragma(p)
       case iupdate_pragma:	PUTTAGSTR("Pu");
 				pid(gprag_update_val(p));
 				break;
-      case ideforest_pragma:	PUTTAGSTR("PD");
-				break;
       case istrictness_pragma:	PUTTAGSTR("PS");
 				print_string(gprag_strict_spec(p));
 				ppragma(gprag_strict_wrkr(p));
diff --git a/ghc/compiler/reader/PrefixSyn.lhs b/ghc/compiler/reader/PrefixSyn.lhs
index ad57265f23b3faa84d1ea7bfb0402e27ab385376..b61c178cbdb527c10eec4cb03814ac585377746a 100644
--- a/ghc/compiler/reader/PrefixSyn.lhs
+++ b/ghc/compiler/reader/PrefixSyn.lhs
@@ -63,7 +63,6 @@ data RdrBinding
   -- user pragmas come in in a Sig-ish way/form...
   | RdrSpecValSig   	[RdrNameSig]
   | RdrInlineValSig 	RdrNameSig
-  | RdrDeforestSig 	RdrNameSig
   | RdrMagicUnfoldingSig RdrNameSig
   | RdrSpecInstSig  	RdrNameSpecInstSig
   | RdrSpecDataSig   	RdrNameSpecDataSig
diff --git a/ghc/compiler/reader/PrefixToHs.lhs b/ghc/compiler/reader/PrefixToHs.lhs
index 3536af82ad10f2488f8054d3e364e54e6b116b96..a8efe1abcc290fd2fc240aeb6b1d873aa14b0ea2 100644
--- a/ghc/compiler/reader/PrefixToHs.lhs
+++ b/ghc/compiler/reader/PrefixToHs.lhs
@@ -49,7 +49,6 @@ cvClassOpSig (RdrTySig vars poly_ty src_loc)
 
 cvInstDeclSig (RdrSpecValSig        sigs) = sigs
 cvInstDeclSig (RdrInlineValSig      sig)  = [ sig ]
-cvInstDeclSig (RdrDeforestSig	    sig)  = [ sig ]
 cvInstDeclSig (RdrMagicUnfoldingSig sig)  = [ sig ]
 \end{code}
 
@@ -96,7 +95,6 @@ cvMonoBindsAndSigs sf sig_cvtr fb
 
     mangle_bind (b_acc, s_acc) (RdrSpecValSig	     sig) = (b_acc, sig ++ s_acc)
     mangle_bind (b_acc, s_acc) (RdrInlineValSig      sig) = (b_acc, sig : s_acc)
-    mangle_bind (b_acc, s_acc) (RdrDeforestSig       sig) = (b_acc, sig : s_acc)
     mangle_bind (b_acc, s_acc) (RdrMagicUnfoldingSig sig) = (b_acc, sig : s_acc)
 
     mangle_bind (b_acc, s_acc)
diff --git a/ghc/compiler/reader/ReadPrefix.lhs b/ghc/compiler/reader/ReadPrefix.lhs
index 4b185e175629ca1025a3b842022921bec9450e9b..8e41450d8450f30af415afab83392b5089139269 100644
--- a/ghc/compiler/reader/ReadPrefix.lhs
+++ b/ghc/compiler/reader/ReadPrefix.lhs
@@ -683,12 +683,6 @@ wlk_sig_thing (U_inline_uprag ivar srcline)
     wlkVarId	ivar		`thenUgn` \ var     ->
     returnUgn (RdrInlineValSig (InlineSig var src_loc))
 
-	-- "deforest me" user-pragma
-wlk_sig_thing (U_deforest_uprag ivar srcline)
-  = mkSrcLocUgn srcline			$ \ src_loc ->
-    wlkVarId	ivar		`thenUgn` \ var     ->
-    returnUgn (RdrDeforestSig (DeforestSig var src_loc))
-
 	-- "magic" unfolding user-pragma
 wlk_sig_thing (U_magicuf_uprag ivar str srcline)
   = mkSrcLocUgn srcline			$ \ src_loc ->
diff --git a/ghc/compiler/rename/RnBinds.lhs b/ghc/compiler/rename/RnBinds.lhs
index 089d8e187ccafba022744cf4fe5c29bc720272cb..b3a776fb77d6c1df9e31cc3839180712850e9334 100644
--- a/ghc/compiler/rename/RnBinds.lhs
+++ b/ghc/compiler/rename/RnBinds.lhs
@@ -498,11 +498,6 @@ renameSig (InlineSig v src_loc)
     lookupBndrRn v		`thenRn` \ new_v ->
     returnRn (InlineSig new_v src_loc)
 
-renameSig (DeforestSig v src_loc)
-  = pushSrcLocRn src_loc $
-    lookupBndrRn v        `thenRn` \ new_v ->
-    returnRn (DeforestSig new_v src_loc)
-
 renameSig (MagicUnfoldingSig v str src_loc)
   = pushSrcLocRn src_loc $
     lookupBndrRn v		`thenRn` \ new_v ->
@@ -529,7 +524,6 @@ sig_tag (Sig n1 _ _)    	   = (ILIT(1) :: FAST_INT)
 sig_tag (SpecSig n1 _ _ _)    	   = ILIT(2)
 sig_tag (InlineSig n1 _)  	   = ILIT(3)
 sig_tag (MagicUnfoldingSig n1 _ _) = ILIT(4)
-sig_tag (DeforestSig n1 _)         = ILIT(5)
 sig_tag _			   = panic# "tag(RnBinds)"
 
 sig_name (Sig        n _ _) 	   = n
diff --git a/ghc/compiler/rename/RnSource.lhs b/ghc/compiler/rename/RnSource.lhs
index 817b3a6de8e215d9cb2d5b79827897bd7d0ac4ed..33d156de53b92525297fa362ea8d0219ba9c9722 100644
--- a/ghc/compiler/rename/RnSource.lhs
+++ b/ghc/compiler/rename/RnSource.lhs
@@ -275,11 +275,6 @@ rnDecl (InstD (InstDecl inst_ty mbinds uprags maybe_dfun src_loc))
 	lookupBndrRn op			`thenRn` \ op_name ->
 	returnRn (InlineSig op_name locn)
 
-    rn_uprag (DeforestSig op locn)
-      = pushSrcLocRn locn $
-	lookupBndrRn op			`thenRn` \ op_name ->
-	returnRn (DeforestSig op_name locn)
-
     rn_uprag (MagicUnfoldingSig op str locn)
       = pushSrcLocRn locn $
 	lookupBndrRn op			`thenRn` \ op_name ->
@@ -562,7 +557,6 @@ rnIdInfo (HsArity arity)	= returnRn (HsArity arity)
 rnIdInfo (HsUpdate update)	= returnRn (HsUpdate update)
 rnIdInfo (HsFBType fb)		= returnRn (HsFBType fb)
 rnIdInfo (HsArgUsage au)	= returnRn (HsArgUsage au)
-rnIdInfo (HsDeforest df)	= returnRn (HsDeforest df)
 
 rnStrict (HsStrictnessInfo demands (Just (worker,cons)))
 	-- The sole purpose of the "cons" field is so that we can mark the constructors
diff --git a/ghc/compiler/simplCore/SimplCore.lhs b/ghc/compiler/simplCore/SimplCore.lhs
index 70520e396a505812d5e6a15210340625882af9df..8a122ef9ba2259b4e2713f673cfa1380aaa52e9d 100644
--- a/ghc/compiler/simplCore/SimplCore.lhs
+++ b/ghc/compiler/simplCore/SimplCore.lhs
@@ -92,12 +92,6 @@ import Constants	( tARGET_MIN_INT, tARGET_MAX_INT )
 import Bag
 import Maybes
 
-
-#ifndef OMIT_DEFORESTER
-import Deforest		( deforestProgram )
-import DefUtils		( deforestable )
-#endif
-
 \end{code}
 
 \begin{code}
@@ -222,16 +216,6 @@ core2core core_todos module_name us local_tycons tycon_specs binds
 		   end_pass us2 p spec_data2 simpl_stats "Specialise"
 	       }
 
-	  CoreDoDeforest
-#if OMIT_DEFORESTER
-	    -> error "ERROR: CoreDoDeforest: not built into compiler\n"
-#else
-	    -> _scc_ "Deforestation"
-	       begin_pass "Deforestation" >>
-	       case (deforestProgram binds us1) of { binds2 ->
-	       end_pass us2 binds2 spec_data simpl_stats "Deforestation" }
-#endif
-
 	  CoreDoPrintCore	-- print result of last pass
 	    -> dumpIfSet (not opt_D_verbose_core2core) "Print Core"
 	 	  (pprCoreBindings pprDumpStyle binds)	>>
diff --git a/ghc/compiler/simplCore/SimplVar.lhs b/ghc/compiler/simplCore/SimplVar.lhs
index 2a2f4ab50b06d8095dbb5d0ded3ecd144a76c2a9..98a89578a9e473b24df49ec4b00680c39c8ebcf7 100644
--- a/ghc/compiler/simplCore/SimplVar.lhs
+++ b/ghc/compiler/simplCore/SimplVar.lhs
@@ -33,7 +33,6 @@ import Id		( idType, getIdInfo, getIdUnfolding, getIdSpecialisation,
 			  idMustBeINLINEd, GenId{-instance Outputable-}
 			)
 import SpecEnv		( SpecEnv, lookupSpecEnv )
-import IdInfo		( DeforestInfo(..) )
 import Literal		( isNoRepLit )
 import MagicUFs		( applyMagicUnfoldingFun, MagicUnfoldingFun )
 import Outputable	( Outputable(..), PprStyle(..) )
diff --git a/ghc/compiler/typecheck/TcBinds.lhs b/ghc/compiler/typecheck/TcBinds.lhs
index 39c7716e88349487ef7433512cc4a1a3f9a05d15..7486de56153710423782f297d1985b9c9181b68f 100644
--- a/ghc/compiler/typecheck/TcBinds.lhs
+++ b/ghc/compiler/typecheck/TcBinds.lhs
@@ -693,8 +693,6 @@ tcPragmaSigs sigs
 Here are the easy cases for tcPragmaSigs
 
 \begin{code}
-tcPragmaSig (DeforestSig name loc)
-  = returnTc ((name, addDeforestInfo DoDeforest),EmptyBinds,emptyLIE)
 tcPragmaSig (InlineSig name loc)
   = returnTc ((name, addUnfoldInfo (iWantToBeINLINEd UnfoldAlways)), EmptyBinds, emptyLIE)
 tcPragmaSig (MagicUnfoldingSig name string loc)
diff --git a/ghc/compiler/typecheck/TcIfaceSig.lhs b/ghc/compiler/typecheck/TcIfaceSig.lhs
index 3cdf85157fc49b189e2f818c3b80b7c2463c347d..63282687cf813c464cfa7eff13f0018cab2b72f5 100644
--- a/ghc/compiler/typecheck/TcIfaceSig.lhs
+++ b/ghc/compiler/typecheck/TcIfaceSig.lhs
@@ -94,7 +94,6 @@ tcIdInfo unf_env name ty info info_ins
     go info (HsUpdate upd : rest)  = go (info `addUpdateInfo` upd)  rest
     go info (HsFBType fb : rest)   = go (info `addFBTypeInfo` fb)   rest
     go info (HsArgUsage au : rest) = go (info `addArgUsageInfo` au) rest
-    go info (HsDeforest df : rest) = go (info `addDeforestInfo` df) rest
 
     go info (HsUnfold inline expr : rest) = tcUnfolding unf_env name expr 	`thenNF_Tc` \ unfold_info ->
 					    go (info `addUnfoldInfo` unfold_info) rest
diff --git a/ghc/compiler/utils/Ubiq.lhi b/ghc/compiler/utils/Ubiq.lhi
index 31109b9905db1c31feb0f4a9187f622cf6e8e3d4..dc0b46586a6a9681a260cb872644b6ed17dc239b 100644
--- a/ghc/compiler/utils/Ubiq.lhi
+++ b/ghc/compiler/utils/Ubiq.lhi
@@ -24,7 +24,7 @@ import HeapOffs		( HeapOffset )
 import HsPat		( OutPat )
 import HsPragmas	( ClassOpPragmas, ClassPragmas, DataPragmas, GenPragmas, InstancePragmas )
 import Id		( StrictnessMark, GenId, Id(..) )
-import IdInfo		( IdInfo, ArityInfo, DeforestInfo, StrictnessInfo, UpdateInfo )
+import IdInfo		( IdInfo, ArityInfo, StrictnessInfo, UpdateInfo )
 import Demand		( Demand )
 import Kind		( Kind )
 import Literal		( Literal )
@@ -78,7 +78,6 @@ data ClosureInfo
 data Coercion
 data CostCentre
 data DataPragmas a
-data DeforestInfo
 data Demand
 data ExportFlag
 data FieldLabel