[project @ 2003-07-28 15:57:40 by simonmar]

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

diff --git a/ghc/compiler/typecheck/TcHsSyn.lhs b/ghc/compiler/typecheck/TcHsSyn.lhs
index 3e83ab8..2b30c3c 100644 (file)
--- a/ghc/compiler/typecheck/TcHsSyn.lhs
+++ b/ghc/compiler/typecheck/TcHsSyn.lhs
@@ -13,6 +13,7 @@ module TcHsSyn (
        TcStmt, TcArithSeqInfo, TcRecordBinds,
        TcHsModule, TcDictBinds,
        TcForeignDecl,
        TcStmt, TcArithSeqInfo, TcRecordBinds,
        TcHsModule, TcDictBinds,
        TcForeignDecl,

+       TcCmd, TcCmdTop,

        
        TypecheckedHsBinds, TypecheckedRuleDecl,
        TypecheckedMonoBinds, TypecheckedPat,
        
        TypecheckedHsBinds, TypecheckedRuleDecl,
        TypecheckedMonoBinds, TypecheckedPat,

@@ -22,11 +23,17 @@ module TcHsSyn (
        TypecheckedGRHSs, TypecheckedGRHS,
        TypecheckedRecordBinds, TypecheckedDictBinds,
        TypecheckedMatchContext, TypecheckedCoreBind,
        TypecheckedGRHSs, TypecheckedGRHS,
        TypecheckedRecordBinds, TypecheckedDictBinds,
        TypecheckedMatchContext, TypecheckedCoreBind,

+       TypecheckedHsCmd, TypecheckedHsCmdTop,

 
        mkHsTyApp, mkHsDictApp, mkHsConApp,
        mkHsTyLam, mkHsDictLam, mkHsLet,
        hsLitType, hsPatType, 
 
 
        mkHsTyApp, mkHsDictApp, mkHsConApp,
        mkHsTyLam, mkHsDictLam, mkHsLet,
        hsLitType, hsPatType, 
 

+       -- Coercions
+       Coercion, ExprCoFn, PatCoFn, 
+       (<$>), (<.>), mkCoercion, 
+       idCoercion, isIdCoercion,
+

        -- re-exported from TcMonad
        TcId, TcIdSet,
 
        -- re-exported from TcMonad
        TcId, TcIdSet,
 

@@ -65,6 +72,7 @@ import VarSet
 import VarEnv
 import BasicTypes ( RecFlag(..), Boxity(..), IPName(..), ipNameName, mapIPName )
 import Maybes    ( orElse )
 import VarEnv
 import BasicTypes ( RecFlag(..), Boxity(..), IPName(..), ipNameName, mapIPName )
 import Maybes    ( orElse )

+import Maybe     ( isNothing )

 import Unique    ( Uniquable(..) )
 import SrcLoc    ( noSrcLoc )
 import Bag
 import Unique    ( Uniquable(..) )
 import SrcLoc    ( noSrcLoc )
 import Bag

@@ -97,6 +105,8 @@ type TcRecordBinds   = HsRecordBinds TcId
 type TcHsModule                = HsModule      TcId
 type TcForeignDecl      = ForeignDecl  TcId
 type TcRuleDecl        = RuleDecl     TcId
 type TcHsModule                = HsModule      TcId
 type TcForeignDecl      = ForeignDecl  TcId
 type TcRuleDecl        = RuleDecl     TcId

+type TcCmd             = HsCmd         TcId 
+type TcCmdTop          = HsCmdTop      TcId 

 
 type TypecheckedPat            = OutPat        Id
 type TypecheckedMonoBinds      = MonoBinds     Id
 
 type TypecheckedPat            = OutPat        Id
 type TypecheckedMonoBinds      = MonoBinds     Id

@@ -113,6 +123,8 @@ type TypecheckedHsModule    = HsModule      Id
 type TypecheckedForeignDecl     = ForeignDecl   Id
 type TypecheckedRuleDecl       = RuleDecl      Id
 type TypecheckedCoreBind        = (Id, CoreExpr)
 type TypecheckedForeignDecl     = ForeignDecl   Id
 type TypecheckedRuleDecl       = RuleDecl      Id
 type TypecheckedCoreBind        = (Id, CoreExpr)

+type TypecheckedHsCmd          = HsCmd         Id
+type TypecheckedHsCmdTop       = HsCmdTop      Id

 
 type TypecheckedMatchContext   = HsMatchContext Name   -- Keeps consistency with 
                                                        -- HsDo arg StmtContext
 
 type TypecheckedMatchContext   = HsMatchContext Name   -- Keeps consistency with 
                                                        -- HsDo arg StmtContext

@@ -182,12 +194,37 @@ hsLitType (HsDoublePrim d) = doublePrimTy
 hsLitType (HsLitLit _ ty)  = ty
 \end{code}
 
 hsLitType (HsLitLit _ ty)  = ty
 \end{code}
 

+%************************************************************************
+%*                                                                     *
+\subsection{Coercion functions}
+%*                                                                     *
+%************************************************************************
+

 \begin{code}
 \begin{code}

--- zonkId is used *during* typechecking just to zonk the Id's type
-zonkId :: TcId -> TcM TcId
-zonkId id
-  = zonkTcType (idType id) `thenM` \ ty' ->
-    returnM (setIdType id ty')
+type Coercion a = Maybe (a -> a)
+       -- Nothing => identity fn
+
+type ExprCoFn = Coercion TypecheckedHsExpr
+type PatCoFn  = Coercion TcPat
+
+(<.>) :: Coercion a -> Coercion a -> Coercion a        -- Composition
+Nothing <.> Nothing = Nothing
+Nothing <.> Just f  = Just f
+Just f  <.> Nothing = Just f
+Just f1 <.> Just f2 = Just (f1 . f2)
+
+(<$>) :: Coercion a -> a -> a
+Just f  <$> e = f e
+Nothing <$> e = e
+
+mkCoercion :: (a -> a) -> Coercion a
+mkCoercion f = Just f
+
+idCoercion :: Coercion a
+idCoercion = Nothing
+
+isIdCoercion :: Coercion a -> Bool
+isIdCoercion = isNothing

 \end{code}
 
 
 \end{code}
 
 

@@ -197,7 +234,16 @@ zonkId id
 %*                                                                     *
 %************************************************************************
 
 %*                                                                     *
 %************************************************************************
 

-This zonking pass runs over the bindings
+\begin{code}
+-- zonkId is used *during* typechecking just to zonk the Id's type
+zonkId :: TcId -> TcM TcId
+zonkId id
+  = zonkTcType (idType id) `thenM` \ ty' ->
+    returnM (setIdType id ty')
+\end{code}
+
+The rest of the zonking is done *after* typechecking.
+The main zonking pass runs over the bindings

 
  a) to convert TcTyVars to TyVars etc, dereferencing any bindings etc
  b) convert unbound TcTyVar to Void
 
  a) to convert TcTyVars to TyVars etc, dereferencing any bindings etc
  b) convert unbound TcTyVar to Void

