[project @ 2005-07-25 11:10:33 by simonpj]

Wibbles to the big HsBinds reorg

diff --git a/ghc/compiler/hsSyn/HsUtils.lhs b/ghc/compiler/hsSyn/HsUtils.lhs
index 8019f36..2e33d4e 100644 (file)
--- a/ghc/compiler/hsSyn/HsUtils.lhs
+++ b/ghc/compiler/hsSyn/HsUtils.lhs
@@ -221,18 +221,17 @@ nlHsFunTy a b             = noLoc (HsFunTy a b)
 %************************************************************************
 
 \begin{code}
-mkVarBind :: SrcSpan -> name -> LHsExpr name -> LHsBind name
-mkVarBind loc var rhs = mk_easy_FunBind loc var [] emptyLHsBinds rhs
+mkVarBind :: SrcSpan -> RdrName -> LHsExpr RdrName -> LHsBind RdrName
+mkVarBind loc var rhs = mk_easy_FunBind loc var [] rhs
 
 ------------
-mk_easy_FunBind :: SrcSpan -> name -> [LPat name]
-               -> LHsBinds name -> LHsExpr name
-               -> LHsBind name
+mk_easy_FunBind :: SrcSpan -> RdrName -> [LPat RdrName]
+               -> LHsExpr RdrName -> LHsBind RdrName
 
-mk_easy_FunBind loc fun pats binds expr
+mk_easy_FunBind loc fun pats expr
   = L loc (FunBind (L loc fun) False{-not infix-} matches placeHolderNames)
   where
-    matches = mkMatchGroup [mk_easy_Match pats binds expr]
+    matches = mkMatchGroup [mkMatch pats expr emptyLocalBinds]
 
 ------------
 mk_FunBind :: SrcSpan -> RdrName
@@ -246,10 +245,6 @@ mk_FunBind loc fun pats_and_exprs
     matches = mkMatchGroup [mkMatch p e emptyLocalBinds | (p,e) <-pats_and_exprs]
 
 ------------
-mk_easy_Match pats binds expr
-  = mkMatch pats expr (HsValBinds (ValBindsIn binds []))
-
-------------
 mkMatch :: [LPat id] -> LHsExpr id -> HsLocalBinds id -> LMatch id
 mkMatch pats expr binds
   = noLoc (Match (map paren pats) Nothing 
@@ -285,7 +280,9 @@ collectLocalBinders EmptyLocalBinds = []
 
 collectHsValBinders :: HsValBinds name -> [Located name]
 collectHsValBinders (ValBindsIn binds sigs) = collectHsBindLocatedBinders binds
-collectHsValBinders (ValBindsOut binds)     = panic "collectHsValBinders"
+collectHsValBinders (ValBindsOut binds)     = foldr collect_one [] binds
+  where
+   collect_one (_,binds) acc = foldrBag (collectAcc . unLoc) acc binds
 
 collectAcc :: HsBind name -> [Located name] -> [Located name]
 collectAcc (PatBind pat _ _ _) acc = collectLocatedPatBinders pat ++ acc

diff --git a/ghc/compiler/typecheck/TcGenDeriv.lhs b/ghc/compiler/typecheck/TcGenDeriv.lhs
index b184513..a0d1c85 100644 (file)
--- a/ghc/compiler/typecheck/TcGenDeriv.lhs
+++ b/ghc/compiler/typecheck/TcGenDeriv.lhs
@@ -167,7 +167,7 @@ gen_Eq_binds tycon
     in
     listToBag [
       mk_FunBind tycon_loc eq_RDR ((map pats_etc nonnullary_cons) ++ rest),
-      mk_easy_FunBind tycon_loc ne_RDR [a_Pat, b_Pat] emptyLHsBinds (
+      mk_easy_FunBind tycon_loc ne_RDR [a_Pat, b_Pat] (
        nlHsApp (nlHsVar not_RDR) (nlHsPar (nlHsVarApps eq_RDR [a_RDR, b_RDR])))
     ]
   where
@@ -298,8 +298,10 @@ gen_Ord_binds tycon
     tycon_loc = getSrcSpan tycon
     --------------------------------------------------------------------
 
-    compare = mk_easy_FunBind tycon_loc compare_RDR
-                                 [a_Pat, b_Pat] (unitBag cmp_eq) compare_rhs
+    compare = L tycon_loc (FunBind (L tycon_loc compare_RDR) False compare_matches placeHolderNames)
+    compare_matches = mkMatchGroup [mkMatch [a_Pat, b_Pat] compare_rhs cmp_eq_binds]
+    cmp_eq_binds    = HsValBinds (ValBindsIn (unitBag cmp_eq) [])
+
     compare_rhs
        | single_con_type = cmp_eq_Expr a_Expr b_Expr
        | otherwise
@@ -417,7 +419,7 @@ gen_Enum_binds tycon
     occ_nm    = getOccString tycon
 
     succ_enum
-      = mk_easy_FunBind tycon_loc succ_RDR [a_Pat] emptyLHsBinds $
+      = mk_easy_FunBind tycon_loc succ_RDR [a_Pat] $
        untag_Expr tycon [(a_RDR, ah_RDR)] $
        nlHsIf (nlHsApps eq_RDR [nlHsVar (maxtag_RDR tycon),
                               nlHsVarApps intDataCon_RDR [ah_RDR]])
@@ -427,7 +429,7 @@ gen_Enum_binds tycon
                                        nlHsIntLit 1]))
                    
     pred_enum
