[project @ 2003-09-24 13:04:45 by simonmar]

The concensus seems to be that 'with' should go away now, after its
customary period of deprecation.  Hugs has already removed it, so
we're following suit.

ghc/compiler/deSugar/DsExpr.lhs

@@ -93,7 +93,7 @@ dsLet (ThenBinds b1 b2) body
   = dsLet b2 body 	`thenDs` \ body' ->
     dsLet b1 body'
   
-dsLet (IPBinds binds is_with) body
+dsLet (IPBinds binds) body
   = foldlDs dsIPBind body binds
   where
     dsIPBind body (n, e)

ghc/compiler/deSugar/DsMeta.hs

@@ -658,7 +658,7 @@ rep_binds' (MonoBind bs sigs _)
  = do { core1 <- rep_monobind' bs
       ;	core2 <- rep_sigs' sigs
       ;	return (core1 ++ core2) }
-rep_binds' (IPBinds _ _)
+rep_binds' (IPBinds _)
   = panic "DsMeta:repBinds: can't do implicit parameters"
 
 rep_monobind :: MonoBinds Name -> DsM [Core M.DecQ]

ghc/compiler/hsSyn/HsBinds.lhs

@@ -58,8 +58,6 @@ data HsBinds id		-- binders and bindees
   | IPBinds			-- Implcit parameters
 				-- Not allowed at top level
 	[(IPName id, HsExpr id)]
-	Bool		-- True <=> this was a 'with' binding
-			--  (tmp, until 'with' is removed)
 \end{code}
 
 \begin{code}
@@ -68,7 +66,7 @@ nullBinds :: HsBinds id -> Bool
 nullBinds EmptyBinds		= True
 nullBinds (ThenBinds b1 b2)	= nullBinds b1 && nullBinds b2
 nullBinds (MonoBind b _ _)	= nullMonoBinds b
-nullBinds (IPBinds b _)   	= null b
+nullBinds (IPBinds b)   	= null b
 
 mkMonoBind :: RecFlag -> MonoBinds id -> HsBinds id
 mkMonoBind _      EmptyMonoBinds  = EmptyBinds
@@ -83,7 +81,7 @@ ppr_binds EmptyBinds = empty
 ppr_binds (ThenBinds binds1 binds2)
     = ppr_binds binds1 $$ ppr_binds binds2
 
-ppr_binds (IPBinds binds is_with)
+ppr_binds (IPBinds binds)
   = sep (punctuate semi (map pp_item binds))
   where
     pp_item (id,rhs) = pprBndr LetBind id <+> equals <+> pprExpr rhs

ghc/compiler/hsSyn/HsSyn.lhs

@@ -126,7 +126,7 @@ collectLocatedHsBinders (ThenBinds b1 b2)
 
 collectHsBinders :: HsBinds name -> [name]
 collectHsBinders EmptyBinds 	   = []
-collectHsBinders (IPBinds _ _)	   = []		-- Implicit parameters don't create
+collectHsBinders (IPBinds _)	   = []		-- Implicit parameters don't create
 						-- ordinary bindings
 collectHsBinders (MonoBind b _ _)  = collectMonoBinders b
 collectHsBinders (ThenBinds b1 b2) = collectHsBinders b1 ++ collectHsBinders b2
@@ -165,7 +165,7 @@ Get all the pattern type signatures out of a bunch of bindings
 \begin{code}
 collectSigTysFromHsBinds :: HsBinds name -> [HsType name]
 collectSigTysFromHsBinds EmptyBinds        = [] 
-collectSigTysFromHsBinds (IPBinds _ _)     = [] 
+collectSigTysFromHsBinds (IPBinds _)       = [] 
 collectSigTysFromHsBinds (MonoBind b _ _)  = collectSigTysFromMonoBinds b
 collectSigTysFromHsBinds (ThenBinds b1 b2) = collectSigTysFromHsBinds b1 ++
 					     collectSigTysFromHsBinds b2

ghc/compiler/main/CmdLineOpts.lhs

@@ -283,7 +283,6 @@ data DynFlag
    | Opt_GlasgowExts
    | Opt_FFI
    | Opt_PArr			       -- syntactic support for parallel arrays
-   | Opt_With			       -- deprecated keyword for implicit parms
    | Opt_Arrows			       -- Arrow-notation syntax
    | Opt_TH
    | Opt_ImplicitParams

ghc/compiler/main/DriverFlags.hs

 -----------------------------------------------------------------------------
--- $Id: DriverFlags.hs,v 1.125 2003/09/23 14:32:59 simonmar Exp $
+-- $Id: DriverFlags.hs,v 1.126 2003/09/24 13:04:50 simonmar Exp $
 --
 -- Driver flags
 --
