From a6c7e7dc8d0c5626ea29c71c3fc957d33064697b Mon Sep 17 00:00:00 2001 From: simonm Date: Wed, 24 Sep 1997 09:09:02 +0000 Subject: [PATCH] [project @ 1997-09-24 09:08:21 by simonm] Remove deforester --- ghc/compiler/Makefile | 11 ----- ghc/compiler/basicTypes/Id.lhs | 13 ------ ghc/compiler/basicTypes/IdInfo.lhs | 74 +++++++++------------------------ ghc/compiler/hsSyn/HsBinds.lhs | 6 --- ghc/compiler/hsSyn/HsDecls.lhs | 1 - ghc/compiler/hsSyn/HsPragmas.lhs | 1 - ghc/compiler/main/CmdLineOpts.lhs | 4 -- ghc/compiler/parser/binding.ugn | 3 -- ghc/compiler/parser/hslexer.flex | 4 -- ghc/compiler/parser/hsparser.y | 8 +--- ghc/compiler/parser/printtree.c | 8 ---- ghc/compiler/reader/PrefixSyn.lhs | 1 - ghc/compiler/reader/PrefixToHs.lhs | 2 - ghc/compiler/reader/ReadPrefix.lhs | 6 --- ghc/compiler/rename/RnBinds.lhs | 6 --- ghc/compiler/rename/RnSource.lhs | 6 --- ghc/compiler/simplCore/SimplCore.lhs | 16 ------- ghc/compiler/simplCore/SimplVar.lhs | 1 - ghc/compiler/typecheck/TcBinds.lhs | 2 - ghc/compiler/typecheck/TcIfaceSig.lhs | 1 - ghc/compiler/utils/Ubiq.lhi | 3 +- 21 files changed, 22 insertions(+), 155 deletions(-) diff --git a/ghc/compiler/Makefile b/ghc/compiler/Makefile index 3623c96..3b745ad 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 49c76cc..1e72ae4 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, @@ -847,18 +846,6 @@ addIdArity (Id u n ty details pinfo info) arity %************************************************************************ %* * -\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 2843e29..b9e81f9 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,10 +371,10 @@ 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 @@ -389,33 +382,6 @@ ppUpdateInfo sty (SomeUpdateInfo spec) = (<>) (ptext SLIT("_U_ ")) (hcat (map in \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 e39e494..c298d94 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 f780f12..d4c904f 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 26075b3..cc3733e 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 e00c778..d1fe78a 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 25c7802..2f6bcca 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 3b0268c..432625a 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); } -"{-#"{WS}*"DEFOREST" { - PUSH_STATE(UserPragma); - RETURN(DEFOREST_UPRAGMA); - } "{-#"{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 58db2df..72d4472 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 b72b977..1118488 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 ad57265..b61c178 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 3536af8..a8efe1a 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 4b185e1..8e41450 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 089d8e1..b3a776f 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 817b3a6..33d156d 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 70520e3..8a122ef 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 2a2f4ab..98a8957 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 39c7716..7486de5 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 3cdf851..6328268 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 31109b9..dc0b465 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 -- 1.7.10.4