More hacking on monad-comp; now works

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

diff --git a/compiler/typecheck/TcGenDeriv.lhs b/compiler/typecheck/TcGenDeriv.lhs
index f7e5d39..dba87d2 100644 (file)
--- a/compiler/typecheck/TcGenDeriv.lhs
+++ b/compiler/typecheck/TcGenDeriv.lhs
@@ -893,7 +893,7 @@ gen_Read_binds get_fixity loc tycon
     read_nullary_cons 
       = case nullary_cons of
            []    -> []
     read_nullary_cons 
       = case nullary_cons of
            []    -> []

-           [con] -> [nlHsDo DoExpr (match_con con ++ [mkExprStmt (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
             _     -> [nlHsApp (nlHsVar choose_RDR) 
                              (nlList (map mk_pair nullary_cons))]
         -- NB For operators the parens around (:=:) are matched by the

@@ -967,7 +967,7 @@ gen_Read_binds get_fixity loc tycon
     ------------------------------------------------------------------------
     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 })
     ------------------------------------------------------------------------
     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 ++ [mkExprStmt 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)
     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)