@@ -315,7 +361,20 @@ zonkBinds env (MonoBind bind sigs is_rec)
        zonkMonoBinds env1 bind `thenM` \ (new_bind, new_ids) ->
        returnM (env1, new_bind, new_ids)
     )                          `thenM` \ (env1, new_bind, _) ->
        zonkMonoBinds env1 bind `thenM` \ (new_bind, new_ids) ->
        returnM (env1, new_bind, new_ids)
     )                          `thenM` \ (env1, new_bind, _) ->

-   returnM (env1, mkMonoBind new_bind [] is_rec)
+   returnM (env1, mkMonoBind is_rec new_bind)
+
+zonkBinds env (IPBinds binds is_with)
+  = mappM zonk_ip_bind binds   `thenM` \ new_binds ->
+    let
+       env1 = extendZonkEnv env (map (ipNameName . fst) new_binds)
+    in
+    returnM (env1, IPBinds new_binds is_with)
+  where
+    zonk_ip_bind (n, e)
+       = mapIPNameTc (zonkIdBndr env) n        `thenM` \ n' ->
+         zonkExpr env e                        `thenM` \ e' ->
+         returnM (n', e')
+

 
 ---------------------------------------------
 zonkMonoBinds :: ZonkEnv -> TcMonoBinds
 
 ---------------------------------------------
 zonkMonoBinds :: ZonkEnv -> TcMonoBinds

@@ -339,10 +398,6 @@ zonkMonoBinds env (VarMonoBind var expr)
     zonkExpr env expr  `thenM` \ new_expr ->
     returnM (VarMonoBind new_var new_expr, unitBag new_var)
 
     zonkExpr env expr  `thenM` \ new_expr ->
     returnM (VarMonoBind new_var new_expr, unitBag new_var)
 

