[project @ 2001-06-11 12:24:51 by simonpj]

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

diff --git a/ghc/compiler/typecheck/TcHsSyn.lhs b/ghc/compiler/typecheck/TcHsSyn.lhs
index 803e867..ab8f3ad 100644 (file)
--- a/ghc/compiler/typecheck/TcHsSyn.lhs
+++ b/ghc/compiler/typecheck/TcHsSyn.lhs
@@ -21,6 +21,7 @@ module TcHsSyn (
        TypecheckedMatch, TypecheckedHsModule,
        TypecheckedGRHSs, TypecheckedGRHS,
        TypecheckedRecordBinds, TypecheckedDictBinds,
+       TypecheckedMatchContext,
 
        mkHsTyApp, mkHsDictApp, mkHsConApp,
        mkHsTyLam, mkHsDictLam, mkHsLet,
@@ -28,7 +29,7 @@ module TcHsSyn (
        -- re-exported from TcEnv
        TcId, 
 
-       zonkTopBinds, zonkId, zonkIdOcc, zonkExpr,
+       zonkTopBinds, zonkId, zonkIdBndr, zonkIdOcc, zonkExpr,
        zonkForeignExports, zonkRules
   ) where
 
@@ -38,7 +39,7 @@ module TcHsSyn (
 import HsSyn   -- oodles of it
 
 -- others:
-import Id      ( idName, idType, isLocalId, setIdType, isIP, Id )
+import Id      ( idName, idType, setIdType, Id )
 import DataCon ( dataConWrapId )       
 import TcEnv   ( tcLookupGlobal_maybe, tcExtendGlobalValEnv,
                  TcEnv, TcId
@@ -91,6 +92,7 @@ type TypecheckedHsExpr                = HsExpr        Id TypecheckedPat
 type TypecheckedArithSeqInfo   = ArithSeqInfo  Id TypecheckedPat
 type TypecheckedStmt           = Stmt          Id TypecheckedPat
 type TypecheckedMatch          = Match         Id TypecheckedPat
+type TypecheckedMatchContext   = HsMatchContext Id
 type TypecheckedGRHSs          = GRHSs         Id TypecheckedPat
 type TypecheckedGRHS           = GRHS          Id TypecheckedPat
 type TypecheckedRecordBinds    = HsRecordBinds Id TypecheckedPat
@@ -167,7 +169,9 @@ zonkIdOcc id
     let
        new_id = case maybe_id' of
                    Just (AnId id') -> id'
-                   other           -> WARN( isLocalId id, ppr id ) id
+                   other           -> id -- WARN( isLocalId id, ppr id ) id
+                                       -- Oops: the warning can give a black hole
+                                       -- because it looks at the idinfo
     in
     returnNF_Tc new_id
 \end{code}
@@ -510,19 +514,15 @@ zonkStmts (ParStmtOut bndrstmtss : stmts)
     returnNF_Tc (ParStmtOut (zip new_bndrss new_stmtss) : new_stmts)
   where (bndrss, stmtss) = unzip bndrstmtss
 
-zonkStmts [ReturnStmt expr]
-  = zonkExpr expr              `thenNF_Tc` \ new_expr ->
-    returnNF_Tc [ReturnStmt new_expr]
-
-zonkStmts (ExprStmt expr locn : stmts)
+zonkStmts (ResultStmt expr locn : stmts)
   = zonkExpr expr      `thenNF_Tc` \ new_expr ->
     zonkStmts stmts    `thenNF_Tc` \ new_stmts ->
-    returnNF_Tc (ExprStmt new_expr locn : new_stmts)
+    returnNF_Tc (ResultStmt new_expr locn : new_stmts)
 
-zonkStmts (GuardStmt expr locn : stmts)
+zonkStmts (ExprStmt expr locn : stmts)
   = zonkExpr expr      `thenNF_Tc` \ new_expr ->
     zonkStmts stmts    `thenNF_Tc` \ new_stmts ->
-    returnNF_Tc (GuardStmt new_expr locn : new_stmts)
+    returnNF_Tc (ExprStmt new_expr locn : new_stmts)
 
 zonkStmts (LetStmt binds : stmts)
   = zonkBinds binds            `thenNF_Tc` \ (new_binds, new_env) ->
@@ -652,9 +652,9 @@ zonkForeignExports :: [TcForeignExportDecl] -> NF_TcM [TypecheckedForeignDecl]
 zonkForeignExports ls = mapNF_Tc zonkForeignExport ls
 
 zonkForeignExport :: TcForeignExportDecl -> NF_TcM (TypecheckedForeignDecl)
-zonkForeignExport (ForeignDecl i imp_exp hs_ty ext_nm cconv src_loc) =
+zonkForeignExport (ForeignExport i hs_ty spec src_loc) =
    zonkIdOcc i `thenNF_Tc` \ i' ->
-   returnNF_Tc (ForeignDecl i' imp_exp undefined ext_nm cconv src_loc)
+   returnNF_Tc (ForeignExport i' undefined spec src_loc)
 \end{code}
 
 \begin{code}