[project @ 2003-12-10 17:25:12 by simonmar]
authorsimonmar <unknown>
Wed, 10 Dec 2003 17:25:18 +0000 (17:25 +0000)
committersimonmar <unknown>
Wed, 10 Dec 2003 17:25:18 +0000 (17:25 +0000)
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.

ghc/compiler/hsSyn/HsBinds.lhs
ghc/compiler/hsSyn/HsSyn.lhs
ghc/compiler/hsSyn/HsUtils.lhs
ghc/compiler/parser/Parser.y.pp
ghc/compiler/parser/RdrHsSyn.lhs
ghc/compiler/prelude/PrelNames.lhs
ghc/compiler/rename/RnNames.lhs
ghc/compiler/typecheck/TcRnDriver.lhs

index 494ac60..efedcd6 100644 (file)
@@ -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
 
index 7255d1b..2fc0323 100644 (file)
@@ -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}
index dac170b..789887c 100644 (file)
@@ -1,9 +1,16 @@
 %
-% (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}
index b3d6196..4dec2de 100644 (file)
@@ -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
index 3761f74..8d9e17d 100644 (file)
@@ -1,23 +1,16 @@
 %
-% (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]
index f9453ca..f719c4e 100644 (file)
@@ -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("/=")
index eb3d1b0..3abf465 100644 (file)
@@ -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 )
index 03b2e46..7b0a63d 100644 (file)
@@ -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}