[project @ 2002-09-13 15:01:40 by simonpj]

[ghc-hetmet.git] / ghc / compiler / rename / RnMonad.lhs

diff --git a/ghc/compiler/rename/RnMonad.lhs b/ghc/compiler/rename/RnMonad.lhs
index 2eb8003..254b8ec 100644 (file)
--- a/ghc/compiler/rename/RnMonad.lhs
+++ b/ghc/compiler/rename/RnMonad.lhs
@@ -35,7 +35,8 @@ import HscTypes               ( AvailEnv, emptyAvailEnv, lookupType,
                          PersistentCompilerState(..), GlobalRdrEnv, 
                          LocalRdrEnv,
                          HomeIfaceTable, PackageIfaceTable )
-import BasicTypes      ( Version, defaultFixity )
+import BasicTypes      ( Version, defaultFixity, 
+                         Fixity(..), FixityDirection(..) )
 import ErrUtils                ( addShortErrLocLine, addShortWarnLocLine,
                          Message, Messages, errorsFound, warningsFound,
                          printErrorsAndWarnings
@@ -44,14 +45,16 @@ import RdrName              ( RdrName, dummyRdrVarName, rdrNameModule, rdrNameOcc,
                          RdrNameEnv, emptyRdrEnv, extendRdrEnv, 
                          addListToRdrEnv, rdrEnvToList, rdrEnvElts
                        )
+import Id              ( idName )
+import MkId            ( seqId )
 import Name            ( Name, OccName, NamedThing(..), 
-                         nameOccName,
-                         decode, mkLocalName, mkKnownKeyGlobal
+                         nameOccName, nameRdrName,
+                         decode, mkInternalName
                        )
 import NameEnv         ( NameEnv, lookupNameEnv, emptyNameEnv,
                          extendNameEnvList )
 import Module          ( Module, ModuleName, ModuleSet, emptyModuleSet,
-                         PackageName )
+                         PackageName, preludePackage )
 import PrelInfo                ( ghcPrimExports, 
                          cCallableClassDecl, cReturnableClassDecl, assertDecl )
 import PrelNames       ( mkUnboundName, gHC_PRIM_Name )
@@ -65,8 +68,10 @@ import Bag           ( Bag, emptyBag, isEmptyBag, snocBag )
 import UniqSupply
 import Outputable
 
-import IOExts          ( IORef, newIORef, readIORef, writeIORef, 
-                         fixIO, unsafePerformIO )
+import DATA_IOREF      ( IORef, newIORef, readIORef, writeIORef )
+import UNSAFE_IO       ( unsafePerformIO )
+import FIX_IO          ( fixIO )
+
 import IO              ( hPutStr, stderr )
        
 infixr 9 `thenRn`, `thenRn_`
@@ -179,12 +184,7 @@ isCmdLineMode CmdLineMode = True
 isCmdLineMode _ = False
 \end{code}
 
-%===================================================
-\subsubsection{                ENVIRONMENTS}
-%===================================================
-
 \begin{code}
---------------------------------
 type LocalFixityEnv = NameEnv RenamedFixitySig
        -- We keep the whole fixity sig so that we
        -- can report line-number info when there is a duplicate
@@ -192,14 +192,9 @@ type LocalFixityEnv = NameEnv RenamedFixitySig
 
 emptyLocalFixityEnv :: LocalFixityEnv
 emptyLocalFixityEnv = emptyNameEnv
-
-lookupLocalFixity :: LocalFixityEnv -> Name -> Fixity
-lookupLocalFixity env name
-  = case lookupNameEnv env name of 
-       Just (FixitySig _ fix _) -> fix
-       Nothing                  -> defaultFixity
 \end{code}
 
+
 %************************************************************************
 %*                                                                     *
 \subsection{Interface file stuff}
@@ -238,7 +233,7 @@ data ParsedIface
 ghcPrimIface :: ParsedIface
 ghcPrimIface = ParsedIface {
       pi_mod    = gHC_PRIM_Name,
-      pi_pkg     = FSLIT("base"),
+      pi_pkg     = preludePackage,
       pi_vers    = 1,
       pi_orphan  = False,
       pi_usages  = [],
@@ -246,7 +241,8 @@ ghcPrimIface = ParsedIface {
       pi_decls   = [(1,cCallableClassDecl), 
                    (1,cReturnableClassDecl), 
                    (1,assertDecl)],
-      pi_fixity  = [],
+      pi_fixity  = [(nameRdrName (idName seqId), Fixity 0 InfixR)],
+               -- seq is infixr 0
       pi_insts   = [],
       pi_rules   = (1,[]),
       pi_deprecs = Nothing
@@ -727,13 +723,9 @@ getFixityEnv :: RnMS LocalFixityEnv
 getFixityEnv rn_down (SDown {rn_fixenv = fixity_env})
   = return fixity_env
 
-extendFixityEnv :: [(Name, RenamedFixitySig)] -> RnMS a -> RnMS a
-extendFixityEnv fixes enclosed_scope
-               rn_down l_down@(SDown {rn_fixenv = fixity_env})
-  = let
-       new_fixity_env = extendNameEnvList fixity_env fixes
-    in
-    enclosed_scope rn_down (l_down {rn_fixenv = new_fixity_env})
+setFixityEnv :: LocalFixityEnv -> RnMS a -> RnMS a
+setFixityEnv fixes enclosed_scope rn_down l_down
+  = enclosed_scope rn_down (l_down {rn_fixenv = fixes})
 \end{code}
 
 %================