merge GHC HEAD

[ghc-hetmet.git] / compiler / typecheck / TcGenDeriv.lhs

diff --git a/compiler/typecheck/TcGenDeriv.lhs b/compiler/typecheck/TcGenDeriv.lhs
index efacac2..ad640ef 100644 (file)
--- a/compiler/typecheck/TcGenDeriv.lhs
+++ b/compiler/typecheck/TcGenDeriv.lhs
@@ -42,7 +42,7 @@ import Name
 import HscTypes
 import PrelInfo
 import MkCore  ( eRROR_ID )
-import PrelNames
+import PrelNames hiding (error_RDR)
 import PrimOp
 import SrcLoc
 import TyCon
@@ -50,7 +50,6 @@ import TcType
 import TysPrim
 import TysWiredIn
 import Type
-import Var( TyVar )
 import TypeRep
 import VarSet
 import State
@@ -779,7 +778,7 @@ gen_Ix_binds loc tycon
     single_con_range
       = mk_easy_FunBind loc range_RDR 
          [nlTuplePat [con_pat as_needed, con_pat bs_needed] Boxed] $
-       nlHsDo ListComp stmts con_expr
+       noLoc (mkHsComp ListComp stmts con_expr)
       where
        stmts = zipWith3Equal "single_con_range" mk_qual as_needed bs_needed cs_needed
 
@@ -893,7 +892,7 @@ gen_Read_binds get_fixity loc tycon
     read_nullary_cons 
       = case nullary_cons of
            []    -> []
-           [con] -> [nlHsDo DoExpr (match_con con) (result_expr con [])]
+           [con] -> [nlHsDo DoExpr (match_con con ++ [noLoc $ mkLastStmt (result_expr con [])])]
             _     -> [nlHsApp (nlHsVar choose_RDR) 
                              (nlList (map mk_pair nullary_cons))]
         -- NB For operators the parens around (:=:) are matched by the
@@ -965,11 +964,12 @@ gen_Read_binds get_fixity loc tycon
     ------------------------------------------------------------------------
     --         Helpers
     ------------------------------------------------------------------------
-    mk_alt e1 e2       = genOpApp e1 alt_RDR e2                                        -- e1 +++ e2
-    mk_parser p ss b   = nlHsApps prec_RDR [nlHsIntLit p, nlHsDo DoExpr ss b]  -- prec p (do { ss ; b })
-    bindLex pat               = noLoc (mkBindStmt pat (nlHsVar lexP_RDR))              -- pat <- lexP
-    con_app con as     = nlHsVarApps (getRdrName con) as                       -- con as
-    result_expr con as = nlHsApp (nlHsVar returnM_RDR) (con_app con as)                -- return (con as)
+    mk_alt e1 e2       = genOpApp e1 alt_RDR e2                                -- e1 +++ e2
+    mk_parser p ss b   = nlHsApps prec_RDR [nlHsIntLit p               -- prec p (do { ss ; b })
+                                           , nlHsDo DoExpr (ss ++ [noLoc $ mkLastStmt b])]
+    bindLex pat               = noLoc (mkBindStmt pat (nlHsVar lexP_RDR))      -- pat <- lexP
+    con_app con as     = nlHsVarApps (getRdrName con) as               -- con as
+    result_expr con as = nlHsApp (nlHsVar returnM_RDR) (con_app con as) -- return (con as)
     
     punc_pat s   = nlConPat punc_RDR   [nlLitPat (mkHsString s)]  -- Punc 'c'
 
@@ -1836,7 +1836,7 @@ assoc_ty_id cls_str _ tbl ty
                                              text "for primitive type" <+> ppr ty)
   | otherwise = head res
   where
-    res = [id | (ty',id) <- tbl, ty `tcEqType` ty']
+    res = [id | (ty',id) <- tbl, ty `eqType` ty']
 
 -----------------------------------------------------------------------