-      = mk_easy_FunBind tycon_loc pred_RDR [a_Pat] emptyLHsBinds $
+      = mk_easy_FunBind tycon_loc pred_RDR [a_Pat] $
        untag_Expr tycon [(a_RDR, ah_RDR)] $
        nlHsIf (nlHsApps eq_RDR [nlHsIntLit 0,
                               nlHsVarApps intDataCon_RDR [ah_RDR]])
@@ -437,7 +439,7 @@ gen_Enum_binds tycon
                                               nlHsLit (HsInt (-1))]))
 
     to_enum
-      = mk_easy_FunBind tycon_loc toEnum_RDR [a_Pat] emptyLHsBinds $
+      = mk_easy_FunBind tycon_loc toEnum_RDR [a_Pat] $
        nlHsIf (nlHsApps and_RDR
                [nlHsApps ge_RDR [nlHsVar a_RDR, nlHsIntLit 0],
                  nlHsApps le_RDR [nlHsVar a_RDR, nlHsVar (maxtag_RDR tycon)]])
@@ -445,7 +447,7 @@ gen_Enum_binds tycon
             (illegal_toEnum_tag occ_nm (maxtag_RDR tycon))
 
     enum_from
-      = mk_easy_FunBind tycon_loc enumFrom_RDR [a_Pat] emptyLHsBinds $
+      = mk_easy_FunBind tycon_loc enumFrom_RDR [a_Pat] $
          untag_Expr tycon [(a_RDR, ah_RDR)] $
          nlHsApps map_RDR 
                [nlHsVar (tag2con_RDR tycon),
@@ -454,7 +456,7 @@ gen_Enum_binds tycon
                            (nlHsVar (maxtag_RDR tycon)))]
 
     enum_from_then
-      = mk_easy_FunBind tycon_loc enumFromThen_RDR [a_Pat, b_Pat] emptyLHsBinds $
+      = mk_easy_FunBind tycon_loc enumFromThen_RDR [a_Pat, b_Pat] $
          untag_Expr tycon [(a_RDR, ah_RDR), (b_RDR, bh_RDR)] $
          nlHsApp (nlHsVarApps map_RDR [tag2con_RDR tycon]) $
            nlHsPar (enum_from_then_to_Expr
@@ -467,7 +469,7 @@ gen_Enum_binds tycon
                           ))
 
     from_enum
-      = mk_easy_FunBind tycon_loc fromEnum_RDR [a_Pat] emptyLHsBinds $
+      = mk_easy_FunBind tycon_loc fromEnum_RDR [a_Pat] $
          untag_Expr tycon [(a_RDR, ah_RDR)] $
          (nlHsVarApps intDataCon_RDR [ah_RDR])
 \end{code}
@@ -579,8 +581,7 @@ gen_Ix_binds tycon
     enum_ixes = listToBag [ enum_range, enum_index, enum_inRange ]
 
     enum_range
-      = mk_easy_FunBind tycon_loc range_RDR 
-               [nlTuplePat [a_Pat, b_Pat] Boxed] emptyLHsBinds $
+      = mk_easy_FunBind tycon_loc range_RDR [nlTuplePat [a_Pat, b_Pat] Boxed] $
          untag_Expr tycon [(a_RDR, ah_RDR)] $
          untag_Expr tycon [(b_RDR, bh_RDR)] $
          nlHsApp (nlHsVarApps map_RDR [tag2con_RDR tycon]) $
@@ -592,7 +593,7 @@ gen_Ix_binds tycon
       = mk_easy_FunBind tycon_loc unsafeIndex_RDR 
                [noLoc (AsPat (noLoc c_RDR) 
                           (nlTuplePat [a_Pat, nlWildPat] Boxed)), 
-                               d_Pat] emptyLHsBinds (
+                               d_Pat] (
           untag_Expr tycon [(a_RDR, ah_RDR)] (
           untag_Expr tycon [(d_RDR, dh_RDR)] (
           let
@@ -605,8 +606,7 @@ gen_Ix_binds tycon
        )
 
     enum_inRange
-      = mk_easy_FunBind tycon_loc inRange_RDR 
-         [nlTuplePat [a_Pat, b_Pat] Boxed, c_Pat] emptyLHsBinds (
+      = mk_easy_FunBind tycon_loc inRange_RDR [nlTuplePat [a_Pat, b_Pat] Boxed, c_Pat] $
          untag_Expr tycon [(a_RDR, ah_RDR)] (
          untag_Expr tycon [(b_RDR, bh_RDR)] (
          untag_Expr tycon [(c_RDR, ch_RDR)] (
@@ -614,7 +614,7 @@ gen_Ix_binds tycon
             (genOpApp (nlHsVar ch_RDR) leInt_RDR (nlHsVar bh_RDR))
          ) {-else-} (
             false_Expr
-         )))))
+         ))))
 
     --------------------------------------------------------------
     single_con_ixes 
