Commit 38ef36af authored by simonmar's avatar simonmar

[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.
parent 8f57c3c1
......@@ -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)
......
......@@ -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]
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
-----------------------------------------------------------------------------
-- $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 ),
......
......@@ -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
......
{- -*-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 }
......
......@@ -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 ->
......
......@@ -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}
......
......@@ -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
......
......@@ -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' ->
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment