[project @ 1996-04-10 18:10:47 by partain]

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

diff --git a/ghc/compiler/typecheck/TcHsSyn.lhs b/ghc/compiler/typecheck/TcHsSyn.lhs
index 996658b..b51e488 100644 (file)
--- a/ghc/compiler/typecheck/TcHsSyn.lhs
+++ b/ghc/compiler/typecheck/TcHsSyn.lhs
@@ -21,6 +21,7 @@ module TcHsSyn (
        TypecheckedQual(..), TypecheckedStmt(..),
        TypecheckedMatch(..), TypecheckedHsModule(..),
        TypecheckedGRHSsAndBinds(..), TypecheckedGRHS(..),
+       TypecheckedRecordBinds(..),
 
        mkHsTyApp, mkHsDictApp,
        mkHsTyLam, mkHsDictLam,
@@ -95,6 +96,7 @@ type TypecheckedStmt          = Stmt          TyVar UVar Id TypecheckedPat
 type TypecheckedMatch          = Match         TyVar UVar Id TypecheckedPat
 type TypecheckedGRHSsAndBinds  = GRHSsAndBinds TyVar UVar Id TypecheckedPat
 type TypecheckedGRHS           = GRHS          TyVar UVar Id TypecheckedPat
+type TypecheckedRecordBinds    = HsRecordBinds TyVar UVar Id TypecheckedPat
 type TypecheckedHsModule       = HsModule      TyVar UVar Id TypecheckedPat
 \end{code}
 
@@ -128,8 +130,8 @@ instance Outputable (TcIdOcc s) where
   ppr sty (RealId id) = ppr sty id
 
 instance NamedThing (TcIdOcc s) where
-  getOccurrenceName (TcId id)   = getOccurrenceName id
-  getOccurrenceName (RealId id) = getOccurrenceName id
+  getName (TcId id)   = getName id
+  getName (RealId id) = getName id
 \end{code}
 
 
@@ -229,10 +231,10 @@ zonkMonoBinds (VarMonoBind var expr)
     zonkExpr expr      `thenNF_Tc` \ new_expr ->
     returnNF_Tc (VarMonoBind new_var new_expr)
 
-zonkMonoBinds (FunMonoBind name ms locn)
+zonkMonoBinds (FunMonoBind name inf ms locn)
   = zonkId name                        `thenNF_Tc` \ new_name ->
     mapNF_Tc zonkMatch ms      `thenNF_Tc` \ new_ms ->
-    returnNF_Tc (FunMonoBind new_name new_ms locn)
+    returnNF_Tc (FunMonoBind new_name inf new_ms locn)
 \end{code}
 
 %************************************************************************
@@ -253,6 +255,10 @@ zonkMatch (GRHSMatch grhss_w_binds)
   = zonkGRHSsAndBinds grhss_w_binds `thenNF_Tc` \ new_grhss_w_binds ->
     returnNF_Tc (GRHSMatch new_grhss_w_binds)
 
+zonkMatch (SimpleMatch expr)
+  = zonkExpr expr   `thenNF_Tc` \ new_expr ->
+    returnNF_Tc (SimpleMatch new_expr)
+
 -------------------------------------------------------------------------
 zonkGRHSsAndBinds :: TcGRHSsAndBinds s
                   -> NF_TcM s TypecheckedGRHSsAndBinds
@@ -307,6 +313,9 @@ zonkExpr (OpApp e1 op e2)
     zonkExpr e2        `thenNF_Tc` \ new_e2 ->
     returnNF_Tc (OpApp new_e1 new_op new_e2)
 
+zonkExpr (NegApp _) = panic "zonkExpr:NegApp"
+zonkExpr (HsPar _)  = panic "zonkExpr:HsPar"
+
 zonkExpr (SectionL expr op)
   = zonkExpr expr      `thenNF_Tc` \ new_expr ->
     zonkExpr op                `thenNF_Tc` \ new_op ->
@@ -317,25 +326,24 @@ zonkExpr (SectionR op expr)
     zonkExpr expr      `thenNF_Tc` \ new_expr ->
     returnNF_Tc (SectionR new_op new_expr)
 
-zonkExpr (CCall fun args may_gc is_casm result_ty)
-  = mapNF_Tc zonkExpr args     `thenNF_Tc` \ new_args ->
-    zonkTcTypeToType result_ty `thenNF_Tc` \ new_result_ty ->
-    returnNF_Tc (CCall fun new_args may_gc is_casm new_result_ty)
-
-zonkExpr (HsSCC label expr)
-  = zonkExpr expr      `thenNF_Tc` \ new_expr ->
-    returnNF_Tc (HsSCC label new_expr)
-
 zonkExpr (HsCase expr ms src_loc)
   = zonkExpr expr          `thenNF_Tc` \ new_expr ->
     mapNF_Tc zonkMatch ms   `thenNF_Tc` \ new_ms ->
     returnNF_Tc (HsCase new_expr new_ms src_loc)
 
+zonkExpr (HsIf e1 e2 e3 src_loc)
+  = zonkExpr e1        `thenNF_Tc` \ new_e1 ->
+    zonkExpr e2        `thenNF_Tc` \ new_e2 ->
+    zonkExpr e3        `thenNF_Tc` \ new_e3 ->
+    returnNF_Tc (HsIf new_e1 new_e2 new_e3 src_loc)
+
 zonkExpr (HsLet binds expr)
   = zonkBinds binds    `thenNF_Tc` \ new_binds ->
     zonkExpr expr      `thenNF_Tc` \ new_expr ->
     returnNF_Tc (HsLet new_binds new_expr)
 
+zonkExpr (HsDo _ _) = panic "zonkExpr:HsDo"
+
 zonkExpr (HsDoOut stmts m_id mz_id src_loc)
   = zonkStmts stmts    `thenNF_Tc` \ new_stmts ->
     zonkId m_id                `thenNF_Tc` \ m_new ->
@@ -347,7 +355,7 @@ zonkExpr (ListComp expr quals)
     zonkQuals quals    `thenNF_Tc` \ new_quals ->
     returnNF_Tc (ListComp new_expr new_quals)
 
---ExplicitList: not in typechecked exprs
+zonkExpr (ExplicitList _) = panic "zonkExpr:ExplicitList"
 
 zonkExpr (ExplicitListOut ty exprs)
   = zonkTcTypeToType  ty       `thenNF_Tc` \ new_ty ->
@@ -362,18 +370,26 @@ zonkExpr (RecordCon con rbinds)
   = panic "zonkExpr:RecordCon"
 zonkExpr (RecordUpd exp rbinds)
   = panic "zonkExpr:RecordUpd"
+zonkExpr (RecordUpdOut exp ids rbinds)
+  = panic "zonkExpr:RecordUpdOut"
 
-zonkExpr (HsIf e1 e2 e3 src_loc)
-  = zonkExpr e1        `thenNF_Tc` \ new_e1 ->
-    zonkExpr e2        `thenNF_Tc` \ new_e2 ->
-    zonkExpr e3        `thenNF_Tc` \ new_e3 ->
-    returnNF_Tc (HsIf new_e1 new_e2 new_e3 src_loc)
+zonkExpr (ExprWithTySig _ _) = panic "zonkExpr:ExprWithTySig"
+zonkExpr (ArithSeqIn _) = panic "zonkExpr:ArithSeqIn"
 
 zonkExpr (ArithSeqOut expr info)
   = zonkExpr expr      `thenNF_Tc` \ new_expr ->
     zonkArithSeq info  `thenNF_Tc` \ new_info ->
     returnNF_Tc (ArithSeqOut new_expr new_info)
 
+zonkExpr (CCall fun args may_gc is_casm result_ty)
+  = mapNF_Tc zonkExpr args     `thenNF_Tc` \ new_args ->
+    zonkTcTypeToType result_ty `thenNF_Tc` \ new_result_ty ->
+    returnNF_Tc (CCall fun new_args may_gc is_casm new_result_ty)
+
+zonkExpr (HsSCC label expr)
+  = zonkExpr expr      `thenNF_Tc` \ new_expr ->
+    returnNF_Tc (HsSCC label new_expr)
+
 zonkExpr (TyLam tyvars expr)
   = mapNF_Tc zonkTcTyVarToTyVar tyvars `thenNF_Tc` \ new_tyvars ->
     zonkExpr expr                      `thenNF_Tc` \ new_expr ->
@@ -409,6 +425,11 @@ zonkExpr (SingleDict name)
   = zonkId name        `thenNF_Tc` \ new_name ->
     returnNF_Tc (SingleDict new_name)
 
+zonkExpr (HsCon con tys vargs)
+  = mapNF_Tc zonkTcTypeToType tys `thenNF_Tc` \ new_tys   ->
+    mapNF_Tc zonkExpr vargs      `thenNF_Tc` \ new_vargs ->
+    returnNF_Tc (HsCon con new_tys new_vargs)
+
 -------------------------------------------------------------------------
 zonkArithSeq :: TcArithSeqInfo s -> NF_TcM s TypecheckedArithSeqInfo