Commit c7b38930 authored by simonmar's avatar simonmar

[project @ 2003-12-10 17:25:12 by simonmar]

Cleanups:

- Move the collect* functions from HsSyn into HsUtils.  Check that we
  have a clean separation of utilties over HsSyn, with the generic
  versions in HsUtils, and the specific versions in RdrHsSyn, RnHsSyn
  and TcHsSyn as appropriate.

- Remove the RdrBinding data type, which was really just a nested list
  with O(1) append, and use OrdList instead.  This makes it much clearer
  that there's nothing strange going on.

- Various other minor cleanups.
parent 49fabae4
......@@ -62,9 +62,6 @@ instance OutputableBndr id => Outputable (HsBindGroup id) where
ppr (HsIPBinds ipbinds)
= vcat (map ppr ipbinds)
mkHsBindGroup :: RecFlag -> Bag (LHsBind id) -> HsBindGroup id
mkHsBindGroup is_rec mbinds = HsBindGroup mbinds [] is_rec
-- -----------------------------------------------------------------------------
-- Implicit parameter bindings
......
......@@ -101,94 +101,3 @@ instance (OutputableBndr name)
pp_nonnull [] = empty
pp_nonnull xs = vcat (map ppr xs)
\end{code}
%************************************************************************
%* *
\subsection{Collecting binders from @HsBinds@}
%* *
%************************************************************************
Get all the binders in some @MonoBinds@, IN THE ORDER OF APPEARANCE.
These functions are here, rather than in HsBinds, to avoid a loop between HsPat and HsBinds.
\begin{verbatim}
...
where
(x, y) = ...
f i j = ...
[a, b] = ...
\end{verbatim}
it should return @[x, y, f, a, b]@ (remember, order important).
\begin{code}
collectGroupBinders :: [HsBindGroup name] -> [Located name]
collectGroupBinders groups = foldr collect_group [] groups
where
collect_group (HsBindGroup bag sigs is_rec) acc
= foldrBag (collectAcc . unLoc) acc bag
collect_group (HsIPBinds _) acc = acc
collectAcc :: HsBind name -> [Located name] -> [Located name]
collectAcc (PatBind pat _) acc = collectLocatedPatBinders pat ++ acc
collectAcc (FunBind f _ _) acc = f : acc
collectAcc (VarBind f _) acc = noLoc f : acc
collectAcc (AbsBinds _ _ dbinds _ binds) acc
= [noLoc dp | (_,dp,_) <- dbinds] ++ acc
-- ++ foldr collectAcc acc binds
-- I don't think we want the binders from the nested binds
-- The only time we collect binders from a typechecked
-- binding (hence see AbsBinds) is in zonking in TcHsSyn
collectHsBindBinders :: Bag (LHsBind name) -> [name]
collectHsBindBinders binds = map unLoc (collectHsBindLocatedBinders binds)
collectHsBindLocatedBinders :: Bag (LHsBind name) -> [Located name]
collectHsBindLocatedBinders binds = foldrBag (collectAcc . unLoc) [] binds
\end{code}
%************************************************************************
%* *
\subsection{Getting patterns out of bindings}
%* *
%************************************************************************
Get all the pattern type signatures out of a bunch of bindings
\begin{code}
collectSigTysFromHsBinds :: [LHsBind name] -> [LHsType name]
collectSigTysFromHsBinds binds = concat (map collectSigTysFromHsBind binds)
collectSigTysFromHsBind :: LHsBind name -> [LHsType name]
collectSigTysFromHsBind bind
= go (unLoc bind)
where
go (PatBind pat _) = collectSigTysFromPat pat
go (FunBind f _ ms) = go_matches (map unLoc ms)
-- A binding like x :: a = f y
-- is parsed as FunMonoBind, but for this purpose we
-- want to treat it as a pattern binding
go_matches [] = []
go_matches (Match [] (Just sig) _ : matches) = sig : go_matches matches
go_matches (match : matches) = go_matches matches
\end{code}
\begin{code}
collectStmtsBinders :: [LStmt id] -> [Located id]
collectStmtsBinders = concatMap collectLStmtBinders
collectLStmtBinders = collectStmtBinders . unLoc
collectStmtBinders :: Stmt id -> [Located id]
-- Id Binders for a Stmt... [but what about pattern-sig type vars]?
collectStmtBinders (BindStmt pat _) = collectLocatedPatBinders pat
collectStmtBinders (LetStmt binds) = collectGroupBinders binds
collectStmtBinders (ExprStmt _ _) = []
collectStmtBinders (ResultStmt _) = []
collectStmtBinders (RecStmt ss _ _ _) = collectStmtsBinders ss
collectStmtBinders other = panic "collectStmtBinders"
\end{code}
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
% (c) The University of Glasgow, 1992-2003
%
Collects a variety of helper functions that
construct or analyse HsSyn
Here we collect a variety of helper functions that construct or
analyse HsSyn. All these functions deal with generic HsSyn; functions
which deal with the intantiated versions are located elsewhere:
Parameterised by Module
---------------- -------------
RdrName parser/RdrHsSyn
Name rename/RnHsSyn
Id typecheck/TcHsSyn
\begin{code}
module HsUtils where
......@@ -33,10 +40,13 @@ import Bag
%************************************************************************
%* *
Some useful helpers for constructing expressions
Some useful helpers for constructing syntax
%* *
%************************************************************************
These functions attempt to construct a not-completely-useless SrcSpan
from their components, compared with the nl* functions below which
just attach noSrcSpan to everything.
\begin{code}
mkHsPar :: LHsExpr id -> LHsExpr id
......@@ -119,12 +129,10 @@ mkHsString s = HsString (mkFastString s)
%************************************************************************
%* *
These ones do not pin on useful locations
Used mainly for generated code
Constructing syntax with no location info
%* *
%************************************************************************
\begin{code}
nlHsVar :: id -> LHsExpr id
nlHsVar n = noLoc (HsVar n)
......@@ -239,3 +247,96 @@ mkMatch pats expr binds
L l _ -> L l (ParPat p)
\end{code}
%************************************************************************
%* *
Collecting binders from HsBindGroups and HsBinds
%* *
%************************************************************************
Get all the binders in some HsBindGroups, IN THE ORDER OF APPEARANCE. eg.
...
where
(x, y) = ...
f i j = ...
[a, b] = ...
it should return [x, y, f, a, b] (remember, order important).
\begin{code}
collectGroupBinders :: [HsBindGroup name] -> [Located name]
collectGroupBinders groups = foldr collect_group [] groups
where
collect_group (HsBindGroup bag sigs is_rec) acc
= foldrBag (collectAcc . unLoc) acc bag
collect_group (HsIPBinds _) acc = acc
collectAcc :: HsBind name -> [Located name] -> [Located name]
collectAcc (PatBind pat _) acc = collectLocatedPatBinders pat ++ acc
collectAcc (FunBind f _ _) acc = f : acc
collectAcc (VarBind f _) acc = noLoc f : acc
collectAcc (AbsBinds _ _ dbinds _ binds) acc
= [noLoc dp | (_,dp,_) <- dbinds] ++ acc
-- ++ foldr collectAcc acc binds
-- I don't think we want the binders from the nested binds
-- The only time we collect binders from a typechecked
-- binding (hence see AbsBinds) is in zonking in TcHsSyn
collectHsBindBinders :: Bag (LHsBind name) -> [name]
collectHsBindBinders binds = map unLoc (collectHsBindLocatedBinders binds)
collectHsBindLocatedBinders :: Bag (LHsBind name) -> [Located name]
collectHsBindLocatedBinders binds = foldrBag (collectAcc . unLoc) [] binds
\end{code}
%************************************************************************
%* *
Getting pattern signatures out of bindings
%* *
%************************************************************************
Get all the pattern type signatures out of a bunch of bindings
\begin{code}
collectSigTysFromHsBinds :: [LHsBind name] -> [LHsType name]
collectSigTysFromHsBinds binds = concat (map collectSigTysFromHsBind binds)
collectSigTysFromHsBind :: LHsBind name -> [LHsType name]
collectSigTysFromHsBind bind
= go (unLoc bind)
where
go (PatBind pat _) = collectSigTysFromPat pat
go (FunBind f _ ms) = go_matches (map unLoc ms)
-- A binding like x :: a = f y
-- is parsed as FunMonoBind, but for this purpose we
-- want to treat it as a pattern binding
go_matches [] = []
go_matches (Match [] (Just sig) _ : matches) = sig : go_matches matches
go_matches (match : matches) = go_matches matches
\end{code}
%************************************************************************
%* *
Getting binders from statements
%* *
%************************************************************************
\begin{code}
collectStmtsBinders :: [LStmt id] -> [Located id]
collectStmtsBinders = concatMap collectLStmtBinders
collectLStmtBinders = collectStmtBinders . unLoc
collectStmtBinders :: Stmt id -> [Located id]
-- Id Binders for a Stmt... [but what about pattern-sig type vars]?
collectStmtBinders (BindStmt pat _) = collectLocatedPatBinders pat
collectStmtBinders (LetStmt binds) = collectGroupBinders binds
collectStmtBinders (ExprStmt _ _) = []
collectStmtBinders (ResultStmt _) = []
collectStmtBinders (RecStmt ss _ _ _) = collectStmtsBinders ss
collectStmtBinders other = panic "collectStmtBinders"
\end{code}
......@@ -33,6 +33,7 @@ import CmdLineOpts ( opt_SccProfilingOn )
import Type ( Kind, mkArrowKind, liftedTypeKind )
import BasicTypes ( Boxity(..), Fixity(..), FixityDirection(..), IPName(..),
NewOrData(..), Activation(..) )
import OrdList
import Bag ( emptyBag )
import Panic
......@@ -419,21 +420,21 @@ ops :: { Located [Located RdrName] }
-----------------------------------------------------------------------------
-- Top-Level Declarations
topdecls :: { [RdrBinding] } -- Reversed
: topdecls ';' topdecl { $3 : $1 }
topdecls :: { OrdList (LHsDecl RdrName) } -- Reversed
: topdecls ';' topdecl { $1 `appOL` $3 }
| topdecls ';' { $1 }
| topdecl { [$1] }
| topdecl { $1 }
topdecl :: { RdrBinding }
: tycl_decl { RdrHsDecl (L1 (TyClD (unLoc $1))) }
topdecl :: { OrdList (LHsDecl RdrName) }
: tycl_decl { unitOL (L1 (TyClD (unLoc $1))) }
| 'instance' inst_type where
{ let (binds,sigs) = cvBindsAndSigs (unLoc $3)
in RdrHsDecl (L (comb3 $1 $2 $3) (InstD (InstDecl $2 binds sigs))) }
| 'default' '(' comma_types0 ')' { RdrHsDecl (LL $ DefD (DefaultDecl $3)) }
| 'foreign' fdecl { RdrHsDecl (LL (unLoc $2)) }
| '{-# DEPRECATED' deprecations '#-}' { RdrBindings (reverse $2) }
| '{-# RULES' rules '#-}' { RdrBindings (reverse $2) }
| '$(' exp ')' { RdrHsDecl (LL $ SpliceD (SpliceDecl $2)) }
in unitOL (L (comb3 $1 $2 $3) (InstD (InstDecl $2 binds sigs))) }
| 'default' '(' comma_types0 ')' { unitOL (LL $ DefD (DefaultDecl $3)) }
| 'foreign' fdecl { unitOL (LL (unLoc $2)) }
| '{-# DEPRECATED' deprecations '#-}' { $2 }
| '{-# RULES' rules '#-}' { $2 }
| '$(' exp ')' { unitOL (LL $ SpliceD (SpliceDecl $2)) }
| decl { unLoc $1 }
tycl_decl :: { LTyClDecl RdrName }
......@@ -478,21 +479,21 @@ tycl_hdr :: { Located (LHsContext RdrName, Located RdrName, [LHsTyVarBndr RdrNam
-----------------------------------------------------------------------------
-- Nested declarations
decls :: { Located [RdrBinding] } -- Reversed
: decls ';' decl { LL (unLoc $3 : unLoc $1) }
decls :: { Located (OrdList (LHsDecl RdrName)) } -- Reversed
: decls ';' decl { LL (unLoc $1 `appOL` unLoc $3) }
| decls ';' { LL (unLoc $1) }
| decl { L1 [unLoc $1] }
| {- empty -} { noLoc [] }
| decl { L1 (unLoc $1) }
| {- empty -} { noLoc nilOL }
decllist :: { Located [RdrBinding] } -- Reversed
decllist :: { Located (OrdList (LHsDecl RdrName)) } -- Reversed
: '{' decls '}' { LL (unLoc $2) }
| vocurly decls close { $2 }
where :: { Located [RdrBinding] } -- Reversed
where :: { Located (OrdList (LHsDecl RdrName)) } -- Reversed
-- No implicit parameters
: 'where' decllist { LL (unLoc $2) }
| {- empty -} { noLoc [] }
| {- empty -} { noLoc nilOL }
binds :: { Located [HsBindGroup RdrName] } -- May have implicit parameters
: decllist { L1 [cvBindGroup (unLoc $1)] }
......@@ -507,15 +508,15 @@ wherebinds :: { Located [HsBindGroup RdrName] } -- May have implicit parameters
-----------------------------------------------------------------------------
-- Transformation Rules
rules :: { [RdrBinding] } -- Reversed
: rules ';' rule { $3 : $1 }
rules :: { OrdList (LHsDecl RdrName) } -- Reversed
: rules ';' rule { $1 `snocOL` $3 }
| rules ';' { $1 }
| rule { [$1] }
| {- empty -} { [] }
| rule { unitOL $1 }
| {- empty -} { nilOL }
rule :: { RdrBinding }
rule :: { LHsDecl RdrName }
: STRING activation rule_forall infixexp '=' exp
{ RdrHsDecl (LL $ RuleD (HsRule (getSTRING $1) $2 $3 $4 $6)) }
{ LL $ RuleD (HsRule (getSTRING $1) $2 $3 $4 $6) }
activation :: { Activation } -- Omitted means AlwaysActive
: {- empty -} { AlwaysActive }
......@@ -544,16 +545,17 @@ rule_var :: { RuleBndr RdrName }
-----------------------------------------------------------------------------
-- Deprecations (c.f. rules)
deprecations :: { [RdrBinding] } -- Reversed
: deprecations ';' deprecation { $3 : $1 }
deprecations :: { OrdList (LHsDecl RdrName) } -- Reversed
: deprecations ';' deprecation { $1 `appOL` $3 }
| deprecations ';' { $1 }
| deprecation { [$1] }
| {- empty -} { [] }
| deprecation { $1 }
| {- empty -} { nilOL }
-- SUP: TEMPORARY HACK, not checking for `module Foo'
deprecation :: { RdrBinding }
deprecation :: { OrdList (LHsDecl RdrName) }
: depreclist STRING
{ RdrBindings [ RdrHsDecl (LL $ DeprecD (Deprecation n (getSTRING $2))) | n <- unLoc $1 ] }
{ toOL [ LL $ DeprecD (Deprecation n (getSTRING $2))
| n <- unLoc $1 ] }
-----------------------------------------------------------------------------
......@@ -919,10 +921,10 @@ deriving :: { Located (Maybe (LHsContext RdrName)) }
We can't tell whether to reduce var to qvar until after we've read the signatures.
-}
decl :: { Located RdrBinding }
decl :: { Located (OrdList (LHsDecl RdrName)) }
: sigdecl { $1 }
| infixexp opt_sig rhs {% do { r <- checkValDef $1 $2 (unLoc $3);
return (LL $ RdrValBinding (LL r)) } }
return (LL $ unitOL (LL $ ValD r)) } }
rhs :: { Located (GRHSs RdrName) }
: '=' exp wherebinds { L (comb3 $1 $2 $3) $ GRHSs (unguardedRHS $2) (unLoc $3) placeHolderType }
......@@ -936,23 +938,24 @@ gdrh :: { LGRHS RdrName }
: '|' quals '=' exp { LL $ GRHS (reverse (L (getLoc $4) (ResultStmt $4) :
unLoc $2)) }
sigdecl :: { Located RdrBinding }
sigdecl :: { Located (OrdList (LHsDecl RdrName)) }
: infixexp '::' sigtype
{% do s <- checkValSig $1 $3;
return (LL $ RdrHsDecl (LL $ SigD s)) }
return (LL $ unitOL (LL $ SigD s)) }
-- See the above notes for why we need infixexp here
| var ',' sig_vars '::' sigtype
{ LL $ mkSigDecls [ LL $ Sig n $5 | n <- $1 : unLoc $3 ] }
| infix prec ops { LL $ mkSigDecls [ LL $ FixSig (FixitySig n (Fixity $2 (unLoc $1)))
{ LL $ toOL [ LL $ SigD (Sig n $5) | n <- $1 : unLoc $3 ] }
| infix prec ops { LL $ toOL [ LL $ SigD (FixSig (FixitySig n (Fixity $2 (unLoc $1))))
| n <- unLoc $3 ] }
| '{-# INLINE' activation qvar '#-}'
{ LL $ RdrHsDecl (LL $ SigD (InlineSig True $3 $2)) }
{ LL $ unitOL (LL $ SigD (InlineSig True $3 $2)) }
| '{-# NOINLINE' inverse_activation qvar '#-}'
{ LL $ RdrHsDecl (LL $ SigD (InlineSig False $3 $2)) }
{ LL $ unitOL (LL $ SigD (InlineSig False $3 $2)) }
| '{-# SPECIALISE' qvar '::' sigtypes '#-}'
{ LL $ mkSigDecls [ LL $ SpecSig $2 t | t <- $4] }
{ LL $ toOL [ LL $ SigD (SpecSig $2 t)
| t <- $4] }
| '{-# SPECIALISE' 'instance' inst_type '#-}'
{ LL $ RdrHsDecl (LL $ SigD (SpecInstSig $3)) }
{ LL $ unitOL (LL $ SigD (SpecInstSig $3)) }
-----------------------------------------------------------------------------
-- Expressions
......
%
% (c) The AQUA Project, Glasgow University, 1996-1998
%
\section[RdrHsSyn]{Specialisations of the @HsSyn@ syntax for the reader}
% (c) The University of Glasgow, 1996-2003
(Well, really, for specialisations involving @RdrName@s, even if
they are used somewhat later on in the compiler...)
Functions over HsSyn specialised to RdrName.
\begin{code}
module RdrHsSyn (
RdrBinding(..),
main_RDR_Unqual,
extractHsTyRdrTyVars,
extractHsRhoRdrTyVars, extractGenericPatTyVars,
mkHsOpApp, mkClassDecl,
mkHsNegApp, mkHsIntegral, mkHsFractional,
mkHsDo, mkHsSplice, mkSigDecls,
mkHsDo, mkHsSplice,
mkTyData, mkPrefixCon, mkRecCon,
mkRecConstrOrUpdate, -- HsExp -> [HsFieldUpdate] -> P HsExp
mkBootIface,
......@@ -76,6 +69,7 @@ import Module ( ModuleName )
import SrcLoc
import CStrings ( CLabelString )
import CmdLineOpts ( opt_InPackage )
import OrdList ( OrdList, fromOL )
import Bag ( Bag, emptyBag, snocBag, consBag, foldrBag )
import Outputable
import FastString
......@@ -84,19 +78,6 @@ import Panic
import List ( isSuffixOf, nubBy )
\end{code}
%************************************************************************
%* *
\subsection{Type synonyms}
%* *
%************************************************************************
\begin{code}
main_RDR_Unqual :: RdrName
main_RDR_Unqual = mkUnqual varName FSLIT("main")
-- We definitely don't want an Orig RdrName, because
-- main might, in principle, be imported into module Main
\end{code}
%************************************************************************
%* *
......@@ -104,7 +85,7 @@ main_RDR_Unqual = mkUnqual varName FSLIT("main")
%* *
%************************************************************************
@extractHsTyRdrNames@ finds the free variables of a HsType
extractHsTyRdrNames finds the free variables of a HsType
It's used when making the for-alls explicit.
\begin{code}
......@@ -344,25 +325,6 @@ hsIfaceFDs fds = [ (map rdrNameOcc xs, map rdrNameOcc ys)
| (xs,ys) <- fds ]
\end{code}
%************************************************************************
%* *
\subsection[rdrBinding]{Bindings straight out of the parser}
%* *
%************************************************************************
\begin{code}
data RdrBinding
= -- Value bindings havn't been united with their
-- signatures yet
RdrBindings [RdrBinding] -- Convenience for parsing
| RdrValBinding (LHsBind RdrName)
-- The remainder all fit into the main HsDecl form
| RdrHsDecl (LHsDecl RdrName)
\end{code}
%************************************************************************
%* *
\subsection[cvBinds-etc]{Converting to @HsBinds@, etc.}
......@@ -375,44 +337,39 @@ analyser.
\begin{code}
cvTopDecls :: [RdrBinding] -> [LHsDecl RdrName]
-- Incoming bindings are in reverse order; result is in ordinary order
-- (a) flatten RdrBindings
-- (b) Group together bindings for a single function
cvTopDecls decls
= go [] decls
-- | Groups together bindings for a single function
cvTopDecls :: OrdList (LHsDecl RdrName) -> [LHsDecl RdrName]
cvTopDecls decls = go (fromOL decls)
where
go :: [LHsDecl RdrName] -> [RdrBinding] -> [LHsDecl RdrName]
go acc [] = acc
go acc (RdrBindings ds1 : ds2) = go (go acc ds1) ds2
go acc (RdrHsDecl d : ds) = go (d : acc) ds
go acc (RdrValBinding b : ds) = go (L l (ValD b') : acc) ds'
where
(L l b', ds') = getMonoBind b ds
cvBindGroup :: [RdrBinding] -> HsBindGroup RdrName
go :: [LHsDecl RdrName] -> [LHsDecl RdrName]
go [] = []
go (L l (ValD b) : ds) = L l' (ValD b') : go ds'
where (L l' b', ds') = getMonoBind (L l b) ds
go (d : ds) = d : go ds
cvBindGroup :: OrdList (LHsDecl RdrName) -> HsBindGroup RdrName
cvBindGroup binding
= case (cvBindsAndSigs binding) of { (mbs, sigs) ->
HsBindGroup mbs sigs Recursive -- just one big group for now
}
cvBindsAndSigs :: [RdrBinding] -> (Bag (LHsBind RdrName), [LSig RdrName])
-- Input bindings are in *reverse* order,
-- and contain just value bindings and signatures
cvBindsAndSigs fb
= go (emptyBag, []) fb
cvBindsAndSigs :: OrdList (LHsDecl RdrName)
-> (Bag (LHsBind RdrName), [LSig RdrName])
-- Input decls contain just value bindings and signatures
cvBindsAndSigs fb = go (fromOL fb)
where
go acc [] = acc
go acc (RdrBindings ds1 : ds2) = go (go acc ds1) ds2
go (bs, ss) (RdrHsDecl (L l (SigD s)) : ds) = go (bs, L l s : ss) ds
go (bs, ss) (RdrValBinding b : ds) = go (b' `consBag` bs, ss) ds'
where
(b',ds') = getMonoBind b ds
go [] = (emptyBag, [])
go (L l (SigD s) : ds) = (bs, L l s : ss)
where (bs,ss) = go ds
go (L l (ValD b) : ds) = (b' `consBag` bs, ss)
where (b',ds') = getMonoBind (L l b) ds
(bs,ss) = go ds'
-----------------------------------------------------------------------------
-- Group function bindings into equation groups
getMonoBind :: LHsBind RdrName -> [RdrBinding] -> (LHsBind RdrName, [RdrBinding])
getMonoBind :: LHsBind RdrName -> [LHsDecl RdrName]
-> (LHsBind RdrName, [LHsDecl RdrName])
-- Suppose (b',ds') = getMonoBind b ds
-- ds is a *reversed* list of parsed bindings
-- b is a MonoBinds that has just been read off the front
......@@ -427,7 +384,7 @@ getMonoBind (L loc (FunBind lf@(L _ f) inf mtchs)) binds
| has_args mtchs
= go mtchs loc binds
where
go mtchs1 loc1 (RdrValBinding (L loc2 (FunBind f2 inf2 mtchs2)) : binds)
go mtchs1 loc1 (L loc2 (ValD (FunBind f2 inf2 mtchs2)) : binds)
| f == unLoc f2 = go (mtchs2 ++ mtchs1) loc binds
-- Remember binds is reversed, so glue mtchs2 on the front
-- and use loc2 as the final location
......@@ -796,10 +753,6 @@ checkValSig (L l (HsVar v)) ty | isUnqual v = return (Sig (L l v) ty)
checkValSig (L l other) ty
= parseError l "Type signature given for an expression"
mkSigDecls :: [LSig RdrName] -> RdrBinding
mkSigDecls sigs = RdrBindings [RdrHsDecl (L l (SigD sig)) | L l sig <- sigs]
-- A variable binding is parsed as a FunBind.
isFunLhs :: LHsExpr RdrName -> [LHsExpr RdrName]
......
......@@ -53,7 +53,7 @@ import Module ( Module, mkBasePkgModule, mkHomeModule, mkModuleName )
import OccName ( dataName, tcName, clsName, varName, mkOccFS
)
import RdrName ( RdrName, nameRdrName, mkOrig, rdrNameOcc )
import RdrName ( RdrName, nameRdrName, mkOrig, rdrNameOcc, mkUnqual )
import Unique ( Unique, Uniquable(..), hasKey,
mkPreludeMiscIdUnique, mkPreludeDataConUnique,
mkPreludeTyConUnique, mkPreludeClassUnique,
......@@ -63,8 +63,6 @@ import BasicTypes ( Boxity(..), Arity )
import Name ( Name, mkInternalName, mkExternalName, nameUnique, nameModule )
import SrcLoc ( noSrcLoc )
import FastString
\end{code}
......@@ -345,6 +343,10 @@ mkTupleModule Unboxed _ = gHC_PRIM
%************************************************************************
\begin{code}
main_RDR_Unqual = mkUnqual varName FSLIT("main")
-- We definitely don't want an Orig RdrName, because
-- main might, in principle, be imported into module Main
eq_RDR = nameRdrName eqName
ge_RDR = nameRdrName geName
ne_RDR = varQual_RDR pREL_BASE_Name FSLIT("/=")
......
......@@ -16,14 +16,14 @@ import HsSyn ( IE(..), ieName, ImportDecl(..), LImportDecl,
ForeignDecl(..), HsGroup(..),
collectGroupBinders, tyClDeclNames
)
import RdrHsSyn ( main_RDR_Unqual )
import RnEnv
import IfaceEnv ( lookupOrig, newGlobalBinder )
import LoadIface ( loadSrcInterface )
import TcRnMonad
import FiniteMap
import PrelNames ( pRELUDE_Name, isBuiltInSyntaxName, isUnboundName )
import PrelNames ( pRELUDE_Name, isBuiltInSyntaxName, isUnboundName,
main_RDR_Unqual )
import Module ( Module, ModuleName, moduleName, mkPackageModule,
moduleNameUserString, isHomeModule,
unitModuleEnvByName, unitModuleEnv,
......@@ -46,7 +46,7 @@ import RdrName ( RdrName, rdrNameOcc, setRdrNameSpace,
isLocalGRE, pprNameProvenance )
import Outputable
import Maybes ( isJust, isNothing, catMaybes, mapCatMaybes )
import SrcLoc ( noSrcLoc, Located(..), mkGeneralSrcSpan, srcSpanStart,
import SrcLoc ( noSrcLoc, Located(..), mkGeneralSrcSpan,
unLoc, noLoc )
import ListSetOps ( removeDups )
import Util ( sortLt, notNull )
......
......@@ -22,9 +22,10 @@ import {-# SOURCE #-} TcSplice ( tcSpliceDecls )
import CmdLineOpts ( DynFlag(..), opt_PprStyle_Debug, dopt )
import DriverState ( v_MainModIs, v_MainFunIs )
import HsSyn
import RdrHsSyn ( findSplice, main_RDR_Unqual )
import RdrHsSyn ( findSplice )
import PrelNames ( runIOName, rootMainName, mAIN_Name )
import PrelNames ( runIOName, rootMainName, mAIN_Name,
main_RDR_Unqual )
import RdrName ( RdrName, mkRdrUnqual, emptyGlobalRdrEnv,
plusGlobalRdrEnv )
import TcHsSyn ( zonkTopDecls )
......@@ -56,7 +57,7 @@ import OccName ( mkVarOcc )
import Name ( Name, isExternalName, getSrcLoc, getOccName )
import NameSet
import TyCon ( tyConHasGenerics )
import SrcLoc ( srcLocSpan, Located(..), noLoc, unLoc )
import SrcLoc ( srcLocSpan, Located(..), noLoc )
import Outputable
import HscTypes ( ModGuts(..), HscEnv(..),
GhciMode(..), noDependencies,
......@@ -93,7 +94,7 @@ import Id ( Id, isImplicitId )
import MkId ( unsafeCoerceId )
import TysWiredIn ( mkListTy, unitTy )
import IdInfo ( GlobalIdDetails(..) )
import SrcLoc ( interactiveSrcLoc )
import SrcLoc ( interactiveSrcLoc, unLoc )
import Var ( setGlobalIdDetails )
import Name ( nameOccName, nameModuleName )
import NameEnv ( delListFromNameEnv )
......@@ -104,12 +105,13 @@ import HscTypes ( InteractiveContext(..),
TyThing(..), availNames, icPrintUnqual,
ModIface(..), ModDetails(..) )
import BasicTypes ( RecFlag(..), Fixity )
import Bag ( unitBag )
import Panic ( ghcError, GhcException(..) )
#endif
import FastString ( mkFastString )
import Util ( sortLt )
import Bag ( unionBags, snocBag, unitBag )
import Bag ( unionBags, snocBag )
import Maybe ( isJust )
\end{code}
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment