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

Wibbles to the big HsBinds reorg

3 files changed, 33 insertions, 37 deletions

diff --git a/ghc/compiler/hsSyn/HsUtils.lhs b/ghc/compiler/hsSyn/HsUtils.lhs
index 8019f36282..2e33d4e361 100644
--- 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 b18451321c..a0d1c852bb 100644
--- 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 c9f03c3c40..fb7f803ee0 100644
--- 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