[project @ 2000-10-12 13:44:59 by simonpj]

[ghc-hetmet.git] / ghc / compiler / typecheck / TcGenDeriv.lhs

diff --git a/ghc/compiler/typecheck/TcGenDeriv.lhs b/ghc/compiler/typecheck/TcGenDeriv.lhs
index d216ae6..bf828e4 100644 (file)
--- a/ghc/compiler/typecheck/TcGenDeriv.lhs
+++ b/ghc/compiler/typecheck/TcGenDeriv.lhs
@@ -31,25 +31,23 @@ import HsSyn                ( InPat(..), HsExpr(..), MonoBinds(..),
                          HsBinds(..), StmtCtxt(..), HsType(..),
                          unguardedRHS, mkSimpleMatch, mkMonoBind, andMonoBindList
                        )
-import RdrHsSyn                ( mkOpApp, RdrNameMonoBinds, RdrNameHsExpr, RdrNamePat )
-import RdrName         ( RdrName, mkSrcUnqual )
-import RnMonad         ( FixityEnv, lookupFixity )
+import RdrHsSyn                ( mkHsOpApp, RdrNameMonoBinds, RdrNameHsExpr, RdrNamePat )
+import RdrName         ( RdrName, mkUnqual )
 import BasicTypes      ( RecFlag(..), Fixity(..), FixityDirection(..)
-                       , maxPrecedence, defaultFixity
+                       , maxPrecedence
                        , Boxity(..)
                        )
 import FieldLabel       ( fieldLabelName )
 import DataCon         ( isNullaryDataCon, dataConTag,
                          dataConOrigArgTys, dataConSourceArity, fIRST_TAG,
-                         DataCon, ConTag,
+                         DataCon, 
                          dataConFieldLabels )
 import Name            ( getOccString, getOccName, getSrcLoc, occNameString, 
                          occNameUserString, nameRdrName, varName,
-                         OccName, Name, NamedThing(..), NameSpace,
+                         Name, NamedThing(..), 
                          isDataSymOcc, isSymOcc
                        )
 
-import PrimOp          ( PrimOp(..) )
 import PrelInfo                -- Lots of RdrNames
 import SrcLoc          ( mkGeneratedSrcLoc, SrcLoc )
 import TyCon           ( TyCon, isNewTyCon, tyConDataCons, isEnumerationTyCon,
@@ -60,12 +58,11 @@ import TysPrim              ( charPrimTy, intPrimTy, wordPrimTy, addrPrimTy,
                          floatPrimTy, doublePrimTy
                        )
 import Util            ( mapAccumL, zipEqual, zipWithEqual,
-                         zipWith3Equal, nOfThem, assocDefault )
+                         zipWith3Equal, nOfThem )
 import Panic           ( panic, assertPanic )
 import Maybes          ( maybeToBool )
 import Constants
 import List            ( partition, intersperse )
-import Char            ( isAlpha )
 
 #if __GLASGOW_HASKELL__ >= 404
 import GlaExts         ( fromInt )
@@ -776,7 +773,7 @@ gen_Ix_binds tycon
 \begin{code}
 gen_Read_binds :: FixityEnv -> TyCon -> RdrNameMonoBinds
 
-gen_Read_binds fixity_env tycon
+gen_Read_binds gst tycon
   = reads_prec `AndMonoBinds` read_list
   where
     tycon_loc = getSrcLoc tycon
@@ -904,7 +901,7 @@ gen_Read_binds fixity_env tycon
                                                    then d_Expr 
                                                    else HsVar (last bs_needed)] Boxed
 
-           [lp,rp] = getLRPrecs is_infix fixity_env dc_nm
+           [lp,rp] = getLRPrecs is_infix gst dc_nm
 
            quals
            | is_infix  = let (h:t) = field_quals in (h:con_qual:t)
@@ -917,7 +914,7 @@ gen_Read_binds fixity_env tycon
            -}
           paren_prec_limit
             | not is_infix  = fromInt maxPrecedence
