[project @ 2002-06-05 14:39:27 by simonpj]
[ghc-hetmet.git] / ghc / compiler / rename / RnExpr.lhs
index 62e228f..fd08c0f 100644 (file)
@@ -18,37 +18,42 @@ module RnExpr (
 #include "HsVersions.h"
 
 import {-# SOURCE #-} RnBinds  ( rnBinds ) 
-import {-# SOURCE #-} RnSource ( rnHsTypeFVs )
 
 import HsSyn
 import RdrHsSyn
 import RnHsSyn
 import RnMonad
 import RnEnv
-import RnHiFiles       ( lookupFixityRn )
-import RdrName         ( isRdrTyVar )
+import RnTypes         ( rnHsTypeFVs, precParseErr, sectionPrecErr )
 import CmdLineOpts     ( DynFlag(..), opt_IgnoreAsserts )
 import Literal         ( inIntRange, inCharRange )
-import BasicTypes      ( Fixity(..), FixityDirection(..), defaultFixity, negateFixity )
+import BasicTypes      ( Fixity(..), FixityDirection(..), IPName(..),
+                         defaultFixity, negateFixity, compareFixity )
 import PrelNames       ( hasKey, assertIdKey, 
-                         eqClass_RDR, foldr_RDR, build_RDR, eqString_RDR,
-                         cCallableClass_RDR, cReturnableClass_RDR, 
-                         monadClass_RDR, enumClass_RDR, ordClass_RDR,
-                         ratioDataCon_RDR, assertErr_RDR,
-                         ioDataCon_RDR, plusInteger_RDR, timesInteger_RDR,
-                       )
+                         eqClassName, foldrName, buildName, eqStringName,
+                         cCallableClassName, cReturnableClassName, 
+                         monadClassName, enumClassName, ordClassName,
+                         ratioDataConName, splitName, fstName, sndName,
+                         ioDataConName, plusIntegerName, timesIntegerName,
+                         assertErr_RDR,
+                         replicatePName, mapPName, filterPName,
+                         falseDataConName, trueDataConName, crossPName,
+                         zipPName, lengthPName, indexPName, toPName,
+                         enumFromToPName, enumFromThenToPName, 
+                         fromIntegerName, fromRationalName, minusName, negateName,
+                         failMName, bindMName, thenMName, returnMName )
 import TysPrim         ( charPrimTyCon, addrPrimTyCon, intPrimTyCon, 
-                         floatPrimTyCon, doublePrimTyCon
-                       )
+                         floatPrimTyCon, doublePrimTyCon )
 import TysWiredIn      ( intTyCon )
-import Name            ( NamedThing(..), mkSysLocalName, nameSrcLoc )
+import Name            ( NamedThing(..), mkSystemName, nameSrcLoc )
 import NameSet
+import UnicodeUtil     ( stringToUtf8 )
 import UniqFM          ( isNullUFM )
-import FiniteMap       ( elemFM )
 import UniqSet         ( emptyUniqSet )
 import List            ( intersectBy )
 import ListSetOps      ( removeDups )
 import Outputable
+import FastString
 \end{code}
 
 
@@ -81,24 +86,29 @@ rnPat (SigPatIn pat ty)
     doc = text "a pattern type-signature"
     
 rnPat (LitPatIn s@(HsString _)) 
-  = lookupOrigName eqString_RDR                `thenRn` \ eq ->
-    returnRn (LitPatIn s, unitFV eq)
+  = returnRn (LitPatIn s, unitFV eqStringName)
 
 rnPat (LitPatIn lit) 
   = litFVs lit         `thenRn` \ fvs ->
     returnRn (LitPatIn lit, fvs) 
 
-rnPat (NPatIn lit) 
+rnPat (NPatIn lit mb_neg) 
   = rnOverLit lit                      `thenRn` \ (lit', fvs1) ->
-    lookupOrigName eqClass_RDR         `thenRn` \ eq   ->      -- Needed to find equality on pattern
-    returnRn (NPatIn lit', fvs1 `addOneFV` eq)
-
-rnPat (NPlusKPatIn name lit minus)
+    (case mb_neg of
+       Nothing  -> returnRn (Nothing, emptyFVs)
+       Just neg -> lookupSyntaxName neg        `thenRn` \ neg' ->
+                   returnRn (Just neg', unitFV neg')
+    )                                  `thenRn` \ (mb_neg', fvs2) ->
+    returnRn (NPatIn lit' mb_neg', 
+             fvs1 `plusFV` fvs2 `addOneFV` eqClassName)        
+       -- Needed to find equality on pattern
+
+rnPat (NPlusKPatIn name lit _)
   = rnOverLit lit                      `thenRn` \ (lit', fvs) ->
-    lookupOrigName ordClass_RDR                `thenRn` \ ord ->
     lookupBndrRn name                  `thenRn` \ name' ->
-    lookupSyntaxName minus             `thenRn` \ minus' ->
-    returnRn (NPlusKPatIn name' lit' minus', fvs `addOneFV` ord `addOneFV` minus')
+    lookupSyntaxName minusName         `thenRn` \ minus ->
+    returnRn (NPlusKPatIn name' lit' minus, 
+             fvs `addOneFV` ordClassName `addOneFV` minus)
 
 rnPat (LazyPatIn pat)
   = rnPat pat          `thenRn` \ (pat', fvs) ->
@@ -136,6 +146,13 @@ rnPat (ListPatIn pats)
   = mapFvRn rnPat pats                 `thenRn` \ (patslist, fvs) ->
     returnRn (ListPatIn patslist, fvs `addOneFV` listTyCon_name)
 
+rnPat (PArrPatIn pats)
+  = mapFvRn rnPat pats                 `thenRn` \ (patslist, fvs) ->
+    returnRn (PArrPatIn patslist, 
+             fvs `plusFV` implicit_fvs `addOneFV` parrTyCon_name)
+  where
+    implicit_fvs = mkFVs [lengthPName, indexPName]
+
 rnPat (TuplePatIn pats boxed)
   = mapFvRn rnPat pats                                    `thenRn` \ (patslist, fvs) ->
     returnRn (TuplePatIn patslist boxed, fvs `addOneFV` tycon_name)
@@ -147,8 +164,8 @@ rnPat (RecPatIn con rpats)
     rnRpats rpats      `thenRn` \ (rpats', fvs) ->
     returnRn (RecPatIn con' rpats', fvs `addOneFV` con')
 
-rnPat (TypePatIn name) =
-    rnHsTypeFVs (text "type pattern") name     `thenRn` \ (name', fvs) ->
+rnPat (TypePatIn name)
+  = rnHsTypeFVs (text "type pattern") name     `thenRn` \ (name', fvs) ->
     returnRn (TypePatIn name', fvs)
 \end{code}
 
@@ -161,7 +178,7 @@ rnPat (TypePatIn name) =
 \begin{code}
 rnMatch :: HsMatchContext RdrName -> RdrNameMatch -> RnMS (RenamedMatch, FreeVars)
 
-rnMatch ctxt match@(Match _ pats maybe_rhs_sig grhss)
+rnMatch ctxt match@(Match pats maybe_rhs_sig grhss)
   = pushSrcLocRn (getMatchLoc match)   $
 
        -- Bind pattern-bound type variables
@@ -173,7 +190,7 @@ rnMatch ctxt match@(Match _ pats maybe_rhs_sig grhss)
        doc_sig     = text "In a result type-signature"
        doc_pat     = pprMatchContext ctxt
     in
-    bindPatSigTyVars (rhs_sig_tys ++ pat_sig_tys)      $ \ sig_tyvars ->
+    bindPatSigTyVars (rhs_sig_tys ++ pat_sig_tys)      $ 
 
        -- Note that we do a single bindLocalsRn for all the
        -- matches together, so that we spot the repeated variable in
@@ -198,25 +215,11 @@ rnMatch ctxt match@(Match _ pats maybe_rhs_sig grhss)
     in
     warnUnusedMatches unused_binders           `thenRn_`
     
-    returnRn (Match sig_tyvars pats' maybe_rhs_sig' grhss', all_fvs)
+    returnRn (Match pats' maybe_rhs_sig' grhss', all_fvs)
        -- The bindLocals and bindTyVars will remove the bound FVs
-
-
-bindPatSigTyVars :: [RdrNameHsType]
-                -> ([Name] -> RnMS (a, FreeVars))
-                -> RnMS (a, FreeVars)
-  -- Find the type variables in the pattern type 
-  -- signatures that must be brought into scope
-bindPatSigTyVars tys thing_inside
-  = getLocalNameEnv                    `thenRn` \ name_env ->
-    let
-       tyvars_in_sigs = extractSomeHsTysRdrNames isRdrTyVar tys
-       forall_tyvars  = filter (not . (`elemFM` name_env)) tyvars_in_sigs
-       doc_sig        = text "In a pattern type-signature"
-    in
-    bindNakedTyVarsFVRn doc_sig forall_tyvars thing_inside
 \end{code}
 
+
 %************************************************************************
 %*                                                                     *
 \subsubsection{Guarded right-hand sides (GRHSs)}
@@ -294,7 +297,12 @@ rnExpr (HsVar v)
 
 rnExpr (HsIPVar v)
   = newIPName v                        `thenRn` \ name ->
-    returnRn (HsIPVar name, emptyFVs)
+    let 
+       fvs = case name of
+               Linear _  -> mkFVs [splitName, fstName, sndName]
+               Dupable _ -> emptyFVs 
+    in   
+    returnRn (HsIPVar name, fvs)
 
 rnExpr (HsLit lit) 
   = litFVs lit         `thenRn` \ fvs -> 
@@ -333,11 +341,11 @@ rnExpr (OpApp e1 op _ e2)
     returnRn (final_e,
              fv_e1 `plusFV` fv_op `plusFV` fv_e2)
 
-rnExpr (NegApp e neg_name)
+rnExpr (NegApp e _)
   = rnExpr e                   `thenRn` \ (e', fv_e) ->
-    lookupSyntaxName neg_name  `thenRn` \ neg_name' ->
-    mkNegAppRn e' neg_name'    `thenRn` \ final_e ->
-    returnRn (final_e, fv_e `addOneFV` neg_name')
+    lookupSyntaxName negateName        `thenRn` \ neg_name ->
+    mkNegAppRn e' neg_name     `thenRn` \ final_e ->
+    returnRn (final_e, fv_e `addOneFV` neg_name)
 
 rnExpr (HsPar e)
   = rnExpr e           `thenRn` \ (e', fvs_e) ->
@@ -346,23 +354,23 @@ rnExpr (HsPar e)
 rnExpr section@(SectionL expr op)
   = rnExpr expr                                        `thenRn` \ (expr', fvs_expr) ->
     rnExpr op                                  `thenRn` \ (op', fvs_op) ->
-    checkSectionPrec "left" section op' expr'  `thenRn_`
+    checkSectionPrec InfixL section op' expr' `thenRn_`
     returnRn (SectionL expr' op', fvs_op `plusFV` fvs_expr)
 
 rnExpr section@(SectionR op expr)
   = rnExpr op                                  `thenRn` \ (op',   fvs_op) ->
     rnExpr expr                                        `thenRn` \ (expr', fvs_expr) ->
-    checkSectionPrec "right" section op' expr' `thenRn_`
+    checkSectionPrec InfixR section op' expr'  `thenRn_`
     returnRn (SectionR op' expr', fvs_op `plusFV` fvs_expr)
 
 rnExpr (HsCCall fun args may_gc is_casm _)
        -- Check out the comment on RnIfaces.getNonWiredDataDecl about ccalls
-  = lookupOrigNames [cCallableClass_RDR, 
-                         cReturnableClass_RDR, 
-                         ioDataCon_RDR]        `thenRn` \ implicit_fvs ->
+  = lookupOrigNames [] `thenRn` \ implicit_fvs ->
     rnExprs args                               `thenRn` \ (args', fvs_args) ->
     returnRn (HsCCall fun args' may_gc is_casm placeHolderType, 
-             fvs_args `plusFV` implicit_fvs)
+             fvs_args `plusFV` mkFVs [cCallableClassName, 
+                                      cReturnableClassName, 
+                                      ioDataConName])
 
 rnExpr (HsSCC lbl expr)
   = rnExpr expr                `thenRn` \ (expr', fvs_expr) ->
@@ -379,32 +387,51 @@ rnExpr (HsLet binds expr)
     rnExpr expr                         `thenRn` \ (expr',fvExpr) ->
     returnRn (HsLet binds' expr', fvExpr)
 
-rnExpr (HsWith expr binds)
-  = rnExpr expr                        `thenRn` \ (expr',fvExpr) ->
+rnExpr (HsWith expr binds is_with)
+  = warnCheckRn (not is_with) withWarning `thenRn_`
+    rnExpr expr                        `thenRn` \ (expr',fvExpr) ->
     rnIPBinds binds            `thenRn` \ (binds',fvBinds) ->
-    returnRn (HsWith expr' binds', fvExpr `plusFV` fvBinds)
+    returnRn (HsWith expr' binds' is_with, fvExpr `plusFV` fvBinds)
 
-rnExpr e@(HsDo do_or_lc stmts src_loc)
+rnExpr e@(HsDo do_or_lc stmts _ ty src_loc)
   = pushSrcLocRn src_loc $
-    lookupOrigNames implicit_rdr_names `thenRn` \ implicit_fvs ->
     rnStmts stmts                      `thenRn` \ ((_, stmts'), fvs) ->
-       -- check the statement list ends in an expression
+
+       -- Check the statement list ends in an expression
     case last stmts' of {
        ResultStmt _ _ -> returnRn () ;
        _              -> addErrRn (doStmtListErr e)
     }                                  `thenRn_`
-    returnRn (HsDo do_or_lc stmts' src_loc, fvs `plusFV` implicit_fvs)
+
+       -- Generate the rebindable syntax for the monad
+    (case do_or_lc of
+       DoExpr -> mapRn lookupSyntaxName monad_names
+       other  -> returnRn []
+    )                                  `thenRn` \ monad_names' ->
+
+    returnRn (HsDo do_or_lc stmts' monad_names' placeHolderType src_loc, 
+             fvs `plusFV` implicit_fvs)
   where
-    implicit_rdr_names = [foldr_RDR, build_RDR, monadClass_RDR]
+    monad_names = [returnMName, failMName, bindMName, thenMName]
+
+    implicit_fvs = case do_or_lc of
+      PArrComp -> mkFVs [replicatePName, mapPName, filterPName,
+                        falseDataConName, trueDataConName, crossPName,
+                        zipPName]
+      _        -> mkFVs [foldrName, buildName, monadClassName]
        -- Monad stuff should not be necessary for a list comprehension
        -- but the typechecker looks up the bind and return Ids anyway
        -- Oh well.
 
-
 rnExpr (ExplicitList _ exps)
   = rnExprs exps                       `thenRn` \ (exps', fvs) ->
     returnRn  (ExplicitList placeHolderType exps', fvs `addOneFV` listTyCon_name)
 
+rnExpr (ExplicitPArr _ exps)
+  = rnExprs exps                       `thenRn` \ (exps', fvs) ->
+    returnRn  (ExplicitPArr placeHolderType exps', 
+              fvs `addOneFV` toPName `addOneFV` parrTyCon_name)
+
 rnExpr (ExplicitTuple exps boxity)
   = rnExprs exps                               `thenRn` \ (exps', fvs) ->
     returnRn (ExplicitTuple exps' boxity, fvs `addOneFV` tycon_name)
@@ -437,12 +464,11 @@ rnExpr (HsType a)
   = rnHsTypeFVs doc a  `thenRn` \ (t, fvT) -> 
     returnRn (HsType t, fvT)
   where 
-    doc = text "renaming a type pattern"
+    doc = text "in a type argument"
 
 rnExpr (ArithSeqIn seq)
-  = lookupOrigName enumClass_RDR       `thenRn` \ enum ->
-    rn_seq seq                         `thenRn` \ (new_seq, fvs) ->
-    returnRn (ArithSeqIn new_seq, fvs `addOneFV` enum)
+  = rn_seq seq                         `thenRn` \ (new_seq, fvs) ->
+    returnRn (ArithSeqIn new_seq, fvs `addOneFV` enumClassName)
   where
     rn_seq (From expr)
      = rnExpr expr     `thenRn` \ (expr', fvExpr) ->
@@ -464,6 +490,28 @@ rnExpr (ArithSeqIn seq)
        rnExpr expr3    `thenRn` \ (expr3', fvExpr3) ->
        returnRn (FromThenTo expr1' expr2' expr3',
                  plusFVs [fvExpr1, fvExpr2, fvExpr3])
+
+rnExpr (PArrSeqIn seq)
+  = rn_seq seq                        `thenRn` \ (new_seq, fvs) ->
+    returnRn (PArrSeqIn new_seq, 
+             fvs `plusFV` mkFVs [enumFromToPName, enumFromThenToPName])
+  where
+
+    -- the parser shouldn't generate these two
+    --
+    rn_seq (From     _  ) = panic "RnExpr.rnExpr: Infinite parallel array!"
+    rn_seq (FromThen _ _) = panic "RnExpr.rnExpr: Infinite parallel array!"
+
+    rn_seq (FromTo expr1 expr2)
+     = rnExpr expr1    `thenRn` \ (expr1', fvExpr1) ->
+       rnExpr expr2    `thenRn` \ (expr2', fvExpr2) ->
+       returnRn (FromTo expr1' expr2', fvExpr1 `plusFV` fvExpr2)
+    rn_seq (FromThenTo expr1 expr2 expr3)
+     = rnExpr expr1    `thenRn` \ (expr1', fvExpr1) ->
+       rnExpr expr2    `thenRn` \ (expr2', fvExpr2) ->
+       rnExpr expr3    `thenRn` \ (expr3', fvExpr3) ->
+       returnRn (FromThenTo expr1' expr2' expr3',
+                 plusFVs [fvExpr1, fvExpr2, fvExpr3])
 \end{code}
 
 These three are pattern syntax appearing in expressions.
@@ -587,7 +635,7 @@ rnStmt (ParStmt stmtss) thing_inside
 rnStmt (BindStmt pat expr src_loc) thing_inside
   = pushSrcLocRn src_loc $
     rnExpr expr                                        `thenRn` \ (expr', fv_expr) ->
-    bindPatSigTyVars (collectSigTysFromPat pat)        $ \ sig_tyvars ->
+    bindPatSigTyVars (collectSigTysFromPat pat)        $ 
     bindLocalsFVRn doc (collectPatBinders pat) $ \ new_binders ->
     rnPat pat                                  `thenRn` \ (pat', fv_pat) ->
     thing_inside (BindStmt pat' expr' src_loc) `thenRn` \ ((rest_binders, result), fvs) ->
@@ -735,7 +783,7 @@ checkPrecMatch :: Bool -> Name -> RenamedMatch -> RnMS ()
 checkPrecMatch False fn match
   = returnRn ()
 
-checkPrecMatch True op (Match _ (p1:p2:_) _ _)
+checkPrecMatch True op (Match (p1:p2:_) _ _)
        -- True indicates an infix lhs
   = getModeRn          `thenRn` \ mode ->
        -- See comments with rnExpr (OpApp ...)
@@ -765,45 +813,24 @@ checkPrec op pat right
   = returnRn ()
 
 -- Check precedence of (arg op) or (op arg) respectively
--- If arg is itself an operator application, its precedence should
--- be higher than that of op
-checkSectionPrec left_or_right section op arg
+-- If arg is itself an operator application, then either
+--   (a) its precedence must be higher than that of op
+--   (b) its precedency & associativity must be the same as that of op
+checkSectionPrec direction section op arg
   = case arg of
        OpApp _ op fix _ -> go_for_it (ppr_op op)     fix
        NegApp _ _       -> go_for_it pp_prefix_minus negateFixity
        other            -> returnRn ()
   where
     HsVar op_name = op
-    go_for_it pp_arg_op arg_fix@(Fixity arg_prec _)
+    go_for_it pp_arg_op arg_fix@(Fixity arg_prec assoc)
        = lookupFixityRn op_name        `thenRn` \ op_fix@(Fixity op_prec _) ->
-         checkRn (op_prec < arg_prec)
-                 (sectionPrecErr (ppr_op op_name, op_fix) (pp_arg_op, arg_fix) section)
+         checkRn (op_prec < arg_prec
+                    || op_prec == arg_prec && direction == assoc)
+                 (sectionPrecErr (ppr_op op_name, op_fix)      
+                 (pp_arg_op, arg_fix) section)
 \end{code}
 
-Consider
-\begin{verbatim}
-       a `op1` b `op2` c
-\end{verbatim}
-@(compareFixity op1 op2)@ tells which way to arrange appication, or
-whether there's an error.
-
-\begin{code}
-compareFixity :: Fixity -> Fixity
-             -> (Bool,         -- Error please
-                 Bool)         -- Associate to the right: a op1 (b op2 c)
-compareFixity (Fixity prec1 dir1) (Fixity prec2 dir2)
-  = case prec1 `compare` prec2 of
-       GT -> left
-       LT -> right
-       EQ -> case (dir1, dir2) of
-                       (InfixR, InfixR) -> right
-                       (InfixL, InfixL) -> left
-                       _                -> error_please
-  where
-    right       = (False, True)
-    left         = (False, False)
-    error_please = (True,  False)
-\end{code}
 
 %************************************************************************
 %*                                                                     *
@@ -827,27 +854,28 @@ litFVs (HsInt i)        = returnRn (unitFV (getName intTyCon))
 litFVs (HsIntPrim i)          = returnRn (unitFV (getName intPrimTyCon))
 litFVs (HsFloatPrim f)        = returnRn (unitFV (getName floatPrimTyCon))
 litFVs (HsDoublePrim d)       = returnRn (unitFV (getName doublePrimTyCon))
-litFVs (HsLitLit l bogus_ty)  = lookupOrigName cCallableClass_RDR      `thenRn` \ cc ->   
-                               returnRn (unitFV cc)
+litFVs (HsLitLit l bogus_ty)  = returnRn (unitFV cCallableClassName)
 litFVs lit                   = pprPanic "RnExpr.litFVs" (ppr lit)      -- HsInteger and HsRat only appear 
                                                                        -- in post-typechecker translations
 
-rnOverLit (HsIntegral i from_integer_name)
-  = lookupSyntaxName from_integer_name `thenRn` \ from_integer_name' ->
+rnOverLit (HsIntegral i _)
+  = lookupSyntaxName fromIntegerName   `thenRn` \ from_integer_name ->
     if inIntRange i then
-       returnRn (HsIntegral i from_integer_name', unitFV from_integer_name')
-    else
-       lookupOrigNames [plusInteger_RDR, timesInteger_RDR]     `thenRn` \ ns ->
+       returnRn (HsIntegral i from_integer_name, unitFV from_integer_name)
+    else let
+       fvs = mkFVs [plusIntegerName, timesIntegerName]
        -- Big integer literals are built, using + and *, 
        -- out of small integers (DsUtils.mkIntegerLit)
        -- [NB: plusInteger, timesInteger aren't rebindable... 
        --      they are used to construct the argument to fromInteger, 
        --      which is the rebindable one.]
-    returnRn (HsIntegral i from_integer_name', ns `addOneFV` from_integer_name')
+    in
+    returnRn (HsIntegral i from_integer_name, fvs `addOneFV` from_integer_name)
 
-rnOverLit (HsFractional i from_rat_name)
-  = lookupSyntaxName from_rat_name                                             `thenRn` \ from_rat_name' ->
-    lookupOrigNames [ratioDataCon_RDR, plusInteger_RDR, timesInteger_RDR]      `thenRn` \ ns ->
+rnOverLit (HsFractional i _)
+  = lookupSyntaxName fromRationalName          `thenRn` \ from_rat_name ->
+    let
+       fvs = mkFVs [ratioDataConName, plusIntegerName, timesIntegerName]
        -- We have to make sure that the Ratio type is imported with
        -- its constructor, because literals of type Ratio t are
        -- built with that constructor.
@@ -855,7 +883,8 @@ rnOverLit (HsFractional i from_rat_name)
        -- when fractionalClass does.
        -- The plus/times integer operations may be needed to construct the numerator
        -- and denominator (see DsUtils.mkIntegerLit)
-    returnRn (HsFractional i from_rat_name', ns `addOneFV` from_rat_name')
+    in
+    returnRn (HsFractional i from_rat_name, fvs `addOneFV` from_rat_name)
 \end{code}
 
 %************************************************************************
@@ -876,7 +905,7 @@ mkAssertExpr =
   if opt_IgnoreAsserts then
     getUniqRn                          `thenRn` \ uniq ->
     let
-     vname = mkSysLocalName uniq SLIT("v")
+     vname = mkSystemName uniq FSLIT("v")
      expr  = HsLam ignorePredMatch
      loc   = nameSrcLoc vname
      ignorePredMatch = mkSimpleMatch [WildPatIn, VarPatIn vname] (HsVar vname) placeHolderType loc
@@ -886,11 +915,9 @@ mkAssertExpr =
     let
      expr = 
           HsApp (HsVar name)
-               (HsLit (HsString (_PK_ (showSDoc (ppr sloc)))))
-
+               (HsLit (HsStringPrim (mkFastString (stringToUtf8 (showSDoc (ppr sloc))))))
     in
     returnRn (expr, unitFV name)
-
 \end{code}
 
 %************************************************************************
@@ -901,7 +928,6 @@ mkAssertExpr =
 
 \begin{code}
 ppr_op op = quotes (ppr op)    -- Here, op can be a Name or a (Var n), where n is a Name
-ppr_opfix (pp_op, fixity) = pp_op <+> brackets (ppr fixity)
 pp_prefix_minus = ptext SLIT("prefix `-'")
 
 dupFieldErr str (dup:rest)
@@ -909,17 +935,6 @@ dupFieldErr str (dup:rest)
           quotes (ppr dup),
          ptext SLIT("in record"), text str]
 
-precParseErr op1 op2 
-  = hang (ptext SLIT("precedence parsing error"))
-      4 (hsep [ptext SLIT("cannot mix"), ppr_opfix op1, ptext SLIT("and"), 
-              ppr_opfix op2,
-              ptext SLIT("in the same infix expression")])
-
-sectionPrecErr op arg_op section
- = vcat [ptext SLIT("The operator") <+> ppr_opfix op <+> ptext SLIT("of a section"),
-        nest 4 (ptext SLIT("must have lower precedence than the operand") <+> ppr_opfix arg_op),
-        nest 4 (ptext SLIT("in the section:") <+> quotes (ppr section))]
-
 nonStdGuardErr guard
   = hang (ptext
     SLIT("accepting non-standard pattern guards (-fglasgow-exts to suppress this message)")
@@ -939,4 +954,10 @@ doStmtListErr e
 
 bogusCharError c
   = ptext SLIT("character literal out of range: '\\") <> int c <> char '\''
+
+withWarning
+  = sep [quotes (ptext SLIT("with")),
+        ptext SLIT("is deprecated, use"),
+        quotes (ptext SLIT("let")),
+        ptext SLIT("instead")]
 \end{code}