[project @ 1999-07-27 09:25:49 by simonmar]

[ghc-hetmet.git] / ghc / compiler / rename / RnExpr.lhs

diff --git a/ghc/compiler/rename/RnExpr.lhs b/ghc/compiler/rename/RnExpr.lhs
index 8a381e1..b9621e7 100644 (file)
--- a/ghc/compiler/rename/RnExpr.lhs
+++ b/ghc/compiler/rename/RnExpr.lhs
@@ -18,7 +18,7 @@ module RnExpr (
 #include "HsVersions.h"
 
 import {-# SOURCE #-} RnBinds  ( rnBinds ) 
-import {-# SOURCE #-} RnSource ( rnHsSigType, rnHsType )
+import {-# SOURCE #-} RnSource ( rnHsSigType, rnHsPolyType, rnHsType )
 
 import HsSyn
 import RdrHsSyn
@@ -70,7 +70,7 @@ rnPat (VarPatIn name)
 rnPat (SigPatIn pat ty)
   | opt_GlasgowExts
   = rnPat pat          `thenRn` \ (pat', fvs1) ->
-    rnHsType doc ty    `thenRn` \ (ty',  fvs2) ->
+    rnHsPolyType doc ty        `thenRn` \ (ty',  fvs2) ->
     returnRn (SigPatIn pat' ty', fvs1 `plusFV` fvs2)
 
   | otherwise
@@ -365,10 +365,16 @@ rnExpr (HsLet binds expr)
     rnExpr expr                         `thenRn` \ (expr',fvExpr) ->
     returnRn (HsLet binds' expr', fvExpr)
 
-rnExpr (HsDo do_or_lc stmts src_loc)
+rnExpr e@(HsDo do_or_lc stmts src_loc)
   = pushSrcLocRn src_loc $
     lookupImplicitOccRn monadClass_RDR         `thenRn` \ monad ->
     rnStmts rnExpr stmts                       `thenRn` \ (stmts', fvs) ->
+       -- check the statement list ends in an expression
+    case last stmts' of {
+       ExprStmt _ _ -> returnRn () ;
+       ReturnStmt _ -> returnRn () ;   -- for list comprehensions
+       _            -> addErrRn (doStmtListErr e)
+    }                                          `thenRn_`
     returnRn (HsDo do_or_lc stmts' src_loc, fvs `addOneFV` monad)
 
 rnExpr (ExplicitList exps)
@@ -865,4 +871,8 @@ pp_op (op, fix) = hcat [quotes (ppr op), space, parens (ppr fix)]
 patSynErr e 
   = sep [ptext SLIT("Pattern syntax in expression context:"),
         nest 4 (ppr e)]
+
+doStmtListErr e
+  = sep [ptext SLIT("`do' statements must end in expression:"),
+        nest 4 (ppr e)]
 \end{code}