-zonkMonoBinds env (CoreMonoBind var core_expr)
-  = zonkIdBndr env var         `thenM` \ new_var ->
-    returnM (CoreMonoBind new_var core_expr, unitBag new_var)
-

 zonkMonoBinds env (FunMonoBind var inf ms locn)
   = zonkIdBndr env var                 `thenM` \ new_var ->
     mappM (zonkMatch env) ms           `thenM` \ new_ms ->
 zonkMonoBinds env (FunMonoBind var inf ms locn)
   = zonkIdBndr env var                 `thenM` \ new_var ->
     mappM (zonkMatch env) ms           `thenM` \ new_ms ->

@@ -417,7 +472,11 @@ zonkGRHSs env (GRHSs grhss binds ty)
 %************************************************************************
 
 \begin{code}
 %************************************************************************
 
 \begin{code}

-zonkExpr :: ZonkEnv -> TcExpr -> TcM TypecheckedHsExpr
+zonkExprs :: ZonkEnv -> [TcExpr] -> TcM [TypecheckedHsExpr]
+zonkExpr  :: ZonkEnv -> TcExpr -> TcM TypecheckedHsExpr
+
+zonkExprs env exprs = mappM (zonkExpr env) exprs
+

 
 zonkExpr env (HsVar id)
   = returnM (HsVar (zonkIdOcc env id))
 
 zonkExpr env (HsVar id)
   = returnM (HsVar (zonkIdOcc env id))

