summaryrefslogtreecommitdiff
path: root/ghc/compiler
diff options
context:
space:
mode:
Diffstat (limited to 'ghc/compiler')
-rw-r--r--ghc/compiler/deSugar/DsExpr.lhs2
-rw-r--r--ghc/compiler/deSugar/DsMeta.hs2
-rw-r--r--ghc/compiler/hsSyn/HsBinds.lhs6
-rw-r--r--ghc/compiler/hsSyn/HsSyn.lhs4
-rw-r--r--ghc/compiler/main/CmdLineOpts.lhs1
-rw-r--r--ghc/compiler/main/DriverFlags.hs3
-rw-r--r--ghc/compiler/parser/Lexer.x7
-rw-r--r--ghc/compiler/parser/Parser.y8
-rw-r--r--ghc/compiler/rename/RnExpr.lhs4
-rw-r--r--ghc/compiler/rename/RnSource.lhs10
-rw-r--r--ghc/compiler/typecheck/TcBinds.lhs4
-rw-r--r--ghc/compiler/typecheck/TcHsSyn.lhs4
12 files changed, 20 insertions, 35 deletions
diff --git a/ghc/compiler/deSugar/DsExpr.lhs b/ghc/compiler/deSugar/DsExpr.lhs
index bed0a6fd4d..a26d5a752e 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 51edae1295..f92af145d5 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 7437f09f29..b00b3e9776 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 9f6b53481c..373a240a33 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 b520eee214..caae4cbe21 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 2dc42a28c7..28bb2857a9 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 264b7249bb..997a7d7d88 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 194e457354..7976b1b25f 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 131a66c52f..a575a87aa1 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 35ebab2d41..ee01065696 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 b5d2cb7477..446f198b31 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 dd27a91f08..bb84ca8af7 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' ->
View Lorry Controller Status