X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Ftypecheck%2FTcBinds.lhs;h=51b7301f037246826ca2f02b3d310e697ce3f295;hb=68a1f0233996ed79824d11d946e9801473f6946c;hp=1631365ed65dbc81e30f82cc50d64e98aaf910df;hpb=e7d21ee4f8ac907665a7e170c71d59e13a01da09;p=ghc-hetmet.git

diff --git a/ghc/compiler/typecheck/TcBinds.lhs b/ghc/compiler/typecheck/TcBinds.lhs
index 1631365..51b7301 100644
--- a/ghc/compiler/typecheck/TcBinds.lhs
+++ b/ghc/compiler/typecheck/TcBinds.lhs
@@ -7,7 +7,8 @@
 #include "HsVersions.h"
 
 module TcBinds (
-	tcTopBindsAndThen, tcLocalBindsAndThen
+	tcTopBindsAndThen, tcLocalBindsAndThen,
+	tcSigs, doSpecPragma
     ) where
 
 --IMPORT_Trace		-- ToDo:rm (debugging)
@@ -272,7 +273,8 @@ tcBind_help top_level e bind sigs
     genBinds top_level e bind' lie lve sig_info	`thenTc` \ (binds', lie, lve) ->
 
 	-- Add bindings corresponding to SPECIALIZE pragmas in the code
-    mapAndUnzipTc (doSpecPragma e lve) (get_spec_pragmas sig_info)
+    mapAndUnzipTc (doSpecPragma e (assoc "doSpecPragma" lve))
+		  (get_spec_pragmas sig_info)
 			`thenTc` \ (spec_binds_s, spec_lie_s) ->
 
     returnTc (binds' `ThenBinds` (SingleBind (NonRecBind (
@@ -315,14 +317,14 @@ We generate:
 \end{verbatim}
 
 \begin{code}
-doSpecPragma :: E -> LVE
+doSpecPragma :: E
+	     -> (Name -> Id)
 	     -> SignatureInfo
 	     -> TcM (TypecheckedMonoBinds, LIE)
 
-doSpecPragma e lve (ValSpecInfo name spec_ty using src_loc)
+doSpecPragma e name_to_id (ValSpecInfo name spec_ty using src_loc)
   = let
-	main_id = assoc "doSpecPragma" lve name
-	    -- Get the parent Id; it should exist (renamer promises...).
+	main_id = name_to_id name    -- Get the parent Id
 
 	main_id_ty = getIdUniType main_id
 	main_id_free_tyvars = extractTyVarsFromTy main_id_ty