[project @ 1996-05-17 16:02:43 by partain]

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

diff --git a/ghc/compiler/typecheck/TcGenDeriv.lhs b/ghc/compiler/typecheck/TcGenDeriv.lhs
index d414786..8f19aef 100644 (file)
--- a/ghc/compiler/typecheck/TcGenDeriv.lhs
+++ b/ghc/compiler/typecheck/TcGenDeriv.lhs
@@ -1,5 +1,5 @@
 %
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
 %
 \section[TcGenDeriv]{Generating derived instance declarations}
 
@@ -81,7 +81,7 @@ import Maybes         ( maybeToBool )
 --import Name          ( Name(..) )
 import Outputable
 import PrimOp
-import PrelInfo
+--import PrelInfo
 import Pretty
 import SrcLoc          ( mkGeneratedSrcLoc )
 import TyCon           ( TyCon, tyConDataCons, isEnumerationTyCon, maybeTyConSingleCon )
@@ -517,7 +517,7 @@ gen_Ix_binds tycon
     then enum_ixes
     else single_con_ixes
   where
-    tycon_str = _UNPK_ (snd (getOrigName tycon))
+    tycon_str = _UNPK_ (snd (moduleNamePair tycon))
 
     --------------------------------------------------------------
     enum_ixes = enum_range `AndMonoBinds`
@@ -590,7 +590,7 @@ gen_Ix_binds tycon
     --------------------------------------------------------------
     single_con_range
       = mk_easy_FunMonoBind range_PN [TuplePatIn [con_pat as_needed, con_pat bs_needed]] [] (
-         ListComp (con_expr cs_needed) (zipWith3Equal mk_qual as_needed bs_needed cs_needed)
+         ListComp (con_expr cs_needed) (zipWith3Equal "single_con_range" mk_qual as_needed bs_needed cs_needed)
        )
       where
        mk_qual a b c = GeneratorQual (VarPatIn c)
@@ -619,7 +619,7 @@ gen_Ix_binds tycon
     ------------------
     single_con_inRange
       = mk_easy_FunMonoBind inRange_PN [TuplePatIn [con_pat as_needed, con_pat bs_needed], con_pat cs_needed] [] (
-         foldl1 and_Expr (zipWith3Equal in_range as_needed bs_needed cs_needed))
+         foldl1 and_Expr (zipWith3Equal "single_con_inRange" in_range as_needed bs_needed cs_needed))
       where
        in_range a b c = HsApp (HsApp (HsVar inRange_PN) (ExplicitTuple [HsVar a, HsVar b])) (HsVar c)
 \end{code}
@@ -655,7 +655,7 @@ gen_Read_binds fixities tycon
        read_con data_con   -- note: "b" is the string being "read"
          = let
                data_con_PN = Prel (WiredInId data_con)
-               data_con_str= snd  (getOrigName data_con)
+               data_con_str= snd  (moduleNamePair data_con)
                as_needed   = take (dataConArity data_con) as_PNs
                bs_needed   = take (dataConArity data_con) bs_PNs
                con_expr    = foldl HsApp (HsVar data_con_PN) (map HsVar as_needed)
@@ -666,7 +666,7 @@ gen_Read_binds fixities tycon
                      (TuplePatIn [LitPatIn (HsString data_con_str), d_Pat])
                      (HsApp (HsVar lex_PN) c_Expr)
 
-               field_quals = snd (mapAccumL mk_qual d_Expr (as_needed `zip` bs_needed))
+               field_quals = snd (mapAccumL mk_qual d_Expr (zipEqual "as_needed" as_needed bs_needed))
 
                read_paren_arg
                  = if nullary_con then -- must be False (parens are surely optional)
@@ -707,7 +707,7 @@ gen_Show_binds fixities tycon
                nullary_con = dataConArity data_con == 0
 
                show_con
-                 = let (mod, nm)   = getOrigName data_con
+                 = let (mod, nm)   = moduleNamePair data_con
                        space_maybe = if nullary_con then _NIL_ else SLIT(" ")
                    in
                        HsApp (HsVar showString_PN) (HsLit (HsString (nm _APPEND_ space_maybe)))
@@ -830,7 +830,7 @@ mk_easy_FunMonoBind :: RdrName -> [RdrNamePat]
                    -> RdrNameMonoBinds
 
 mk_easy_FunMonoBind fun pats binds expr