@@ -454,8 +513,10 @@ zonkExpr env (HsBracketOut body bs)
     zonk_b (n,e) = zonkExpr env e      `thenM` \ e' ->
                   returnM (n,e')
 
     zonk_b (n,e) = zonkExpr env e      `thenM` \ e' ->
                   returnM (n,e')
 

-zonkExpr env (HsSplice n e) = WARN( True, ppr e )      -- Should not happen
-                             returnM (HsSplice n e)
+zonkExpr env (HsReify r) = returnM (HsReify r) -- Nothing to zonk; only top
+                                               -- level things can be reified (for now)
+zonkExpr env (HsSplice n e loc) = WARN( True, ppr e )  -- Should not happen
+                                 returnM (HsSplice n e loc)

 
 zonkExpr env (OpApp e1 op fixity e2)
   = zonkExpr env e1    `thenM` \ new_e1 ->
 
 zonkExpr env (OpApp e1 op fixity e2)
   = zonkExpr env e1    `thenM` \ new_e1 ->

@@ -495,38 +556,25 @@ zonkExpr env (HsLet binds expr)
     zonkExpr new_env expr      `thenM` \ new_expr ->
     returnM (HsLet new_binds new_expr)
 
     zonkExpr new_env expr      `thenM` \ new_expr ->
     returnM (HsLet new_binds new_expr)
 

-zonkExpr env (HsWith expr binds is_with)
-  = mappM zonk_ip_bind binds   `thenM` \ new_binds ->
-    let
-       env1 = extendZonkEnv env (map (ipNameName . fst) new_binds)
-    in
-    zonkExpr env1 expr         `thenM` \ new_expr ->
-    returnM (HsWith new_expr new_binds is_with)
-    where
-       zonk_ip_bind (n, e)
-           = mapIPNameTc (zonkIdBndr env) n    `thenM` \ n' ->
-             zonkExpr env e                    `thenM` \ e' ->
-             returnM (n', e')
-

 zonkExpr env (HsDo do_or_lc stmts ids ty src_loc)
   = zonkStmts env stmts        `thenM` \ new_stmts ->
     zonkTcTypeToType env ty    `thenM` \ new_ty   ->
 zonkExpr env (HsDo do_or_lc stmts ids ty src_loc)
   = zonkStmts env stmts        `thenM` \ new_stmts ->
     zonkTcTypeToType env ty    `thenM` \ new_ty   ->

-    returnM (HsDo do_or_lc new_stmts 
-                     (zonkIdOccs env ids) 
-                     new_ty src_loc)
+    zonkReboundNames env ids   `thenM` \ new_ids ->
+    returnM (HsDo do_or_lc new_stmts new_ids
+                 new_ty src_loc)

 
 zonkExpr env (ExplicitList ty exprs)
   = zonkTcTypeToType env ty    `thenM` \ new_ty ->
 
 zonkExpr env (ExplicitList ty exprs)
   = zonkTcTypeToType env ty    `thenM` \ new_ty ->

-    mappM (zonkExpr env) exprs `thenM` \ new_exprs ->
+    zonkExprs env exprs                `thenM` \ new_exprs ->

     returnM (ExplicitList new_ty new_exprs)
 
 zonkExpr env (ExplicitPArr ty exprs)
   = zonkTcTypeToType env ty    `thenM` \ new_ty ->
     returnM (ExplicitList new_ty new_exprs)
 
 zonkExpr env (ExplicitPArr ty exprs)
   = zonkTcTypeToType env ty    `thenM` \ new_ty ->

-    mappM (zonkExpr env) exprs `thenM` \ new_exprs ->
+    zonkExprs env exprs                `thenM` \ new_exprs ->

     returnM (ExplicitPArr new_ty new_exprs)
 
 zonkExpr env (ExplicitTuple exprs boxed)
     returnM (ExplicitPArr new_ty new_exprs)
 
 zonkExpr env (ExplicitTuple exprs boxed)

-  = mappM (zonkExpr env) exprs         `thenM` \ new_exprs ->
+  = zonkExprs env exprs        `thenM` \ new_exprs ->

     returnM (ExplicitTuple new_exprs boxed)
 
 zonkExpr env (RecordConOut data_con con_expr rbinds)
     returnM (ExplicitTuple new_exprs boxed)
 
 zonkExpr env (RecordConOut data_con con_expr rbinds)

@@ -558,7 +606,7 @@ zonkExpr env (PArrSeqOut expr info)
     returnM (PArrSeqOut new_expr new_info)
 
 zonkExpr env (HsCCall fun args may_gc is_casm result_ty)
     returnM (PArrSeqOut new_expr new_info)
 
 zonkExpr env (HsCCall fun args may_gc is_casm result_ty)

-  = mappM (zonkExpr env) args          `thenM` \ new_args ->
+  = zonkExprs env args                 `thenM` \ new_args ->

     zonkTcTypeToType env result_ty     `thenM` \ new_result_ty ->
     returnM (HsCCall fun new_args may_gc is_casm new_result_ty)
 
     zonkTcTypeToType env result_ty     `thenM` \ new_result_ty ->
     returnM (HsCCall fun new_args may_gc is_casm new_result_ty)
 

@@ -566,6 +614,11 @@ zonkExpr env (HsSCC lbl expr)
   = zonkExpr env expr  `thenM` \ new_expr ->
     returnM (HsSCC lbl new_expr)
 
   = zonkExpr env expr  `thenM` \ new_expr ->
     returnM (HsSCC lbl new_expr)
 

+-- hdaume: core annotations
+zonkExpr env (HsCoreAnn lbl expr)
+  = zonkExpr env expr   `thenM` \ new_expr ->
+    returnM (HsCoreAnn lbl new_expr)
+

 zonkExpr env (TyLam tyvars expr)
   = mappM zonkTcTyVarToTyVar tyvars    `thenM` \ new_tyvars ->
        -- No need to extend tyvar env; see AbsBinds
 zonkExpr env (TyLam tyvars expr)
   = mappM zonkTcTyVarToTyVar tyvars    `thenM` \ new_tyvars ->
        -- No need to extend tyvar env; see AbsBinds

@@ -590,6 +643,42 @@ zonkExpr env (DictApp expr dicts)
   = zonkExpr env expr                  `thenM` \ new_expr ->
     returnM (DictApp new_expr (zonkIdOccs env dicts))
 
   = zonkExpr env expr                  `thenM` \ new_expr ->
     returnM (DictApp new_expr (zonkIdOccs env dicts))
 

+-- arrow notation extensions
+zonkExpr env (HsProc pat body src_loc)
+  = zonkPat env pat                    `thenM` \ (new_pat, new_ids) ->
+    let
+       env1 = extendZonkEnv env (bagToList new_ids)
+    in
+    zonkCmdTop env1 body               `thenM` \ new_body ->
+    returnM (HsProc new_pat new_body src_loc)
+
+zonkExpr env (HsArrApp e1 e2 ty ho rl src_loc)
+  = zonkExpr env e1                    `thenM` \ new_e1 ->
+    zonkExpr env e2                    `thenM` \ new_e2 ->
+    zonkTcTypeToType env ty            `thenM` \ new_ty ->
+    returnM (HsArrApp new_e1 new_e2 new_ty ho rl src_loc)
+
+zonkExpr env (HsArrForm op fixity args src_loc)
+  = zonkExpr env op                    `thenM` \ new_op ->
+    mappM (zonkCmdTop env) args                `thenM` \ new_args ->
+    returnM (HsArrForm new_op fixity new_args src_loc)
+
+zonkCmdTop :: ZonkEnv -> TcCmdTop -> TcM TypecheckedHsCmdTop
+zonkCmdTop env (HsCmdTop cmd stack_tys ty ids)
+  = zonkExpr env cmd                   `thenM` \ new_cmd ->
+    mappM (zonkTcTypeToType env) stack_tys
+                                       `thenM` \ new_stack_tys ->
+    zonkTcTypeToType env ty            `thenM` \ new_ty ->
+    zonkReboundNames env ids           `thenM` \ new_ids ->
+    returnM (HsCmdTop new_cmd new_stack_tys new_ty new_ids)
+
+-------------------------------------------------------------------------
+zonkReboundNames :: ZonkEnv -> ReboundNames Id -> TcM (ReboundNames Id)
+zonkReboundNames env prs 
+  = mapM zonk prs
+  where
+    zonk (n, e) = zonkExpr env e `thenM` \ new_e ->
+                 returnM (n, new_e)

 
 
 -------------------------------------------------------------------------
 
 
 -------------------------------------------------------------------------

@@ -617,55 +706,67 @@ zonkArithSeq env (FromThenTo e1 e2 e3)
 
 
 -------------------------------------------------------------------------
 
 
 -------------------------------------------------------------------------

-zonkStmts :: ZonkEnv -> [TcStmt] -> TcM [TypecheckedStmt]
+zonkStmts  :: ZonkEnv -> [TcStmt] -> TcM [TypecheckedStmt]
+
+zonkStmts env stmts = zonk_stmts env stmts     `thenM` \ (_, stmts) ->
+                     returnM stmts

 
 

-zonkStmts env [] = returnM []
+zonk_stmts :: ZonkEnv -> [TcStmt] -> TcM (ZonkEnv, [TypecheckedStmt])

 
 

-zonkStmts env (ParStmtOut bndrstmtss : stmts)
-  = mappM (mappM zonkId) bndrss                `thenM` \ new_bndrss ->
-    mappM (zonkStmts env) stmtss       `thenM` \ new_stmtss ->
+zonk_stmts env [] = returnM (env, [])
+
+zonk_stmts env (ParStmt stmts_w_bndrs : stmts)
+  = mappM zonk_branch stmts_w_bndrs    `thenM` \ new_stmts_w_bndrs ->

     let 
     let 

-       new_binders = concat new_bndrss
+       new_binders = concat (map snd new_stmts_w_bndrs)

        env1 = extendZonkEnv env new_binders
     in
        env1 = extendZonkEnv env new_binders
     in

-    zonkStmts env1 stmts               `thenM` \ new_stmts ->
-    returnM (ParStmtOut (zip new_bndrss new_stmtss) : new_stmts)
+    zonk_stmts env1 stmts              `thenM` \ (env2, new_stmts) ->
+    returnM (env2, ParStmt new_stmts_w_bndrs : new_stmts)

   where
   where

-    (bndrss, stmtss) = unzip bndrstmtss
+    zonk_branch (stmts, bndrs) = zonk_stmts env stmts  `thenM` \ (env1, new_stmts) ->
+                                returnM (new_stmts, zonkIdOccs env1 bndrs)

 
 

-zonkStmts env (RecStmt vs segStmts : stmts)
-  = mappM zonkId vs            `thenM` \ new_vs ->
+zonk_stmts env (RecStmt segStmts lvs rvs rets : stmts)
+  = zonkIdBndrs env rvs                `thenM` \ new_rvs ->
+    let
+       env1 = extendZonkEnv env new_rvs
+    in
+    zonk_stmts env1 segStmts   `thenM` \ (env2, new_segStmts) ->
+       -- Zonk the ret-expressions in an envt that 
+       -- has the polymorphic bindings in the envt
+    zonkExprs env2 rets                `thenM` \ new_rets ->

     let
     let

-       env1 = extendZonkEnv env new_vs
+       new_lvs = zonkIdOccs env2 lvs
+       env3 = extendZonkEnv env new_lvs        -- Only the lvs are needed

     in
     in

-    zonkStmts env1 segStmts    `thenM` \ new_segStmts ->
-    zonkStmts env1 stmts       `thenM` \ new_stmts ->
-    returnM (RecStmt new_vs new_segStmts : new_stmts)
+    zonk_stmts env3 stmts      `thenM` \ (env4, new_stmts) ->
+    returnM (env4, RecStmt new_segStmts new_lvs new_rvs new_rets : new_stmts)

 
 

-zonkStmts env (ResultStmt expr locn : stmts)
-  = zonkExpr env expr  `thenM` \ new_expr ->
-    zonkStmts env stmts        `thenM` \ new_stmts ->
-    returnM (ResultStmt new_expr locn : new_stmts)
+zonk_stmts env (ResultStmt expr locn : stmts)
+  = ASSERT( null stmts )
+    zonkExpr env expr  `thenM` \ new_expr ->
+    returnM (env, [ResultStmt new_expr locn])

 
 

-zonkStmts env (ExprStmt expr ty locn : stmts)
+zonk_stmts env (ExprStmt expr ty locn : stmts)

   = zonkExpr env expr          `thenM` \ new_expr ->
     zonkTcTypeToType env ty    `thenM` \ new_ty ->
   = zonkExpr env expr          `thenM` \ new_expr ->
     zonkTcTypeToType env ty    `thenM` \ new_ty ->

-    zonkStmts env stmts                `thenM` \ new_stmts ->
-    returnM (ExprStmt new_expr new_ty locn : new_stmts)
+    zonk_stmts env stmts       `thenM` \ (env1, new_stmts) ->
+    returnM (env1, ExprStmt new_expr new_ty locn : new_stmts)

 
 

-zonkStmts env (LetStmt binds : stmts)
-  = zonkBinds env binds                `thenM` \ (new_env, new_binds) ->
-    zonkStmts new_env stmts    `thenM` \ new_stmts ->
-    returnM (LetStmt new_binds : new_stmts)
+zonk_stmts env (LetStmt binds : stmts)
+  = zonkBinds env binds                `thenM` \ (env1, new_binds) ->
+    zonk_stmts env1 stmts      `thenM` \ (env2, new_stmts) ->
+    returnM (env2, LetStmt new_binds : new_stmts)

 
 

-zonkStmts env (BindStmt pat expr locn : stmts)
+zonk_stmts env (BindStmt pat expr locn : stmts)

   = zonkExpr env expr                  `thenM` \ new_expr ->
     zonkPat env pat                    `thenM` \ (new_pat, new_ids) ->
     let
        env1 = extendZonkEnv env (bagToList new_ids)
     in
   = zonkExpr env expr                  `thenM` \ new_expr ->
     zonkPat env pat                    `thenM` \ (new_pat, new_ids) ->
     let
        env1 = extendZonkEnv env (bagToList new_ids)
     in

-    zonkStmts env1 stmts               `thenM` \ new_stmts ->
-    returnM (BindStmt new_pat new_expr locn : new_stmts)
+    zonk_stmts env1 stmts              `thenM` \ (env2, new_stmts) ->
+    returnM (env2, BindStmt new_pat new_expr locn : new_stmts)

 
 
 
 
 
 

@@ -808,6 +909,8 @@ zonkForeignExports env ls = mappM (zonkForeignExport env) ls
 zonkForeignExport :: ZonkEnv -> TcForeignDecl -> TcM (TypecheckedForeignDecl)
 zonkForeignExport env (ForeignExport i hs_ty spec isDeprec src_loc) =
    returnM (ForeignExport (zonkIdOcc env i) undefined spec isDeprec src_loc)
 zonkForeignExport :: ZonkEnv -> TcForeignDecl -> TcM (TypecheckedForeignDecl)
 zonkForeignExport env (ForeignExport i hs_ty spec isDeprec src_loc) =
    returnM (ForeignExport (zonkIdOcc env i) undefined spec isDeprec src_loc)

+zonkForeignExport env for_imp 
+  = returnM for_imp    -- Foreign imports don't need zonking

 \end{code}
 
 \begin{code}
 \end{code}
 
 \begin{code}