@@ -452,7 +452,6 @@ fFlags = [
   ( "warn-deprecations",         	Opt_WarnDeprecations ),
   ( "fi",				Opt_FFI ),  -- support `-ffi'...
   ( "ffi",				Opt_FFI ),  -- ...and also `-fffi'
-  ( "with",				Opt_With ), -- with keyword
   ( "arrows",				Opt_Arrows ), -- arrow syntax
   ( "parr",				Opt_PArr ),
   ( "th",				Opt_TH ),

ghc/compiler/parser/Lexer.x

@@ -334,7 +334,6 @@ data Token__
   | ITsafe
   | ITthreadsafe
   | ITunsafe
-  | ITwith
   | ITstdcallconv
   | ITccallconv
   | ITdotnet
@@ -455,7 +454,6 @@ isSpecial ITdynamic   	= True
 isSpecial ITsafe    	= True
 isSpecial ITthreadsafe 	= True
 isSpecial ITunsafe    	= True
-isSpecial ITwith      	= True
 isSpecial ITccallconv   = True
 isSpecial ITstdcallconv = True
 isSpecial ITmdo		= True
@@ -514,8 +512,6 @@ reservedWordsFM = listToUFM $
 	( "ccall",      ITccallconv,	 bit ffiBit),
 	( "dotnet",     ITdotnet,	 bit ffiBit),
 
-	( "with",	ITwith,		 bit withBit),
-
 	( "rec",	ITrec,		 bit arrowsBit),
 	( "proc",	ITproc,		 bit arrowsBit)
      ]
@@ -1187,7 +1183,6 @@ glaExtsBit, ffiBit, parrBit :: Int
 glaExtsBit = 0
 ffiBit	   = 1
 parrBit	   = 2
-withBit	   = 3
 arrowsBit  = 4
 thBit	   = 5
 ipBit      = 6
@@ -1195,7 +1190,6 @@ ipBit      = 6
 glaExtsEnabled, ffiEnabled, parrEnabled :: Int -> Bool
 glaExtsEnabled flags = testBit flags glaExtsBit
 ffiEnabled     flags = testBit flags ffiBit
-withEnabled    flags = testBit flags withBit
 parrEnabled    flags = testBit flags parrBit
 arrowsEnabled  flags = testBit flags arrowsBit
 thEnabled      flags = testBit flags thBit
@@ -1218,7 +1212,6 @@ mkPState buf loc flags  =
     where
       bitmap =     glaExtsBit `setBitIf` dopt Opt_GlasgowExts flags
 	       .|. ffiBit     `setBitIf` dopt Opt_FFI         flags
-	       .|. withBit    `setBitIf` dopt Opt_With	      flags
 	       .|. parrBit    `setBitIf` dopt Opt_PArr        flags
 	       .|. arrowsBit  `setBitIf` dopt Opt_Arrows      flags
 	       .|. thBit      `setBitIf` dopt Opt_TH          flags

