+\subsection{Looking up fixities}
+%* *
+%*********************************************************
+
+lookupFixity is a bit strange.
+
+* Nested local fixity decls are put in the local fixity env, which we
+ find with getFixtyEnv
+
+* Imported fixities are found in the HIT or PIT
+
+* Top-level fixity decls in this module may be for Names that are
+ either Global (constructors, class operations)
+ or Local/Exported (everything else)
+ (See notes with RnNames.getLocalDeclBinders for why we have this split.)
+ We put them all in the local fixity environment
+
+\begin{code}
+lookupFixityRn :: Name -> RnMS Fixity
+lookupFixityRn name
+ = getModuleRn `thenRn` \ this_mod ->
+ if nameIsLocalOrFrom this_mod name
+ then -- It's defined in this module
+ getFixityEnv `thenRn` \ local_fix_env ->
+ returnRn (lookupLocalFixity local_fix_env name)
+
+ else -- It's imported
+ -- For imported names, we have to get their fixities by doing a
+ -- loadHomeInterface, and consulting the Ifaces that comes back
+ -- from that, because the interface file for the Name might not
+ -- have been loaded yet. Why not? Suppose you import module A,
+ -- which exports a function 'f', thus;
+ -- module CurrentModule where
+ -- import A( f )
+ -- module A( f ) where
+ -- import B( f )
+ -- Then B isn't loaded right away (after all, it's possible that
+ -- nothing from B will be used). When we come across a use of
+ -- 'f', we need to know its fixity, and it's then, and only
+ -- then, that we load B.hi. That is what's happening here.
+ loadInterface doc name_mod ImportBySystem `thenRn` \ iface ->
+ returnRn (lookupFixity (mi_fixities iface) name)
+ where
+ doc = ptext SLIT("Checking fixity for") <+> ppr name
+ name_mod = moduleName (nameModule name)
+
+--------------------------------
+lookupLocalFixity :: LocalFixityEnv -> Name -> Fixity
+lookupLocalFixity env name
+ = case lookupNameEnv env name of
+ Just (FixitySig _ fix _) -> fix
+ Nothing -> defaultFixity
+
+extendNestedFixityEnv :: [(Name, RenamedFixitySig)] -> RnMS a -> RnMS a
+-- Used for nested fixity decls
+-- No need to worry about type constructors here,
+-- Should check for duplicates but we don't
+extendNestedFixityEnv fixes enclosed_scope
+ = getFixityEnv `thenRn` \ fix_env ->
+ let
+ new_fix_env = extendNameEnvList fix_env fixes
+ in
+ setFixityEnv new_fix_env enclosed_scope
+
+mkTopFixityEnv :: GlobalRdrEnv -> [RdrNameFixitySig] -> RnMG LocalFixityEnv
+mkTopFixityEnv gbl_env fix_sigs
+ = getModuleRn `thenRn` \ mod ->
+ let
+ -- GHC extension: look up both the tycon and data con
+ -- for con-like things
+ -- If neither are in scope, report an error; otherwise
+ -- add both to the fixity env
+ go fix_env (FixitySig rdr_name fixity loc)
+ = case catMaybes (map (lookup_local mod gbl_env) rdr_names) of
+ [] -> pushSrcLocRn loc $
+ addErrRn (unknownNameErr rdr_name) `thenRn_`
+ returnRn fix_env
+ ns -> foldlRn add fix_env ns
+
+ where
+ add fix_env name
+ = case lookupNameEnv fix_env name of
+ Just (FixitySig _ _ loc') -> addErrRn (dupFixityDecl rdr_name loc loc') `thenRn_`
+ returnRn fix_env
+ Nothing -> returnRn (extendNameEnv fix_env name (FixitySig name fixity loc))
+
+ rdr_names | isDataSymOcc occ = [rdr_name, rdr_name_tc]
+ | otherwise = [rdr_name]
+
+ occ = rdrNameOcc rdr_name
+ rdr_name_tc = setRdrNameOcc rdr_name (setOccNameSpace occ tcName)
+ in
+ foldlRn go emptyLocalFixityEnv fix_sigs
+\end{code}
+
+
+%*********************************************************
+%* *
projects / ghc-hetmet.git / blobdiff