X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fiface%2FIfaceEnv.lhs;h=86f43cbccdcb940de28ff1a4e4c7d2280851cc53;hb=e4417dcd4679da9c6b18c02ff667199c572bed89;hp=d62aad1fb2e186401d302bd39953e4c05c9656ff;hpb=e04f49034968322349e0f3f608e1b5a856fd6521;p=ghc-hetmet.git diff --git a/compiler/iface/IfaceEnv.lhs b/compiler/iface/IfaceEnv.lhs index d62aad1..86f43cb 100644 --- a/compiler/iface/IfaceEnv.lhs +++ b/compiler/iface/IfaceEnv.lhs @@ -1,6 +1,13 @@ (c) The University of Glasgow 2002-2006 \begin{code} +{-# OPTIONS -w #-} +-- The above warning supression flag is a temporary kludge. +-- While working on this module you are encouraged to remove it and fix +-- any warnings in the module. See +-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings +-- for details + module IfaceEnv ( newGlobalBinder, newIPName, newImplicitBinder, lookupIfaceTop, @@ -29,7 +36,7 @@ import Name import OccName import PrelNames import Module -import UniqFM +import LazyUniqFM import FastString import UniqSupply import FiniteMap @@ -132,7 +139,7 @@ lookupAvail mod (AvailTC p_occ occs) = do p_name <- lookupOrig mod p_occ let lookup_sub occ | occ == p_occ = return p_name | otherwise = lookupOrig mod occ - subs <- mappM lookup_sub occs + subs <- mapM lookup_sub occs return (AvailTC p_name subs) -- Remember that 'occs' is all the exported things, including -- the parent. It's possible to export just class ops without @@ -152,7 +159,7 @@ lookupOrig mod occ ; name_cache <- getNameCache ; case lookupOrigNameCache (nsNames name_cache) mod occ of { - Just name -> returnM name; + Just name -> return name; Nothing -> let us = nsUniqs name_cache @@ -166,15 +173,14 @@ lookupOrig mod occ }}} newIPName :: IPName OccName -> TcRnIf m n (IPName Name) -newIPName occ_name_ip - = getNameCache `thenM` \ name_supply -> +newIPName occ_name_ip = do + name_supply <- getNameCache let ipcache = nsIPs name_supply - in case lookupFM ipcache key of - Just name_ip -> returnM name_ip - Nothing -> setNameCache new_ns `thenM_` - returnM name_ip + Just name_ip -> return name_ip + Nothing -> do setNameCache new_ns + return name_ip where (us', us1) = splitUniqSupply (nsUniqs name_supply) uniq = uniqFromSupply us1