X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fiface%2FIfaceEnv.lhs;h=4d7c6114cdd8430e8168537fe9424f561ad577fe;hb=58d0b1faf2ea388c695fdaf55d80af9b87482572;hp=8074fe0d1810d8db620d792cb618eebe782a39d8;hpb=7fcfb091b89d24e32faf95487208caca47fd0ab8;p=ghc-hetmet.git diff --git a/compiler/iface/IfaceEnv.lhs b/compiler/iface/IfaceEnv.lhs index 8074fe0..4d7c611 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, @@ -8,6 +15,7 @@ module IfaceEnv ( newIfaceName, newIfaceNames, extendIfaceIdEnv, extendIfaceTyVarEnv, tcIfaceLclId, tcIfaceTyVar, + tcIfaceTick, ifaceExportNames, @@ -34,6 +42,7 @@ import UniqSupply import FiniteMap import BasicTypes import SrcLoc +import MkId import Outputable \end{code} @@ -46,7 +55,7 @@ import Outputable %********************************************************* \begin{code} -newGlobalBinder :: Module -> OccName -> SrcLoc -> TcRnIf a b Name +newGlobalBinder :: Module -> OccName -> SrcSpan -> TcRnIf a b Name -- Used for source code and interface files, to make the -- Name for a thing, given its Module and OccName -- @@ -66,7 +75,7 @@ newGlobalBinder mod occ loc allocateGlobalBinder :: NameCache - -> Module -> OccName -> SrcLoc + -> Module -> OccName -> SrcSpan -> (NameCache, Name) allocateGlobalBinder name_supply mod occ loc = case lookupOrigNameCache (nsNames name_supply) mod occ of @@ -114,7 +123,7 @@ newImplicitBinder :: Name -- Base name newImplicitBinder base_name mk_sys_occ = newGlobalBinder (nameModule base_name) (mk_sys_occ (nameOccName base_name)) - (nameSrcLoc base_name) + (nameSrcSpan base_name) ifaceExportNames :: [IfaceExport] -> TcRnIf gbl lcl [AvailInfo] ifaceExportNames exports = do @@ -155,7 +164,7 @@ lookupOrig mod occ let us = nsUniqs name_cache uniq = uniqFromSupply us - name = mkExternalName uniq mod occ noSrcLoc + name = mkExternalName uniq mod occ noSrcSpan new_cache = extendNameCache (nsNames name_cache) mod occ name in case splitUniqSupply us of { (us',_) -> do @@ -292,11 +301,27 @@ lookupIfaceTop occ newIfaceName :: OccName -> IfL Name newIfaceName occ = do { uniq <- newUnique - ; return $! mkInternalName uniq occ noSrcLoc } + ; return $! mkInternalName uniq occ noSrcSpan } newIfaceNames :: [OccName] -> IfL [Name] newIfaceNames occs = do { uniqs <- newUniqueSupply - ; return [ mkInternalName uniq occ noSrcLoc + ; return [ mkInternalName uniq occ noSrcSpan | (occ,uniq) <- occs `zip` uniqsFromSupply uniqs] } \end{code} + +%************************************************************************ +%* * + (Re)creating tick boxes +%* * +%************************************************************************ + +\begin{code} +tcIfaceTick :: Module -> Int -> IfL Id +tcIfaceTick modName tickNo + = do { uniq <- newUnique + ; return $ mkTickBoxOpId uniq modName tickNo + } +\end{code} + +