From 38ef36af81c7fe05f12ead2bb3613cff208d81fe Mon Sep 17 00:00:00 2001 From: simonmar Date: Wed, 24 Sep 2003 13:04:58 +0000 Subject: [PATCH] [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 | 2 +- ghc/compiler/deSugar/DsMeta.hs | 2 +- ghc/compiler/hsSyn/HsBinds.lhs | 6 ++---- ghc/compiler/hsSyn/HsSyn.lhs | 4 ++-- ghc/compiler/main/CmdLineOpts.lhs | 1 - ghc/compiler/main/DriverFlags.hs | 3 +-- ghc/compiler/parser/Lexer.x | 7 ------- ghc/compiler/parser/Parser.y | 8 +++----- ghc/compiler/rename/RnExpr.lhs | 4 ++-- ghc/compiler/rename/RnSource.lhs | 10 ++++------ ghc/compiler/typecheck/TcBinds.lhs | 4 ++-- ghc/compiler/typecheck/TcHsSyn.lhs | 4 ++-- 12 files changed, 20 insertions(+), 35 deletions(-) diff --git a/ghc/compiler/deSugar/DsExpr.lhs b/ghc/compiler/deSugar/DsExpr.lhs index bed0a6f..a26d5a7 100644 --- a/ghc/compiler/deSugar/DsExpr.lhs +++ b/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) diff --git a/ghc/compiler/deSugar/DsMeta.hs b/ghc/compiler/deSugar/DsMeta.hs index 51edae1..f92af14 100644 --- a/ghc/compiler/deSugar/DsMeta.hs +++ b/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] diff --git a/ghc/compiler/hsSyn/HsBinds.lhs b/ghc/compiler/hsSyn/HsBinds.lhs index 7437f09..b00b3e9 100644 --- a/ghc/compiler/hsSyn/HsBinds.lhs +++ b/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 diff --git a/ghc/compiler/hsSyn/HsSyn.lhs b/ghc/compiler/hsSyn/HsSyn.lhs index 9f6b534..373a240 100644 --- a/ghc/compiler/hsSyn/HsSyn.lhs +++ b/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 diff --git a/ghc/compiler/main/CmdLineOpts.lhs b/ghc/compiler/main/CmdLineOpts.lhs index b520eee..caae4cb 100644 --- a/ghc/compiler/main/CmdLineOpts.lhs +++ b/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 diff --git a/ghc/compiler/main/DriverFlags.hs b/ghc/compiler/main/DriverFlags.hs index 2dc42a2..28bb285 100644 --- a/ghc/compiler/main/DriverFlags.hs +++ b/ghc/compiler/main/DriverFlags.hs @@ -1,5 +1,5 @@ ----------------------------------------------------------------------------- --- $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 ), diff --git a/ghc/compiler/parser/Lexer.x b/ghc/compiler/parser/Lexer.x index 264b724..997a7d7 100644 --- a/ghc/compiler/parser/Lexer.x +++ b/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 diff --git a/ghc/compiler/parser/Parser.y b/ghc/compiler/parser/Parser.y index 194e457..7976b1b 100644 --- a/ghc/compiler/parser/Parser.y +++ b/ghc/compiler/parser/Parser.y @@ -1,6 +1,6 @@ {- -*-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 } diff --git a/ghc/compiler/rename/RnExpr.lhs b/ghc/compiler/rename/RnExpr.lhs index 131a66c..a575a87 100644 --- a/ghc/compiler/rename/RnExpr.lhs +++ b/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 -> diff --git a/ghc/compiler/rename/RnSource.lhs b/ghc/compiler/rename/RnSource.lhs index 35ebab2..ee01065 100644 --- a/ghc/compiler/rename/RnSource.lhs +++ b/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} diff --git a/ghc/compiler/typecheck/TcBinds.lhs b/ghc/compiler/typecheck/TcBinds.lhs index b5d2cb7..446f198 100644 --- a/ghc/compiler/typecheck/TcBinds.lhs +++ b/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 diff --git a/ghc/compiler/typecheck/TcHsSyn.lhs b/ghc/compiler/typecheck/TcHsSyn.lhs index dd27a91..bb84ca8 100644 --- a/ghc/compiler/typecheck/TcHsSyn.lhs +++ b/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' -> -- 1.7.10.4