Skip to content

GitLab

Commit ca5a4a48 authored by partain's avatar partain
Browse files

[project @ 1996-05-01 18:36:59 by partain] 

SLPJ 1.3 changes through 960501
parent f01a8e8c
Hide whitespace changes
Inline Side-by-side
ghc/compiler/HsVersions.h
View file @ ca5a4a48
......@@ -10,10 +10,6 @@ you will screw up the layout where they are used in case expressions!
#endif
#define MkInt I#
#define MkChar C#
#define MkArray _Array
#ifdef __GLASGOW_HASKELL__
#define TAG_ Int#
#define LT_ -1#
......@@ -22,58 +18,14 @@ you will screw up the layout where they are used in case expressions!
#endif
#define GT__ _
#ifdef __HBC__
#define IMPORT_Trace import Trace
#define BSCC(l) (
#define ESCC )
#else
#define IMPORT_Trace {--}
#define BSCC(l) (_scc_ l (
#define ESCC ))
#endif
-- these are overridable
#ifndef BIND
#define BIND case
#endif /* BIND */
#ifndef _TO_
#define _TO_ of {
#endif /* _TO_ */
#ifndef BEND
#define BEND }
#endif /* BEND */
#ifndef RETN
#define RETN {--}
#endif /* RETN */
#ifndef RETN_TYPE
#define RETN_TYPE {--}
#endif /* RETN_TYPE */
#define COMMA ,
#ifdef DEBUG
#define ASSERT(e) if (not (e)) then (assertPanic __FILE__ __LINE__) else
#define CHK_Ubiq() import Ubiq
#else
#define ASSERT(e)
#define CHK_Ubiq()
#endif
-- ToDo: ghci needs to load far too many bits of the backend because
-- this ATTACK_PRAGMA stuff encourages Utils.lhs to tell
-- everyone about everyone else. I guess we need to add some
-- more conditional stuff in.
#ifdef USE_ATTACK_PRAGMAS
#define IF_ATTACK_PRAGMAS(x) x
#else
#define IF_ATTACK_PRAGMAS(x) {--}
#endif
#if GHCI
#define IF_GHCI(stuff) stuff
#else
#define IF_GHCI(stuff) {-nothing-}
#endif
#define CHK_Ubiq() import Ubiq
#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 26
#define trace _trace
......@@ -157,24 +109,4 @@ you will screw up the layout where they are used in case expressions!
#define _CONCAT_ concat
#endif
#if __HASKELL1__ < 3
{- To avoid confusion with Haskell 1.3, we use Swahili.
data Maybe a = Nothing | Just a
data Labda a = Hamna | Ni a
Should we ever need to increase confusion with HBC, we will
use Swedish:
data Kanske a = Ingenting | Bara a
-}
# define Maybe Labda
# define Just Ni
# define Nothing Hamna
#else
# define MAYBE Labda
# define JUST Ni
# define NOTHING Hamna
#endif
#endif
ghc/compiler/Jmakefile
View file @ ca5a4a48
......@@ -377,7 +377,7 @@ ALLINTS=$(ALLSRCS_LHS:.lhs=.hi) $(ALLSRCS_HS:.hs=.hi)
#endif
#if GhcWithHscOptimised == YES
#define __version_sensitive_flags -DUSE_ATTACK_PRAGMAS -fshow-pragma-name-errs -fomit-reexported-instances -fshow-import-specs
#define __version_sensitive_flags -O /*-DUSE_ATTACK_PRAGMAS -fshow-pragma-name-errs*/ -fomit-reexported-instances -fshow-import-specs
#else
#define __version_sensitive_flags -fomit-reexported-instances
#endif
......
ghc/compiler/absCSyn/AbsCUtils.lhs
View file @ ca5a4a48
......@@ -66,39 +66,14 @@ mkAbsCStmts :: AbstractC -> AbstractC -> AbstractC
mkAbsCStmts = AbsCStmts
{- Discarded SLPJ June 95; it calls nonemptyAbsC too much!
= BIND (case (nonemptyAbsC abc2) of
= case (case (nonemptyAbsC abc2) of
Nothing -> AbsCNop
Just d2 -> d2) _TO_ abc2b ->
Just d2 -> d2) of { abc2b ->
case (nonemptyAbsC abc1) of {
Nothing -> abc2b;
Just d1 -> AbsCStmts d1 abc2b
} BEND
-}
{-
= case (nonemptyAbsC abc1) of
Nothing -> abc2
Just d1 -> AbsCStmts d1 abc2
-}
{- old2:
= case (nonemptyAbsC abc1) of
Nothing -> case (nonemptyAbsC abc2) of
Nothing -> AbsCNop
Just d2 -> d2
Just d1 -> AbsCStmts d1 abc2
-}
{- old:
if abc1_empty then
if abc2_empty
then AbsCNop
else abc2
else if {- abc1 not empty but -} abc2_empty then
abc1
else {- neither empty -}
AbsCStmts abc1 abc2
where
abc1_empty = noAbsCcode abc1
abc2_empty = noAbsCcode abc2
} }
-}
\end{code}
......@@ -539,14 +514,13 @@ flatAmode (CCode abs_C)
_ ->
-- de-anonymous-ise the code and push it (labelled) to the top level
getUniqFlt `thenFlt` \ new_uniq ->
BIND (mkReturnPtLabel new_uniq) _TO_ return_pt_label ->
case (mkReturnPtLabel new_uniq) of { return_pt_label ->
flatAbsC abs_C `thenFlt` \ (body_code, tops) ->
returnFlt (
CLbl return_pt_label CodePtrRep,
tops `mkAbsCStmts` CCodeBlock return_pt_label body_code
-- DO NOT TOUCH the stuff sent to the top...
)
BEND
) }
flatAmode (CTableEntry base index kind)
= flatAmode base `thenFlt` \ (base_amode, base_tops) ->
......
ghc/compiler/absCSyn/PprAbsC.lhs
View file @ ca5a4a48
......@@ -210,7 +210,7 @@ pprAbsC sty stmt@(COpStmt results op args liveness_mask vol_regs) _
the_op = ppr_op_call non_void_results non_void_args
-- liveness mask is *in* the non_void_args
in
BIND (ppr_vol_regs sty vol_regs) _TO_ (pp_saves, pp_restores) ->
case (ppr_vol_regs sty vol_regs) of { (pp_saves, pp_restores) ->
if primOpNeedsWrapper op then
uppAboves [ pp_saves,
the_op,
......@@ -218,7 +218,7 @@ pprAbsC sty stmt@(COpStmt results op args liveness_mask vol_regs) _
]
else
the_op
BEND
}
where
ppr_op_call results args
= uppBesides [ prettyToUn (pprPrimOp sty op), uppLparen,
......@@ -246,7 +246,7 @@ pprAbsC sty stmt@(CCallProfCCMacro op as) _
pprAbsC sty (CCodeBlock label abs_C) _
= ASSERT( maybeToBool(nonemptyAbsC abs_C) )
BIND (pprTempAndExternDecls abs_C) _TO_ (pp_temps, pp_exts) ->
case (pprTempAndExternDecls abs_C) of { (pp_temps, pp_exts) ->
uppAboves [
uppBesides [uppStr (if (externallyVisibleCLabel label)
then "FN_(" -- abbreviations to save on output
......@@ -259,7 +259,7 @@ pprAbsC sty (CCodeBlock label abs_C) _
uppNest 8 (pprAbsC sty abs_C (costs abs_C)),
uppNest 8 (uppPStr SLIT("FE_")),
uppChar '}' ]
BEND
}
pprAbsC sty (CInitHdr cl_info reg_rel cost_centre inplace_upd) _
= uppBesides [ pp_init_hdr, uppStr "_HDR(",
......@@ -279,7 +279,7 @@ pprAbsC sty (CInitHdr cl_info reg_rel cost_centre inplace_upd) _
getSMInitHdrStr sm_rep)
pprAbsC sty stmt@(CStaticClosure closure_lbl cl_info cost_centre amodes) _
= BIND (pprTempAndExternDecls stmt) _TO_ (_, pp_exts) ->
= case (pprTempAndExternDecls stmt) of { (_, pp_exts) ->
uppAboves [
case sty of
PprForC -> pp_exts
......@@ -296,7 +296,7 @@ pprAbsC sty stmt@(CStaticClosure closure_lbl cl_info cost_centre amodes) _
uppNest 2 (uppBesides (map (ppr_item sty) amodes)),
uppNest 2 (uppBesides (map (ppr_item sty) padding_wds)),
uppStr "};" ]
BEND
}
where
info_lbl = infoTableLabelFromCI cl_info
......@@ -309,9 +309,8 @@ pprAbsC sty stmt@(CStaticClosure closure_lbl cl_info cost_centre amodes) _
if not (closureUpdReqd cl_info) then
[]
else
BIND (max 0 (mIN_UPD_SIZE - length amodes)) _TO_ still_needed ->
nOfThem still_needed (mkIntCLit 0) -- a bunch of 0s
BEND
case (max 0 (mIN_UPD_SIZE - length amodes)) of { still_needed ->
nOfThem still_needed (mkIntCLit 0) } -- a bunch of 0s
{-
STATIC_INIT_HDR(c,i,localness) blows into:
......@@ -420,7 +419,7 @@ pprAbsC sty stmt@(CRetUnVector label amode) _
pp_static = if externallyVisibleCLabel label then uppNil else uppPStr SLIT("static")
pprAbsC sty stmt@(CFlatRetVector label amodes) _
= BIND (pprTempAndExternDecls stmt) _TO_ (_, pp_exts) ->
= case (pprTempAndExternDecls stmt) of { (_, pp_exts) ->
uppAboves [
case sty of
PprForC -> pp_exts
......@@ -428,8 +427,7 @@ pprAbsC sty stmt@(CFlatRetVector label amodes) _
uppBesides [ppLocalness label, uppPStr SLIT(" W_ "),
pprCLabel sty label, uppStr "[] = {"],
uppNest 2 (uppInterleave uppComma (map (ppr_item sty) amodes)),
uppStr "};" ]
BEND
uppStr "};" ] }
where
ppr_item sty item = uppBeside (uppStr "(W_) ") (ppr_amode sty item)
......@@ -444,12 +442,12 @@ ppLocalness label
const = if not (isReadOnly label) then uppNil else uppPStr SLIT("const")
ppLocalnessMacro for_fun{-vs data-} clabel
= BIND (if externallyVisibleCLabel clabel then "E" else "I") _TO_ prefix ->
BIND (if isReadOnly clabel then "RO_" else "") _TO_ suffix ->
= case (if externallyVisibleCLabel clabel then "E" else "I") of { prefix ->
case (if isReadOnly clabel then "RO_" else "") of { suffix ->
if for_fun
then uppStr (prefix ++ "F_")
else uppStr (prefix ++ "D_" ++ suffix)
BEND BEND
} }
\end{code}
\begin{code}
......@@ -1109,10 +1107,9 @@ pprTempAndExternDecls AbsCNop = (uppNil, uppNil)
pprTempAndExternDecls (AbsCStmts stmt1 stmt2)
= initTE (ppr_decls_AbsC stmt1 `thenTE` \ (t_p1, e_p1) ->
ppr_decls_AbsC stmt2 `thenTE` \ (t_p2, e_p2) ->
BIND (catMaybes [t_p1, t_p2]) _TO_ real_temps ->
BIND (catMaybes [e_p1, e_p2]) _TO_ real_exts ->
returnTE (uppAboves real_temps, uppAboves real_exts)
BEND BEND
case (catMaybes [t_p1, t_p2]) of { real_temps ->
case (catMaybes [e_p1, e_p2]) of { real_exts ->
returnTE (uppAboves real_temps, uppAboves real_exts) }}
)
pprTempAndExternDecls other_stmt
......@@ -1214,14 +1211,14 @@ pprExternDecl clabel kind
= if not (needsCDecl clabel) then
uppNil -- do not print anything for "known external" things (e.g., < PreludeCore)
else
BIND (
case (
case kind of
CodePtrRep -> ppLocalnessMacro True{-function-} clabel
_ -> ppLocalnessMacro False{-data-} clabel
) _TO_ pp_macro_str ->
_ -> ppLocalnessMacro False{-data-} clabel
) of { pp_macro_str ->
uppBesides [ pp_macro_str, uppLparen, pprCLabel PprForC clabel, pp_paren_semi ]
BEND
}
\end{code}
\begin{code}
......@@ -1385,12 +1382,12 @@ ppr_decls_Amode other = returnTE (Nothing, Nothing)
maybe_uppAboves :: [(Maybe Unpretty, Maybe Unpretty)] -> (Maybe Unpretty, Maybe Unpretty)
maybe_uppAboves ps
= BIND (unzip ps) _TO_ (ts, es) ->
BIND (catMaybes ts) _TO_ real_ts ->
BIND (catMaybes es) _TO_ real_es ->
= case (unzip ps) of { (ts, es) ->
case (catMaybes ts) of { real_ts ->
case (catMaybes es) of { real_es ->
(if (null real_ts) then Nothing else Just (uppAboves real_ts),
if (null real_es) then Nothing else Just (uppAboves real_es))
BEND BEND BEND
} } }
\end{code}
\begin{code}
......
ghc/compiler/basicTypes/Id.lhs
View file @ ca5a4a48
......@@ -116,7 +116,7 @@ import FieldLabel ( fieldLabelName, FieldLabel(..){-instances-} )
import PragmaInfo ( PragmaInfo(..) )
import PprEnv -- ( NmbrM(..), NmbrEnv(..) )
import PprType ( getTypeString, typeMaybeString, specMaybeTysSuffix,
nmbrType, addTyVar,
nmbrType, nmbrTyVar,
GenType, GenTyVar
)
import PprStyle
......@@ -1098,11 +1098,10 @@ getIdNamePieces show_uniqs id
get_fullname_pieces :: Name -> [FAST_STRING]
get_fullname_pieces n
= BIND (moduleNamePair n) _TO_ (mod, name) ->
= case (moduleNamePair n) of { (mod, name) ->
if isPreludeDefinedName n
then [name]
else [mod, name]
BEND
else [mod, name] }
\end{code}
%************************************************************************
......@@ -1375,11 +1374,11 @@ mkDataCon n stricts fields tvs ctxt args_tys tycon
(tyvars, dict_vars, vars) = mk_uf_bits tvs ctxt args_tys tycon
tyvar_tys = mkTyVarTys tyvars
in
BIND (Con data_con tyvar_tys [VarArg v | v <- vars]) _TO_ plain_Con ->
case (Con data_con tyvar_tys [VarArg v | v <- vars]) of { plain_Con ->
mkUnfolding EssentialUnfolding -- for data constructors
(mkLam tyvars (dict_vars ++ vars) plain_Con)
BEND
}
mk_uf_bits tvs ctxt arg_tys tycon
= let
......@@ -1390,19 +1389,19 @@ mkDataCon n stricts fields tvs ctxt args_tys tycon
-- the "context" and "arg_tys" have TyVarTemplates in them, so
-- we instantiate those types to have the right TyVars in them
-- instead.
BIND (map (instantiateTauTy inst_env) (map ctxt_ty ctxt))
_TO_ inst_dict_tys ->
BIND (map (instantiateTauTy inst_env) arg_tys) _TO_ inst_arg_tys ->
case (map (instantiateTauTy inst_env) (map ctxt_ty ctxt))
of { inst_dict_tys ->
case (map (instantiateTauTy inst_env) arg_tys) of { inst_arg_tys ->
-- We can only have **ONE** call to mkTemplateLocals here;
-- otherwise, we get two blobs of locals w/ mixed-up Uniques
-- (Mega-Sigh) [ToDo]
BIND (mkTemplateLocals (inst_dict_tys ++ inst_arg_tys)) _TO_ all_vars ->
case (mkTemplateLocals (inst_dict_tys ++ inst_arg_tys)) of { all_vars ->
BIND (splitAt (length ctxt) all_vars) _TO_ (dict_vars, vars) ->
case (splitAt (length ctxt) all_vars) of { (dict_vars, vars) ->
(tyvars, dict_vars, vars)
BEND BEND BEND BEND
}}}}
where
-- these are really dubious Types, but they are only to make the
-- binders for the lambdas for tossed-away dicts.
......@@ -1439,17 +1438,14 @@ mkTupleCon arity
(tyvars, dict_vars, vars) = mk_uf_bits arity
tyvar_tys = mkTyVarTys tyvars
in
BIND (Con data_con tyvar_tys [VarArg v | v <- vars]) _TO_ plain_Con ->
case (Con data_con tyvar_tys [VarArg v | v <- vars]) of { plain_Con ->
mkUnfolding
EssentialUnfolding -- data constructors
(mkLam tyvars (dict_vars ++ vars) plain_Con)
BEND
(mkLam tyvars (dict_vars ++ vars) plain_Con) }
mk_uf_bits arity
= BIND (mkTemplateLocals tyvar_tys) _TO_ vars ->
(tyvars, [], vars)
BEND
= case (mkTemplateLocals tyvar_tys) of { vars ->
(tyvars, [], vars) }
where
tyvar_tmpls = take arity alphaTyVars
(_, tyvars, tyvar_tys) = instantiateTyVarTemplates tyvar_tmpls (map uniqueOf tyvar_tmpls)
......@@ -1824,35 +1820,32 @@ instance NamedThing (GenId ty) where
mod -> (mod, classOpString op)
get (SpecId unspec ty_maybes _)
= BIND moduleNamePair unspec _TO_ (mod, unspec_nm) ->
BIND specMaybeTysSuffix ty_maybes _TO_ tys_suffix ->
= case moduleNamePair unspec of { (mod, unspec_nm) ->
case specMaybeTysSuffix ty_maybes of { tys_suffix ->
(mod,
unspec_nm _APPEND_
(if not (toplevelishId unspec)
then showUnique u
else tys_suffix)
)
BEND BEND
) }}
get (WorkerId unwrkr)
= BIND moduleNamePair unwrkr _TO_ (mod, unwrkr_nm) ->
= case moduleNamePair unwrkr of { (mod, unwrkr_nm) ->
(mod,
unwrkr_nm _APPEND_
(if not (toplevelishId unwrkr)
then showUnique u
else SLIT(".wrk"))
)
BEND
) }
get other_details
-- the remaining internally-generated flavours of
-- Ids really do not have meaningful "original name" stuff,
-- but we need to make up something (usually for debugging output)
= BIND (getIdNamePieces True this_id) _TO_ (piece1:pieces) ->
BIND [ _CONS_ '.' p | p <- pieces ] _TO_ dotted_pieces ->
(_NIL_, _CONCAT_ (piece1 : dotted_pieces))
BEND BEND
= case (getIdNamePieces True this_id) of { (piece1:pieces) ->
case [ _CONS_ '.' p | p <- pieces ] of { dotted_pieces ->
(_NIL_, _CONCAT_ (piece1 : dotted_pieces)) }}
-}
\end{code}
......@@ -1989,7 +1982,7 @@ nmbrId id@(Id u ty det prag info) nenv@(NmbrEnv ui ut uu idenv tvenv uvenv)
nmbr_details :: IdDetails -> NmbrM IdDetails
nmbr_details (DataConId n tag marks fields tvs theta arg_tys tc)
= mapNmbr addTyVar tvs `thenNmbr` \ new_tvs ->
= mapNmbr nmbrTyVar tvs `thenNmbr` \ new_tvs ->
mapNmbr nmbrField fields `thenNmbr` \ new_fields ->
mapNmbr nmbr_theta theta `thenNmbr` \ new_theta ->
mapNmbr nmbrType arg_tys `thenNmbr` \ new_arg_tys ->
......
ghc/compiler/basicTypes/IdInfo.lhs
View file @ ca5a4a48
......@@ -728,7 +728,7 @@ pp_strictness sty for_this_id_maybe better_id_fn inline_env
\begin{code}
mkUnfolding guide expr
= GenForm False (mkFormSummary NoStrictnessInfo expr)
(BSCC("OccurExpr") occurAnalyseGlobalExpr expr ESCC)
(occurAnalyseGlobalExpr expr)
guide
\end{code}
......
ghc/compiler/basicTypes/Name.lhs
View file @ ca5a4a48
......@@ -350,12 +350,6 @@ exportFlagOn NotExported = False
exportFlagOn _ = True
isExported a = exportFlagOn (getExportFlag a)
#ifdef USE_ATTACK_PRAGMAS
{-# SPECIALIZE isExported :: Class -> Bool #-}
{-# SPECIALIZE isExported :: Id -> Bool #-}
{-# SPECIALIZE isExported :: TyCon -> Bool #-}
#endif
\end{code}
%************************************************************************
......@@ -409,12 +403,6 @@ comparison.]
\begin{code}
a `ltLexical` b = origName a < origName b
#ifdef USE_ATTACK_PRAGMAS
{-# SPECIALIZE ltLexical :: Class -> Class -> Bool #-}
{-# SPECIALIZE ltLexical :: Id -> Id -> Bool #-}
{-# SPECIALIZE ltLexical :: TyCon -> TyCon -> Bool #-}
#endif
\end{code}
These functions test strings to see if they fit the lexical categories
......@@ -502,11 +490,4 @@ pprNonSym sty var
= if isSymLexeme var
then ppParens (ppr sty var)
else ppr sty var
#ifdef USE_ATTACK_PRAGMAS
{-# SPECIALIZE isSymLexeme :: Id -> Bool #-}
{-# SPECIALIZE pprNonSym :: PprStyle -> Id -> Pretty #-}
{-# SPECIALIZE pprNonSym :: PprStyle -> TyCon -> Pretty #-}
{-# SPECIALIZE pprSym :: PprStyle -> Id -> Pretty #-}
#endif
\end{code}
ghc/compiler/basicTypes/UniqSupply.lhs
View file @ ca5a4a48
......@@ -67,7 +67,7 @@ getUniques :: Int -> UniqSupply -> [Unique]
\end{code}
\begin{code}
mkSplitUniqSupply (MkChar c#)
mkSplitUniqSupply (C# c#)
= let
mask# = (i2w (ord# c#)) `shiftL#` (i2w_s 24#)
......@@ -91,7 +91,7 @@ mkSplitUniqSupply (MkChar c#)
(r, s)
mk_unique = _ccall_ genSymZh `thenPrimIO` \ (W# u#) ->
returnPrimIO (MkInt (w2i (mask# `or#` u#)))
returnPrimIO (I# (w2i (mask# `or#` u#)))
in
mk_supply# `thenPrimIO` \ s ->
return s
......@@ -100,13 +100,13 @@ splitUniqSupply (MkSplitUniqSupply _ s1 s2) = (s1, s2)
\end{code}
\begin{code}
getUnique (MkSplitUniqSupply (MkInt n) _ _) = mkUniqueGrimily n
getUnique (MkSplitUniqSupply (I# n) _ _) = mkUniqueGrimily n
getUniques i@(MkInt i#) supply = i# `get_from` supply
getUniques (I# i) supply = i `get_from` supply
where
get_from 0# _ = []
get_from n# (MkSplitUniqSupply (MkInt u#) _ s2)
= mkUniqueGrimily u# : get_from (n# `minusInt#` 1#) s2
get_from n (MkSplitUniqSupply (I# u) _ s2)
= mkUniqueGrimily u : get_from (n `minusInt#` 1#) s2
\end{code}
%************************************************************************
......
ghc/compiler/basicTypes/Unique.lhs
View file @ ca5a4a48
......@@ -252,13 +252,13 @@ w2i x = word2Int# x
i2w x = int2Word# x
i2w_s x = (x::Int#)
mkUnique (MkChar c#) (MkInt i#)
= MkUnique (w2i (((i2w (ord# c#)) `shiftL#` (i2w_s 24#)) `or#` (i2w i#)))
mkUnique (C# c) (I# i)
= MkUnique (w2i (((i2w (ord# c)) `shiftL#` (i2w_s 24#)) `or#` (i2w i)))
unpkUnique (MkUnique u)
= let
tag = MkChar (chr# (w2i ((i2w u) `shiftr` (i2w_s 24#))))
i = MkInt (w2i ((i2w u) `and#` (i2w 16777215#){-``0x00ffffff''-}))
tag = C# (chr# (w2i ((i2w u) `shiftr` (i2w_s 24#))))
i = I# (w2i ((i2w u) `and#` (i2w 16777215#){-``0x00ffffff''-}))
in
(tag, i)
where
......
ghc/compiler/codeGen/ClosureInfo.lhs
View file @ ca5a4a48
......@@ -25,7 +25,7 @@ module ClosureInfo (
layOutDynClosure, layOutDynCon, layOutStaticClosure,
layOutStaticNoFVClosure, layOutPhantomClosure,
mkVirtHeapOffsets, -- for GHCI
mkVirtHeapOffsets,
nodeMustPointToIt, getEntryConvention,
blackHoleOnEntry,
......
ghc/compiler/coreSyn/PprCore.lhs
View file @ ca5a4a48
......@@ -17,7 +17,7 @@ module PprCore (
pprTypedCoreBinder
-- these are here to make the instances go in 0.26:
#if __GLASGOW_HASKELL__ <= 26
#if __GLASGOW_HASKELL__ <= 30
, GenCoreBinding, GenCoreExpr, GenCoreCaseAlts
, GenCoreCaseDefault, GenCoreArg
#endif
......
ghc/compiler/deSugar/DsUtils.lhs
View file @ ca5a4a48
......@@ -54,7 +54,7 @@ import Type ( mkTyVarTys, mkRhoTy, mkForAllTys, mkFunTys,
import UniqSet ( mkUniqSet, minusUniqSet, uniqSetToList, UniqSet(..) )
import Util ( panic, assertPanic, pprTrace{-ToDo:rm-} )
import PprCore{-ToDo:rm-}
import PprType--ToDo:rm
--import PprType--ToDo:rm
import Pretty--ToDo:rm
import TyVar--ToDo:rm
import Unique--ToDo:rm
......@@ -422,7 +422,7 @@ The general case:
\begin{code}
mkTupleBind tyvars dicts local_global_prs tuple_expr
= pprTrace "mkTupleBind:\n" (ppAboves [ppCat (map (pprId PprShowAll) locals), ppCat (map (pprId PprShowAll) globals), {-ppr PprDebug local_tuple, pprType PprDebug res_ty,-} ppr PprDebug tuple_expr]) $
= --pprTrace "mkTupleBind:\n" (ppAboves [ppCat (map (pprId PprShowAll) locals), ppCat (map (pprId PprShowAll) globals), {-ppr PprDebug local_tuple, pprType PprDebug res_ty,-} ppr PprDebug tuple_expr]) $
newSysLocalDs tuple_var_ty `thenDs` \ tuple_var ->
......
ghc/compiler/deforest/DefExpr.lhs
View file @ ca5a4a48
......@@ -18,7 +18,6 @@
> import Type ( applyTypeEnvToTy, isPrimType,
> SigmaType(..), Type
> IF_ATTACK_PRAGMAS(COMMA cmpUniType)
> )
> import CmdLineOpts ( SwitchResult, switchIsOn )
> import CoreUnfold ( UnfoldingDetails(..) )
......
ghc/compiler/deforest/DefUtils.lhs
View file @ ca5a4a48
......@@ -22,7 +22,6 @@
> import Type ( cloneTyVar, mkTyVarTy, applyTypeEnvToTy,
> tyVarsOfType, TyVar, SigmaType(..)
> IF_ATTACK_PRAGMAS(COMMA cmpTyVar)
> )
> import Literal ( Literal ) -- for Eq Literal
> import CoreSyn
......
ghc/compiler/hsSyn/HsMatches.lhs
View file @ ca5a4a48
......@@ -14,7 +14,7 @@ import Ubiq{-uitous-}
import HsLoop ( HsExpr, nullBinds, HsBinds )
import Outputable ( ifPprShowAll )
import PprType
import PprType ( GenType{-instance Outputable-} )
import Pretty
import SrcLoc ( SrcLoc{-instances-} )
import Util ( panic )
......
ghc/compiler/main/CmdLineOpts.lhs
View file @ ca5a4a48
......@@ -221,10 +221,9 @@ opt_AsmTarget = lookup_str "-fasm="
opt_SccGroup = lookup_str "-G="
opt_ProduceC = lookup_str "-C="
opt_ProduceS = lookup_str "-S="
opt_ProduceHi = lookup_str "-hifile="
opt_ProduceHu = lookup_str "-hufile="
opt_MyHi = lookup_str "-myhifile=" -- the ones produced last time
opt_MyHu = lookup_str "-myhufile=" -- for this module
opt_MustRecompile = lookup SLIT("-fmust-recompile")
opt_ProduceHi = lookup_str "-hifile=" -- the one to produce this time
opt_MyHi = lookup_str "-myhifile=" -- the one produced last time
opt_EnsureSplittableC = lookup_str "-fglobalise-toplev-names="
opt_UnfoldingUseThreshold = lookup_int "-funfolding-use-threshold"
opt_UnfoldingCreationThreshold = lookup_int "-funfolding-creation-threshold"
......@@ -234,7 +233,6 @@ opt_ReturnInRegsThreshold = lookup_int "-freturn-in-regs-threshold"
opt_NoImplicitPrelude = lookup SLIT("-fno-implicit-prelude")
opt_IgnoreIfacePragmas = lookup SLIT("-fignore-interface-pragmas")
opt_HuSuffix = case (lookup_str "-husuffix=") of { Nothing -> ".hu" ; Just x -> x }
opt_HiSuffix = case (lookup_str "-hisuffix=") of { Nothing -> ".hi" ; Just x -> x }
opt_SysHiSuffix = case (lookup_str "-syshisuffix=") of { Nothing -> ".hi" ; Just x -> x }
......
ghc/compiler/main/Main.lhs
View file @ ca5a4a48
......@@ -33,7 +33,6 @@ import Bag ( emptyBag, isEmptyBag )
import CmdLineOpts
import ErrUtils ( pprBagOfErrors, ghcExit )
import Maybes ( maybeToBool, MaybeErr(..) )
import PrelInfo ( builtinNameInfo )