ghc/compiler/parser/Parser.y

 {-								-*-haskell-*-
 -----------------------------------------------------------------------------
-$Id: Parser.y,v 1.124 2003/09/23 14:33:02 simonmar Exp $
+$Id: Parser.y,v 1.125 2003/09/24 13:04:51 simonmar Exp $
 
 Haskell grammar.
 
@@ -127,7 +127,6 @@ Conflicts: 29 shift/reduce, [SDM 19/9/2002]
  'safe'		{ T _ _ ITsafe }
  'threadsafe'	{ T _ _ ITthreadsafe }
  'unsafe'	{ T _ _ ITunsafe }
- 'with' 	{ T _ _ ITwith }
  'mdo'		{ T _ _ ITmdo }
  'stdcall'      { T _ _ ITstdcallconv }
  'ccall'        { T _ _ ITccallconv }
@@ -461,8 +460,8 @@ where 	:: { [RdrBinding] }	-- Reversed
 
 binds 	::  { RdrNameHsBinds }	-- May have implicit parameters
 	: decllist			{ cvBinds $1 }
-	| '{'            dbinds '}'	{ IPBinds $2 False{-not with-} }
-	|     vocurly    dbinds close	{ IPBinds $2 False{-not with-} }
+	| '{'            dbinds '}'	{ IPBinds $2 }
+	|     vocurly    dbinds close	{ IPBinds $2 }
 
 wherebinds :: { RdrNameHsBinds }	-- May have implicit parameters
 	: 'where' binds			{ $2 }
@@ -909,7 +908,6 @@ sigdecl :: { RdrBinding }
 
 exp   :: { RdrNameHsExpr }
 	: infixexp '::' sigtype		{ ExprWithTySig $1 $3 }
-	| infixexp 'with' dbinding	{ HsLet (IPBinds $3 True{-not a let-}) $1 }
 	| fexp srcloc '-<' exp		{ HsArrApp $1 $4 placeHolderType HsFirstOrderApp True $2 }
 	| fexp srcloc '>-' exp		{ HsArrApp $4 $1 placeHolderType HsFirstOrderApp False $2 }
 	| fexp srcloc '-<<' exp		{ HsArrApp $1 $4 placeHolderType HsHigherOrderApp True $2 }

ghc/compiler/rename/RnExpr.lhs

@@ -717,8 +717,8 @@ rnNormalStmts ctxt (LetStmt binds : stmts)
   where
 	-- We do not allow implicit-parameter bindings in a parallel
 	-- list comprehension.  I'm not sure what it might mean.
-    ok (ParStmtCtxt _) (IPBinds _ _) = False	
-    ok _	       _	     = True
+    ok (ParStmtCtxt _) (IPBinds _) = False	
+    ok _	       _	   = True
 
 rnNormalStmts ctxt (ParStmt stmtss : stmts)
   = doptM Opt_GlasgowExts		`thenM` \ opt_GlasgowExts ->

ghc/compiler/rename/RnSource.lhs

@@ -270,7 +270,7 @@ rnBinds    :: RdrNameHsBinds -> RnM (RenamedHsBinds, DefUses)
 -- It's used only in 'mdo'
 rnBinds EmptyBinds	       = returnM (EmptyBinds, emptyDUs)
 rnBinds (MonoBind bind sigs _) = rnMonoBinds NotTopLevel bind sigs
-rnBinds b@(IPBinds bind _)     = addErr (badIpBinds b)	`thenM_` 
+rnBinds b@(IPBinds bind)       = addErr (badIpBinds b)	`thenM_` 
 			         returnM (EmptyBinds, emptyDUs)
 
 rnBindsAndThen	:: RdrNameHsBinds 
@@ -281,10 +281,9 @@ rnBindsAndThen	:: RdrNameHsBinds
 -- The parser doesn't produce ThenBinds
 rnBindsAndThen EmptyBinds	       thing_inside = thing_inside EmptyBinds
 rnBindsAndThen (MonoBind bind sigs _)  thing_inside = rnMonoBindsAndThen bind sigs thing_inside
-rnBindsAndThen (IPBinds binds is_with) thing_inside
-  = warnIf is_with withWarning			`thenM_`
-    rnIPBinds binds				`thenM` \ (binds',fv_binds) ->
-    thing_inside (IPBinds binds' is_with)	`thenM` \ (thing, fvs_thing) ->
+rnBindsAndThen (IPBinds binds) thing_inside
+  = rnIPBinds binds				`thenM` \ (binds',fv_binds) ->
+    thing_inside (IPBinds binds')		`thenM` \ (thing, fvs_thing) ->
     returnM (thing, fvs_thing `plusFV` fv_binds)
 \end{code}
 
@@ -302,7 +301,6 @@ rnIPBinds ((n, expr) : binds)
     rnExpr expr			`thenM` \ (expr',fvExpr) ->
     rnIPBinds binds		`thenM` \ (binds',fvBinds) ->
     returnM ((name, expr') : binds', fvExpr `plusFV` fvBinds)
-
 \end{code}
 
 

ghc/compiler/typecheck/TcBinds.lhs

@@ -121,7 +121,7 @@ tc_binds_and_then top_lvl combiner (ThenBinds b1 b2) do_next
     tc_binds_and_then top_lvl combiner b2	$
     do_next
 
-tc_binds_and_then top_lvl combiner (IPBinds binds is_with) do_next
+tc_binds_and_then top_lvl combiner (IPBinds binds) do_next
   = getLIE do_next			`thenM` \ (result, expr_lie) ->
     mapAndUnzipM tc_ip_bind binds	`thenM` \ (avail_ips, binds') ->
 
@@ -129,7 +129,7 @@ tc_binds_and_then top_lvl combiner (IPBinds binds is_with) do_next
 	-- discharge any ?x constraints in expr_lie
     tcSimplifyIPs avail_ips expr_lie	`thenM` \ dict_binds ->
 
-    returnM (combiner (IPBinds binds' is_with) $
+    returnM (combiner (IPBinds binds') $
 	     combiner (mkMonoBind Recursive dict_binds) result)
   where
 	-- I wonder if we should do these one at at time

ghc/compiler/typecheck/TcHsSyn.lhs

@@ -362,12 +362,12 @@ zonkBinds env (MonoBind bind sigs is_rec)
     )				`thenM` \ (env1, new_bind, _) ->
    returnM (env1, mkMonoBind is_rec new_bind)
 
-zonkBinds env (IPBinds binds is_with)
+zonkBinds env (IPBinds binds)
   = mappM zonk_ip_bind binds	`thenM` \ new_binds ->
     let
 	env1 = extendZonkEnv env (map (ipNameName . fst) new_binds)
     in
-    returnM (env1, IPBinds new_binds is_with)
+    returnM (env1, IPBinds new_binds)
   where
     zonk_ip_bind (n, e)
 	= mapIPNameTc (zonkIdBndr env) n	`thenM` \ n' ->