-            | otherwise     = getFixity fixity_env dc_nm
+            | otherwise     = getFixity gst dc_nm
 
           read_paren_arg   -- parens depend on precedence...
            | nullary_con  = false_Expr -- it's optional.
@@ -931,9 +928,9 @@ gen_Read_binds fixity_env tycon
 %************************************************************************
 
 \begin{code}
-gen_Show_binds :: FixityEnv -> TyCon -> RdrNameMonoBinds
+gen_Show_binds :: GlobalSymbolTable -> TyCon -> RdrNameMonoBinds
 
-gen_Show_binds fixity_env tycon
+gen_Show_binds gst tycon
   = shows_prec `AndMonoBinds` show_list
   where
     tycon_loc = getSrcLoc tycon
@@ -1004,7 +1001,7 @@ gen_Show_binds fixity_env tycon
              mk_showString_app str = HsApp (HsVar showString_RDR)
                                           (HsLit (mkHsString str))
 
-             prec_cons = getLRPrecs is_infix fixity_env dc_nm
+             prec_cons = getLRPrecs is_infix gst dc_nm
 
              real_show_thingies
                | is_infix  = 
@@ -1025,27 +1022,25 @@ gen_Show_binds fixity_env tycon
                                 (map show_label labels) 
                                 real_show_thingies
                               
-            (con_left_assoc, con_right_assoc) = isLRAssoc fixity_env dc_nm
-
              {-
                c.f. Figure 16 and 17 in Haskell 1.1 report
              -}  
             paren_prec_limit
                | not is_infix = fromInt maxPrecedence + 1
-               | otherwise    = getFixity fixity_env dc_nm + 1
+               | otherwise    = getFixity gst dc_nm + 1
 
 \end{code}
 
 \begin{code}
-getLRPrecs :: Bool -> FixityEnv -> Name -> [Integer]
-getLRPrecs is_infix fixity_env nm = [lp, rp]
+getLRPrecs :: Bool -> GlobalSymbolTable -> Name -> [Integer]
+getLRPrecs is_infix gst nm = [lp, rp]
     where
      {-
        Figuring out the fixities of the arguments to a constructor,
        cf. Figures 16-18 in Haskell 1.1 report.
      -}
-     (con_left_assoc, con_right_assoc) = isLRAssoc fixity_env nm
-     paren_con_prec = getFixity fixity_env nm
+     (con_left_assoc, con_right_assoc) = isLRAssoc gst nm
+     paren_con_prec = getFixity gst nm
      maxPrec       = fromInt maxPrecedence
 
      lp
@@ -1058,9 +1053,9 @@ getLRPrecs is_infix fixity_env nm = [lp, rp]
       | con_right_assoc = paren_con_prec
       | otherwise       = paren_con_prec + 1
                  
-getFixity :: FixityEnv -> Name -> Integer
-getFixity fixity_env nm = case lookupFixity fixity_env nm of
-                            Fixity x _ -> fromInt x
+getFixity :: GobalSymbolTable -> Name -> Integer
+getFixity gst nm = case lookupFixityEnv gst nm of
+                       Fixity x _ -> fromInt x
 
 isLRAssoc :: FixityEnv -> Name -> (Bool, Bool)
 isLRAssoc fixs_assoc nm =
@@ -1354,12 +1349,12 @@ parenify e           = HsPar e
 -- For some reason the renamer doesn't reassociate it right, and I can't
 -- be bothered to find out why just now.
 
-genOpApp e1 op e2 = mkOpApp e1 op e2
+genOpApp e1 op e2 = mkHsOpApp e1 op e2
 \end{code}
 
 \begin{code}
 qual_orig_name n = nameRdrName (getName n)
-varUnqual n      = mkSrcUnqual varName n
+varUnqual n      = mkUnqual varName n
 
 zz_a_RDR       = varUnqual SLIT("_a")
 a_RDR          = varUnqual SLIT("a")