@@ -640,7 +640,7 @@ gen_Ix_binds tycon
     --------------------------------------------------------------
     single_con_range
       = mk_easy_FunBind tycon_loc range_RDR 
-         [nlTuplePat [con_pat as_needed, con_pat bs_needed] Boxed] emptyLHsBinds $
+         [nlTuplePat [con_pat as_needed, con_pat bs_needed] Boxed] $
        nlHsDo ListComp stmts con_expr
       where
        stmts = zipWith3Equal "single_con_range" mk_qual as_needed bs_needed cs_needed
@@ -653,7 +653,7 @@ gen_Ix_binds tycon
     single_con_index
       = mk_easy_FunBind tycon_loc unsafeIndex_RDR 
                [nlTuplePat [con_pat as_needed, con_pat bs_needed] Boxed, 
-                con_pat cs_needed] emptyBag
+                con_pat cs_needed] 
                (mk_index (zip3 as_needed bs_needed cs_needed))
       where
        -- index (l1,u1) i1 + rangeSize (l1,u1) * (index (l2,u2) i2 + ...)
@@ -675,9 +675,8 @@ gen_Ix_binds tycon
     single_con_inRange
       = mk_easy_FunBind tycon_loc inRange_RDR 
                [nlTuplePat [con_pat as_needed, con_pat bs_needed] Boxed, 
-                con_pat cs_needed]
-                          emptyLHsBinds (
-         foldl1 and_Expr (zipWith3Equal "single_con_inRange" in_range as_needed bs_needed cs_needed))
+                con_pat cs_needed] $
+         foldl1 and_Expr (zipWith3Equal "single_con_inRange" in_range as_needed bs_needed cs_needed)
       where
        in_range a b c = nlHsApps inRange_RDR [nlTuple [nlHsVar a, nlHsVar b] Boxed,
                                               nlHsVar c]
@@ -994,7 +993,7 @@ gen_Typeable_binds tycon
   = unitBag $
        mk_easy_FunBind tycon_loc 
                (mk_typeOf_RDR tycon)   -- Name of appropriate type0f function
-               [nlWildPat] emptyLHsBinds
+               [nlWildPat] 
                (nlHsApps mkTypeRep_RDR [tycon_rep, nlList []])
   where
     tycon_loc = getSrcSpan tycon
@@ -1100,7 +1099,6 @@ gen_Data_binds fix_env tycon
                         tycon_loc
                         dataTypeOf_RDR
                        [nlWildPat]
-                        emptyLHsBinds
                         (nlHsVar data_type_name)
 
        ------------  $dT

diff --git a/ghc/compiler/typecheck/TcRnDriver.lhs b/ghc/compiler/typecheck/TcRnDriver.lhs
index c9f03c3..fb7f803 100644 (file)
--- a/ghc/compiler/typecheck/TcRnDriver.lhs
+++ b/ghc/compiler/typecheck/TcRnDriver.lhs
@@ -84,7 +84,7 @@ import Outputable
 #ifdef GHCI
 import HsSyn           ( HsStmtContext(..), Stmt(..), HsExpr(..), 
                          HsLocalBinds(..), HsValBinds(..),
-                         LStmt, LHsExpr, LHsType, mkVarBind, 
+                         LStmt, LHsExpr, LHsType, mkMatchGroup, mkMatch, emptyLocalBinds,
                          collectLStmtsBinders, collectLStmtBinders, nlVarPat,
                          placeHolderType, noSyntaxExpr )
 import RdrName         ( GlobalRdrElt(..), globalRdrEnvElts,
@@ -122,7 +122,7 @@ import HscTypes             ( InteractiveContext(..),
                          ModIface(..), icPrintUnqual,
                          Dependencies(..) )
 import BasicTypes      ( Fixity )
-import SrcLoc          ( unLoc, noSrcSpan )
+import SrcLoc          ( unLoc )
 #endif
 
 import FastString      ( mkFastString )
@@ -950,7 +950,8 @@ mkPlan :: LStmt Name -> TcM PlanResult
 mkPlan (L loc (ExprStmt expr _ _))     -- An expression typed at the prompt 
   = do { uniq <- newUnique             -- is treated very specially
        ; let fresh_it  = itName uniq
-             the_bind  = mkVarBind noSrcSpan fresh_it expr
+             the_bind  = L loc $ FunBind (L loc fresh_it) False matches emptyNameSet
+             matches   = mkMatchGroup [mkMatch [] expr emptyLocalBinds]
              let_stmt  = L loc $ LetStmt (HsValBinds (ValBindsIn (unitBag the_bind) []))
              bind_stmt = L loc $ BindStmt (nlVarPat fresh_it) expr
                                           (HsVar bindIOName) noSyntaxExpr