-  = FunMonoBind fun [mk_easy_Match pats binds expr] mkGeneratedSrcLoc
+  = FunMonoBind fun False{-not infix-} [mk_easy_Match pats binds expr] mkGeneratedSrcLoc
 
 mk_easy_Match pats binds expr
   = foldr PatMatch
@@ -849,7 +849,7 @@ mk_FunMonoBind      :: RdrName
 
 mk_FunMonoBind fun [] = panic "TcGenDeriv:mk_FunMonoBind"
 mk_FunMonoBind fun pats_and_exprs
-  = FunMonoBind fun (map mk_match pats_and_exprs) mkGeneratedSrcLoc
+  = FunMonoBind fun False{-not infix-} (map mk_match pats_and_exprs) mkGeneratedSrcLoc
   where
     mk_match (pats, expr)
       = foldr PatMatch
@@ -1047,11 +1047,11 @@ showString_PN   = prelude_val pRELUDE_TEXT SLIT("showString")
 showParen_PN   = prelude_val pRELUDE_TEXT SLIT("showParen")
 readParen_PN   = prelude_val pRELUDE_TEXT SLIT("readParen")
 lex_PN         = prelude_val pRELUDE_TEXT SLIT("lex")
-_showList_PN    = prelude_val pRELUDE_CORE SLIT("_showList")
-_readList_PN    = prelude_val pRELUDE_CORE SLIT("_readList")
+_showList_PN    = prelude_val pRELUDE SLIT("_showList")
+_readList_PN    = prelude_val pRELUDE SLIT("_readList")
 
 prelude_val    m s = Imp m s [m] s
-prelude_method c o = Imp pRELUDE_CORE o [pRELUDE_CORE] o -- class not used...
+prelude_method c o = Imp pRELUDE o [pRELUDE] o -- class not used...
 
 a_Expr         = HsVar a_PN
 b_Expr         = HsVar b_PN
@@ -1074,19 +1074,19 @@ d_Pat           = VarPatIn d_PN
 con2tag_PN, tag2con_PN, maxtag_PN :: TyCon -> RdrName
 
 con2tag_PN tycon
-  = let        (mod, nm) = getOrigName tycon
+  = let        (mod, nm) = moduleNamePair tycon
        con2tag   = SLIT("con2tag_") _APPEND_ nm _APPEND_ SLIT("#")
     in
     Imp mod con2tag [mod] con2tag
 
 tag2con_PN tycon
-  = let        (mod, nm) = getOrigName tycon
+  = let        (mod, nm) = moduleNamePair tycon
        tag2con   = SLIT("tag2con_") _APPEND_ nm _APPEND_ SLIT("#")
     in
     Imp mod tag2con [mod] tag2con
 
 maxtag_PN tycon
-  = let        (mod, nm) = getOrigName tycon
+  = let        (mod, nm) = moduleNamePair tycon
        maxtag    = SLIT("maxtag_") _APPEND_ nm _APPEND_ SLIT("#")
     in
     Imp mod maxtag [mod] maxtag
@@ -1095,19 +1095,19 @@ maxtag_PN tycon
 con2tag_FN, tag2con_FN, maxtag_FN :: TyCon -> RnName
 
 tag2con_FN tycon
-  = let        (mod, nm) = getOrigName tycon
+  = let        (mod, nm) = moduleNamePair tycon
        tag2con   = SLIT("tag2con_") _APPEND_ nm _APPEND_ SLIT("#")
     in
     mkFullName mod tag2con InventedInThisModule NotExported mkGeneratedSrcLoc
 
 maxtag_FN tycon
-  = let        (mod, nm) = getOrigName tycon
+  = let        (mod, nm) = moduleNamePair tycon
        maxtag    = SLIT("maxtag_") _APPEND_ nm _APPEND_ SLIT("#")
     in
     mkFullName mod maxtag InventedInThisModule NotExported mkGeneratedSrcLoc
 
 con2tag_FN tycon
-  = let        (mod, nm) = getOrigName tycon
+  = let        (mod, nm) = moduleNamePair tycon
        con2tag   = SLIT("con2tag_") _APPEND_ nm _APPEND_ SLIT("#")
     in
     mkFullName mod con2tag InventedInThisModule NotExported mkGeneratedSrcLoc