X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcHsSyn.lhs;h=122b74374230e063aa36d39cb0452903a1115e92;hp=b7b572f82834be7eb0f4dbd8ef6cc48db9126961;hb=f2aaae9757e7532485c97f6c9a9ed5437542d1dd;hpb=19d8dcbdaac5dc10e551703b824e8237e7d5f0a1

diff --git a/compiler/typecheck/TcHsSyn.lhs b/compiler/typecheck/TcHsSyn.lhs
index b7b572f..122b743 100644
--- a/compiler/typecheck/TcHsSyn.lhs
+++ b/compiler/typecheck/TcHsSyn.lhs
@@ -269,15 +269,16 @@ zonkTopLExpr e = zonkLExpr emptyZonkEnv e
 
 zonkTopDecls :: Bag EvBind 
              -> LHsBinds TcId -> NameSet
-             -> [LRuleDecl TcId] -> [LTcSpecPrag] -> [LForeignDecl TcId]
-	     -> TcM ([Id], 
-	             Bag EvBind,
-		     Bag (LHsBind  Id),
-		     [LForeignDecl Id],
-		     [LTcSpecPrag],
-		     [LRuleDecl    Id])
-zonkTopDecls ev_binds binds sig_ns rules imp_specs fords
-  = do	{ (env1, ev_binds') <- zonkEvBinds emptyZonkEnv ev_binds
+             -> [LRuleDecl TcId] -> [LVectDecl TcId] -> [LTcSpecPrag] -> [LForeignDecl TcId]
+             -> TcM ([Id], 
+                     Bag EvBind,
+                     Bag (LHsBind  Id),
+                     [LForeignDecl Id],
+                     [LTcSpecPrag],
+                     [LRuleDecl    Id],
+                     [LVectDecl    Id])
+zonkTopDecls ev_binds binds sig_ns rules vects imp_specs fords
+  = do  { (env1, ev_binds') <- zonkEvBinds emptyZonkEnv ev_binds
 
 	 -- Warn about missing signatures
 	 -- Do this only when we we have a type to offer
@@ -286,11 +287,12 @@ zonkTopDecls ev_binds binds sig_ns rules imp_specs fords
                        | otherwise         = noSigWarn
 
         ; (env2, binds') <- zonkRecMonoBinds env1 sig_warn binds
-			-- Top level is implicitly recursive
-	; rules' <- zonkRules env2 rules
+                        -- Top level is implicitly recursive
+        ; rules' <- zonkRules env2 rules
+        ; vects' <- zonkVects env2 vects
         ; specs' <- zonkLTcSpecPrags env2 imp_specs
-	; fords' <- zonkForeignExports env2 fords
-	; return (zonkEnvIds env2, ev_binds', binds', fords', specs', rules') }
+        ; fords' <- zonkForeignExports env2 fords
+        ; return (zonkEnvIds env2, ev_binds', binds', fords', specs', rules', vects') }
 
 ---------------------------------------------
 zonkLocalBinds :: ZonkEnv -> HsLocalBinds TcId -> TcM (ZonkEnv, HsLocalBinds Id)
@@ -1006,6 +1008,21 @@ zonkRule env (HsRule name act (vars{-::[RuleBndr TcId]-}) lhs fv_lhs rhs fv_rhs)
      | otherwise  = ASSERT( isImmutableTyVar v) return (env, v)
 \end{code}
 
+\begin{code}
+zonkVects :: ZonkEnv -> [LVectDecl TcId] -> TcM [LVectDecl Id]
+zonkVects env = mappM (wrapLocM (zonkVect env))
+
+zonkVect :: ZonkEnv -> VectDecl TcId -> TcM (VectDecl Id)
+zonkVect env (HsVect v Nothing)
+  = do { v' <- wrapLocM (zonkIdBndr env) v
+       ; return $ HsVect v' Nothing
+       }
+zonkVect env (HsVect v (Just e))
+  = do { v' <- wrapLocM (zonkIdBndr env) v
+       ; e' <- zonkLExpr env e
+       ; return $ HsVect v' (Just e')
+       }
+\end{code}
 
 %************************************************************************
 %*									*