[project @ 2001-09-25 18:08:47 by ken]

[ghc-hetmet.git] / ghc / compiler / parser / ParseUtil.lhs

diff --git a/ghc/compiler/parser/ParseUtil.lhs b/ghc/compiler/parser/ParseUtil.lhs
index 7334806..6b10b9e 100644 (file)
--- a/ghc/compiler/parser/ParseUtil.lhs
+++ b/ghc/compiler/parser/ParseUtil.lhs
@@ -6,7 +6,6 @@
 \begin{code}
 module ParseUtil (
          parseError            -- String -> Pa
-       , cbot                  -- a
        , mkVanillaCon, mkRecCon,
 
        , mkRecConstrOrUpdate   -- HsExp -> [HsFieldUpdate] -> P HsExp
@@ -21,7 +20,7 @@ module ParseUtil (
        , checkSimple           -- HsType -> [HsName] -> P ((HsName,[HsName]))
        , checkPattern          -- HsExp -> P HsPat
        , checkPatterns         -- SrcLoc -> [HsExp] -> P [HsPat]
-       , checkDo               -- [HsStmt] -> P [HsStmt]
+       , checkDo               -- [Stmt] -> P [Stmt]
        , checkValDef           -- (SrcLoc, HsExp, HsRhs, [HsDecl]) -> P HsDecl
        , checkValSig           -- (SrcLoc, HsExp, HsRhs, [HsDecl]) -> P HsDecl
  ) where
@@ -34,7 +33,8 @@ import SrcLoc
 import RdrHsSyn                ( RdrBinding(..),
                          RdrNameHsType, RdrNameBangType, RdrNameContext,
                          RdrNameHsTyVar, RdrNamePat, RdrNameHsExpr, RdrNameGRHSs,
-                         RdrNameHsRecordBinds, RdrNameMonoBinds, RdrNameConDetails
+                         RdrNameHsRecordBinds, RdrNameMonoBinds, RdrNameConDetails,
+                         mkNPlusKPat
                        )
 import RdrName
 import PrelNames       ( unitTyCon_RDR )
@@ -52,7 +52,6 @@ parseError s =
   getSrcLocP `thenP` \ loc ->
   failMsgP (hcat [ppr loc, text ": ", text s])
 
-cbot = panic "CCall:result_ty"
 
 -----------------------------------------------------------------------------
 -- mkVanillaCon
@@ -156,11 +155,11 @@ checkSimple t _ = parseError "Illegal left hand side in data/newtype declaration
 -- checkDo (a) checks that the last thing is an ExprStmt
 --        (b) transforms it to a ResultStmt
 
-checkDo []            = parseError "Empty 'do' construct"
-checkDo [ExprStmt e l] = returnP [ResultStmt e l]
-checkDo [s]           = parseError "The last statement in a 'do' construct must be an expression"
-checkDo (s:ss)        = checkDo ss     `thenP` \ ss' ->
-                        returnP (s:ss')
+checkDo []              = parseError "Empty 'do' construct"
+checkDo [ExprStmt e _ l] = returnP [ResultStmt e l]
+checkDo [s]             = parseError "The last statement in a 'do' construct must be an expression"
+checkDo (s:ss)          = checkDo ss   `thenP` \ ss' ->
+                          returnP (s:ss')
 
 ---------------------------------------------------------------------------
 -- Checking Patterns.
@@ -196,9 +195,9 @@ checkPat e [] = case e of
                              in
                              returnP (SigPatIn e t')
 
-       OpApp (HsVar n) (HsVar plus) _ (HsOverLit lit@(HsIntegral k)) 
+       OpApp (HsVar n) (HsVar plus) _ (HsOverLit lit@(HsIntegral _ _)) 
                           | plus == plus_RDR
-                          -> returnP (NPlusKPatIn n lit)
+                          -> returnP (mkNPlusKPat n lit)
                           where
                              plus_RDR = mkUnqual varName SLIT("+")     -- Hack
 
@@ -209,7 +208,7 @@ checkPat e [] = case e of
                                 _ -> patFail
 
        HsPar e            -> checkPat e [] `thenP` (returnP . ParPatIn)
-       ExplicitList es    -> mapP (\e -> checkPat e []) es `thenP` \ps ->
+       ExplicitList _ es  -> mapP (\e -> checkPat e []) es `thenP` \ps ->
                              returnP (ListPatIn ps)
 
        ExplicitTuple es b -> mapP (\e -> checkPat e []) es `thenP` \ps ->