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.
12 files changed:
= dsLet b2 body `thenDs` \ body' ->
dsLet b1 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)
= foldlDs dsIPBind body binds
where
dsIPBind body (n, e)
= do { core1 <- rep_monobind' bs
; core2 <- rep_sigs' sigs
; return (core1 ++ core2) }
= do { core1 <- rep_monobind' bs
; core2 <- rep_sigs' sigs
; return (core1 ++ core2) }
-rep_binds' (IPBinds _ _)
= panic "DsMeta:repBinds: can't do implicit parameters"
rep_monobind :: MonoBinds Name -> DsM [Core M.DecQ]
= panic "DsMeta:repBinds: can't do implicit parameters"
rep_monobind :: MonoBinds Name -> DsM [Core M.DecQ]
| IPBinds -- Implcit parameters
-- Not allowed at top level
[(IPName id, HsExpr id)]
| IPBinds -- Implcit parameters
-- Not allowed at top level
[(IPName id, HsExpr id)]
- Bool -- True <=> this was a 'with' binding
- -- (tmp, until 'with' is removed)
nullBinds EmptyBinds = True
nullBinds (ThenBinds b1 b2) = nullBinds b1 && nullBinds b2
nullBinds (MonoBind b _ _) = nullMonoBinds b
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
mkMonoBind :: RecFlag -> MonoBinds id -> HsBinds id
mkMonoBind _ EmptyMonoBinds = EmptyBinds
ppr_binds (ThenBinds binds1 binds2)
= ppr_binds binds1 $$ ppr_binds binds2
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
= sep (punctuate semi (map pp_item binds))
where
pp_item (id,rhs) = pprBndr LetBind id <+> equals <+> pprExpr rhs
collectHsBinders :: HsBinds name -> [name]
collectHsBinders EmptyBinds = []
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
-- ordinary bindings
collectHsBinders (MonoBind b _ _) = collectMonoBinders b
collectHsBinders (ThenBinds b1 b2) = collectHsBinders b1 ++ collectHsBinders b2
\begin{code}
collectSigTysFromHsBinds :: HsBinds name -> [HsType name]
collectSigTysFromHsBinds EmptyBinds = []
\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
collectSigTysFromHsBinds (MonoBind b _ _) = collectSigTysFromMonoBinds b
collectSigTysFromHsBinds (ThenBinds b1 b2) = collectSigTysFromHsBinds b1 ++
collectSigTysFromHsBinds b2
| Opt_GlasgowExts
| Opt_FFI
| Opt_PArr -- syntactic support for parallel arrays
| 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
| 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 $
( "warn-deprecations", Opt_WarnDeprecations ),
( "fi", Opt_FFI ), -- support `-ffi'...
( "ffi", Opt_FFI ), -- ...and also `-fffi'
( "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 ),
( "arrows", Opt_Arrows ), -- arrow syntax
( "parr", Opt_PArr ),
( "th", Opt_TH ),
| ITsafe
| ITthreadsafe
| ITunsafe
| ITsafe
| ITthreadsafe
| ITunsafe
| ITstdcallconv
| ITccallconv
| ITdotnet
| ITstdcallconv
| ITccallconv
| ITdotnet
isSpecial ITsafe = True
isSpecial ITthreadsafe = True
isSpecial ITunsafe = True
isSpecial ITsafe = True
isSpecial ITthreadsafe = True
isSpecial ITunsafe = True
isSpecial ITccallconv = True
isSpecial ITstdcallconv = True
isSpecial ITmdo = True
isSpecial ITccallconv = True
isSpecial ITstdcallconv = True
isSpecial ITmdo = True
( "ccall", ITccallconv, bit ffiBit),
( "dotnet", ITdotnet, bit ffiBit),
( "ccall", ITccallconv, bit ffiBit),
( "dotnet", ITdotnet, bit ffiBit),
- ( "with", ITwith, bit withBit),
-
( "rec", ITrec, bit arrowsBit),
( "proc", ITproc, bit arrowsBit)
]
( "rec", ITrec, bit arrowsBit),
( "proc", ITproc, bit arrowsBit)
]
glaExtsBit = 0
ffiBit = 1
parrBit = 2
glaExtsBit = 0
ffiBit = 1
parrBit = 2
arrowsBit = 4
thBit = 5
ipBit = 6
arrowsBit = 4
thBit = 5
ipBit = 6
glaExtsEnabled, ffiEnabled, parrEnabled :: Int -> Bool
glaExtsEnabled flags = testBit flags glaExtsBit
ffiEnabled flags = testBit flags ffiBit
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
parrEnabled flags = testBit flags parrBit
arrowsEnabled flags = testBit flags arrowsBit
thEnabled flags = testBit flags thBit
where
bitmap = glaExtsBit `setBitIf` dopt Opt_GlasgowExts flags
.|. ffiBit `setBitIf` dopt Opt_FFI 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
.|. parrBit `setBitIf` dopt Opt_PArr flags
.|. arrowsBit `setBitIf` dopt Opt_Arrows flags
.|. thBit `setBitIf` dopt Opt_TH flags
{- -*-haskell-*-
-----------------------------------------------------------------------------
{- -*-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 $
'safe' { T _ _ ITsafe }
'threadsafe' { T _ _ ITthreadsafe }
'unsafe' { T _ _ ITunsafe }
'safe' { T _ _ ITsafe }
'threadsafe' { T _ _ ITthreadsafe }
'unsafe' { T _ _ ITunsafe }
- 'with' { T _ _ ITwith }
'mdo' { T _ _ ITmdo }
'stdcall' { T _ _ ITstdcallconv }
'ccall' { T _ _ ITccallconv }
'mdo' { T _ _ ITmdo }
'stdcall' { T _ _ ITstdcallconv }
'ccall' { T _ _ ITccallconv }
binds :: { RdrNameHsBinds } -- May have implicit parameters
: decllist { cvBinds $1 }
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 }
wherebinds :: { RdrNameHsBinds } -- May have implicit parameters
: 'where' binds { $2 }
exp :: { RdrNameHsExpr }
: infixexp '::' sigtype { ExprWithTySig $1 $3 }
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 }
| 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 }
where
-- We do not allow implicit-parameter bindings in a parallel
-- list comprehension. I'm not sure what it might mean.
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 ->
rnNormalStmts ctxt (ParStmt stmtss : stmts)
= doptM Opt_GlasgowExts `thenM` \ opt_GlasgowExts ->
-- It's used only in 'mdo'
rnBinds EmptyBinds = returnM (EmptyBinds, emptyDUs)
rnBinds (MonoBind bind sigs _) = rnMonoBinds NotTopLevel bind sigs
-- 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
returnM (EmptyBinds, emptyDUs)
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
-- 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}
returnM (thing, fvs_thing `plusFV` fv_binds)
\end{code}
rnExpr expr `thenM` \ (expr',fvExpr) ->
rnIPBinds binds `thenM` \ (binds',fvBinds) ->
returnM ((name, expr') : binds', fvExpr `plusFV` fvBinds)
rnExpr expr `thenM` \ (expr',fvExpr) ->
rnIPBinds binds `thenM` \ (binds',fvBinds) ->
returnM ((name, expr') : binds', fvExpr `plusFV` fvBinds)
tc_binds_and_then top_lvl combiner 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') ->
= getLIE do_next `thenM` \ (result, expr_lie) ->
mapAndUnzipM tc_ip_bind binds `thenM` \ (avail_ips, binds') ->
-- discharge any ?x constraints in expr_lie
tcSimplifyIPs avail_ips expr_lie `thenM` \ dict_binds ->
-- 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
combiner (mkMonoBind Recursive dict_binds) result)
where
-- I wonder if we should do these one at at time
) `thenM` \ (env1, new_bind, _) ->
returnM (env1, mkMonoBind is_rec new_bind)
) `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
= 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' ->
where
zonk_ip_bind (n, e)
= mapIPNameTc (zonkIdBndr env) n `thenM` \ n' ->