[project @ 2002-06-05 14:39:27 by simonpj]
[ghc-hetmet.git] / ghc / compiler / typecheck / TcGenDeriv.lhs
index 2422b42..4636cde 100644 (file)
@@ -28,16 +28,16 @@ module TcGenDeriv (
 
 import HsSyn           ( InPat(..), HsExpr(..), MonoBinds(..),
                          Match(..), GRHSs(..), Stmt(..), HsLit(..),
-                         HsBinds(..), HsType(..), HsMatchContext(..),
-                         unguardedRHS, mkSimpleMatch, mkMonoBind, andMonoBindList
+                         HsBinds(..), HsType(..), HsDoContext(..),
+                         unguardedRHS, mkSimpleMatch, mkMonoBind, andMonoBindList, placeHolderType
                        )
-import RdrHsSyn                ( mkHsOpApp, RdrNameMonoBinds, RdrNameHsExpr, RdrNamePat )
 import RdrName         ( RdrName, mkUnqual )
+import RdrHsSyn                ( mkHsOpApp, RdrNameMonoBinds, RdrNameHsExpr, RdrNamePat, mkHsDo )
 import BasicTypes      ( RecFlag(..), Fixity(..), FixityDirection(..)
-                       , maxPrecedence, defaultFixity
+                       , maxPrecedence
                        , Boxity(..)
                        )
-import FieldLabel       ( fieldLabelName )
+import FieldLabel       ( FieldLabel, fieldLabelName )
 import DataCon         ( isNullaryDataCon, dataConTag,
                          dataConOrigArgTys, dataConSourceArity, fIRST_TAG,
                          DataCon, 
@@ -48,25 +48,24 @@ import Name         ( getOccString, getOccName, getSrcLoc, occNameString,
                          isDataSymOcc, isSymOcc
                        )
 
+import HscTypes                ( FixityEnv, lookupFixity )
 import PrelInfo                -- Lots of RdrNames
 import SrcLoc          ( generatedSrcLoc, SrcLoc )
 import TyCon           ( TyCon, isNewTyCon, tyConDataCons, isEnumerationTyCon,
                          maybeTyConSingleCon, tyConFamilySize
                        )
-import Type            ( isUnLiftedType, Type )
+import TcType          ( isUnLiftedType, tcEqType, Type )
 import TysPrim         ( charPrimTy, intPrimTy, wordPrimTy, addrPrimTy,
                          floatPrimTy, doublePrimTy
                        )
-import Util            ( mapAccumL, zipEqual, zipWithEqual,
+import Util            ( mapAccumL, zipEqual, zipWithEqual, isSingleton,
                          zipWith3Equal, nOfThem )
 import Panic           ( panic, assertPanic )
-import Maybes          ( maybeToBool, orElse )
+import Maybes          ( maybeToBool )
+import Char            ( ord, isAlpha )
 import Constants
 import List            ( partition, intersperse )
-
-#if __GLASGOW_HASKELL__ >= 404
-import GlaExts         ( fromInt )
-#endif
+import FastString
 \end{code}
 
 %************************************************************************
@@ -184,12 +183,12 @@ gen_Eq_binds tycon
            else -- calc. and compare the tags
                 [([a_Pat, b_Pat],
                    untag_Expr tycon [(a_RDR,ah_RDR), (b_RDR,bh_RDR)]
-                     (cmp_tags_Expr eqH_Int_RDR ah_RDR bh_RDR true_Expr false_Expr))]
+                              (genOpApp (HsVar ah_RDR) eqH_Int_RDR (HsVar bh_RDR)))]
     in
     mk_FunMonoBind tycon_loc eq_RDR ((map pats_etc nonnullary_cons) ++ rest)
            `AndMonoBinds`
     mk_easy_FunMonoBind tycon_loc ne_RDR [a_Pat, b_Pat] [] (
-       HsApp (HsVar not_RDR) (HsPar (mk_easy_App eq_RDR [a_RDR, b_RDR])))
+       HsApp (HsVar not_RDR) (HsPar (mkHsVarApps eq_RDR [a_RDR, b_RDR])))
   where
     ------------------------------------------------------------------
     pats_etc data_con
@@ -351,7 +350,7 @@ gen_Ord_binds tycon
     cmp_eq =
        mk_FunMonoBind tycon_loc 
                       cmp_eq_RDR 
-                      (if null nonnullary_cons && (length nullary_cons == 1) then
+                      (if null nonnullary_cons && isSingleton nullary_cons then
                           -- catch this specially to avoid warnings
                           -- about overlapping patterns from the desugarer.
                          let 
@@ -363,7 +362,7 @@ gen_Ord_binds tycon
                       else
                          map pats_etc nonnullary_cons ++
                          -- leave out wildcards to silence desugarer.
-                         (if length tycon_data_cons == 1 then
+                         (if isSingleton tycon_data_cons then
                              []
                           else
                               [([WildPatIn, WildPatIn], default_rhs)]))
@@ -392,26 +391,6 @@ gen_Ord_binds tycon
                                                                -- inexhaustive patterns
                    | otherwise         = eqTag_Expr            -- Some nullary constructors;
                                                                -- Tags are equal, no args => return EQ
-    --------------------------------------------------------------------
-
-{- Not necessary: the default decls in PrelBase handle these 
-
-defaulted = foldr1 AndMonoBinds [lt, le, ge, gt, max_, min_]
-
-lt = mk_easy_FunMonoBind generatedSrcLoc lt_RDR [a_Pat, b_Pat] [] (
-           compare_Case true_Expr  false_Expr false_Expr a_Expr b_Expr)
-le = mk_easy_FunMonoBind generatedSrcLoc le_RDR [a_Pat, b_Pat] [] (
-           compare_Case true_Expr  true_Expr  false_Expr a_Expr b_Expr)
-ge = mk_easy_FunMonoBind generatedSrcLoc ge_RDR [a_Pat, b_Pat] [] (
-           compare_Case false_Expr true_Expr  true_Expr  a_Expr b_Expr)
-gt = mk_easy_FunMonoBind generatedSrcLoc gt_RDR [a_Pat, b_Pat] [] (
-           compare_Case false_Expr false_Expr true_Expr  a_Expr b_Expr)
-
-max_ = mk_easy_FunMonoBind generatedSrcLoc max_RDR [a_Pat, b_Pat] [] (
-           compare_Case b_Expr a_Expr a_Expr a_Expr b_Expr)
-min_ = mk_easy_FunMonoBind generatedSrcLoc min_RDR [a_Pat, b_Pat] [] (
-           compare_Case a_Expr b_Expr b_Expr a_Expr b_Expr)
--}
 \end{code}
 
 %************************************************************************
@@ -472,68 +451,60 @@ gen_Enum_binds tycon
     succ_enum
       = mk_easy_FunMonoBind tycon_loc succ_RDR [a_Pat] [] $
        untag_Expr tycon [(a_RDR, ah_RDR)] $
-       HsIf (HsApp (HsApp (HsVar eq_RDR) 
-                          (HsVar (maxtag_RDR tycon)))
-                          (mk_easy_App mkInt_RDR [ah_RDR]))
+       HsIf (mkHsApps eq_RDR [HsVar (maxtag_RDR tycon),
+                              mkHsVarApps mkInt_RDR [ah_RDR]])
             (illegal_Expr "succ" occ_nm "tried to take `succ' of last tag in enumeration")
             (HsApp (HsVar (tag2con_RDR tycon))
-                   (HsApp (HsApp (HsVar plus_RDR)
-                                 (mk_easy_App mkInt_RDR [ah_RDR]))
-                          (HsLit (HsInt 1))))
+                   (mkHsApps plus_RDR [mkHsVarApps mkInt_RDR [ah_RDR],
+                                       mkHsIntLit 1]))
             tycon_loc
                    
     pred_enum
       = mk_easy_FunMonoBind tycon_loc pred_RDR [a_Pat] [] $
        untag_Expr tycon [(a_RDR, ah_RDR)] $
-       HsIf (HsApp (HsApp (HsVar eq_RDR) (HsLit (HsInt 0)))
-                   (mk_easy_App mkInt_RDR [ah_RDR]))
+       HsIf (mkHsApps eq_RDR [mkHsIntLit 0,
+                              mkHsVarApps mkInt_RDR [ah_RDR]])
             (illegal_Expr "pred" occ_nm "tried to take `pred' of first tag in enumeration")
             (HsApp (HsVar (tag2con_RDR tycon))
-                          (HsApp (HsApp (HsVar plus_RDR)
-                                        (mk_easy_App mkInt_RDR [ah_RDR]))
-                                 (HsLit (HsInt (-1)))))
+                          (mkHsApps plus_RDR [mkHsVarApps mkInt_RDR [ah_RDR],
+                                              HsLit (HsInt (-1))]))
             tycon_loc
 
     to_enum
       = mk_easy_FunMonoBind tycon_loc toEnum_RDR [a_Pat] [] $
-       HsIf (HsApp (HsApp 
-                   (HsVar and_RDR)
-                   (HsApp (HsApp (HsVar ge_RDR)
-                                 (HsVar a_RDR))
-                                 (HsLit (HsInt 0))))
-                    (HsApp (HsApp (HsVar le_RDR)
-                                 (HsVar a_RDR))
-                                 (HsVar (maxtag_RDR tycon))))
-             (mk_easy_App (tag2con_RDR tycon) [a_RDR])
+       HsIf (mkHsApps and_RDR
+               [mkHsApps ge_RDR [HsVar a_RDR, mkHsIntLit 0],
+                 mkHsApps le_RDR [HsVar a_RDR, HsVar (maxtag_RDR tycon)]])
+             (mkHsVarApps (tag2con_RDR tycon) [a_RDR])
             (illegal_toEnum_tag occ_nm (maxtag_RDR tycon))
             tycon_loc
 
     enum_from
       = mk_easy_FunMonoBind tycon_loc enumFrom_RDR [a_Pat] [] $
          untag_Expr tycon [(a_RDR, ah_RDR)] $
-         HsApp (mk_easy_App map_RDR [tag2con_RDR tycon]) $
-           HsPar (enum_from_to_Expr
-                   (mk_easy_App mkInt_RDR [ah_RDR])
-                   (HsVar (maxtag_RDR tycon)))
+         mkHsApps map_RDR 
+               [HsVar (tag2con_RDR tycon),
+                HsPar (enum_from_to_Expr
+                           (mkHsVarApps mkInt_RDR [ah_RDR])
+                           (HsVar (maxtag_RDR tycon)))]
 
     enum_from_then
       = mk_easy_FunMonoBind tycon_loc enumFromThen_RDR [a_Pat, b_Pat] [] $
          untag_Expr tycon [(a_RDR, ah_RDR), (b_RDR, bh_RDR)] $
-         HsApp (mk_easy_App map_RDR [tag2con_RDR tycon]) $
+         HsApp (mkHsVarApps map_RDR [tag2con_RDR tycon]) $
            HsPar (enum_from_then_to_Expr
-                   (mk_easy_App mkInt_RDR [ah_RDR])
-                   (mk_easy_App mkInt_RDR [bh_RDR])
-                   (HsIf  (HsApp (HsApp (HsVar gt_RDR)
-                                        (mk_easy_App mkInt_RDR [ah_RDR]))
-                                        (mk_easy_App mkInt_RDR [bh_RDR]))
-                          (HsLit (HsInt 0))
+                   (mkHsVarApps mkInt_RDR [ah_RDR])
+                   (mkHsVarApps mkInt_RDR [bh_RDR])
+                   (HsIf  (mkHsApps gt_RDR [mkHsVarApps mkInt_RDR [ah_RDR],
+                                            mkHsVarApps mkInt_RDR [bh_RDR]])
+                          (mkHsIntLit 0)
                           (HsVar (maxtag_RDR tycon))
                           tycon_loc))
 
     from_enum
       = mk_easy_FunMonoBind tycon_loc fromEnum_RDR [a_Pat] [] $
          untag_Expr tycon [(a_RDR, ah_RDR)] $
-         (mk_easy_App mkInt_RDR [ah_RDR])
+         (mkHsVarApps mkInt_RDR [ah_RDR])
 \end{code}
 
 %************************************************************************
@@ -547,7 +518,7 @@ gen_Bounded_binds tycon
   = if isEnumerationTyCon tycon then
        min_bound_enum `AndMonoBinds` max_bound_enum
     else
-       ASSERT(length data_cons == 1)
+       ASSERT(isSingleton data_cons)
        min_bound_1con `AndMonoBinds` max_bound_1con
   where
     data_cons = tyConDataCons tycon
@@ -566,9 +537,9 @@ gen_Bounded_binds tycon
     arity         = dataConSourceArity data_con_1
 
     min_bound_1con = mk_easy_FunMonoBind tycon_loc minBound_RDR [] [] $
-                    mk_easy_App data_con_1_RDR (nOfThem arity minBound_RDR)
+                    mkHsVarApps data_con_1_RDR (nOfThem arity minBound_RDR)
     max_bound_1con = mk_easy_FunMonoBind tycon_loc maxBound_RDR [] [] $
-                    mk_easy_App data_con_1_RDR (nOfThem arity maxBound_RDR)
+                    mkHsVarApps data_con_1_RDR (nOfThem arity maxBound_RDR)
 \end{code}
 
 %************************************************************************
@@ -649,28 +620,28 @@ gen_Ix_binds tycon
                [TuplePatIn [a_Pat, b_Pat] Boxed] [] $
          untag_Expr tycon [(a_RDR, ah_RDR)] $
          untag_Expr tycon [(b_RDR, bh_RDR)] $
-         HsApp (mk_easy_App map_RDR [tag2con_RDR tycon]) $
+         HsApp (mkHsVarApps map_RDR [tag2con_RDR tycon]) $
              HsPar (enum_from_to_Expr
-                       (mk_easy_App mkInt_RDR [ah_RDR])
-                       (mk_easy_App mkInt_RDR [bh_RDR]))
+                       (mkHsVarApps mkInt_RDR [ah_RDR])
+                       (mkHsVarApps mkInt_RDR [bh_RDR]))
 
     enum_index
       = mk_easy_FunMonoBind tycon_loc index_RDR 
                [AsPatIn c_RDR (TuplePatIn [a_Pat, wildPat] Boxed), 
                                d_Pat] [] (
-       HsIf (HsPar (mk_easy_App inRange_RDR [c_RDR, d_RDR])) (
+       HsIf (HsPar (mkHsVarApps inRange_RDR [c_RDR, d_RDR])) (
           untag_Expr tycon [(a_RDR, ah_RDR)] (
           untag_Expr tycon [(d_RDR, dh_RDR)] (
           let
-               rhs = mk_easy_App mkInt_RDR [c_RDR]
+               rhs = mkHsVarApps mkInt_RDR [c_RDR]
           in
           HsCase
             (genOpApp (HsVar dh_RDR) minusH_RDR (HsVar ah_RDR))
-            [mkSimpleMatch [VarPatIn c_RDR] rhs Nothing tycon_loc]
+            [mkSimpleMatch [VarPatIn c_RDR] rhs placeHolderType tycon_loc]
             tycon_loc
           ))
        ) {-else-} (
-          HsApp (HsVar error_RDR) (HsLit (HsString (_PK_ ("Ix."++tycon_str++".index: out of range\n"))))
+          HsApp (HsVar error_RDR) (HsLit (HsString (mkFastString ("Ix."++tycon_str++".index: out of range\n"))))
        )
        tycon_loc)
 
@@ -708,17 +679,17 @@ gen_Ix_binds tycon
     cs_needed = take con_arity cs_RDRs
 
     con_pat  xs  = ConPatIn data_con_RDR (map VarPatIn xs)
-    con_expr     = mk_easy_App data_con_RDR cs_needed
+    con_expr     = mkHsVarApps data_con_RDR cs_needed
 
     --------------------------------------------------------------
     single_con_range
       = mk_easy_FunMonoBind tycon_loc range_RDR 
          [TuplePatIn [con_pat as_needed, con_pat bs_needed] Boxed] [] $
-       HsDo ListComp stmts tycon_loc
+       mkHsDo ListComp stmts tycon_loc
       where
        stmts = zipWith3Equal "single_con_range" mk_qual as_needed bs_needed cs_needed
                ++
-               [ExprStmt con_expr tycon_loc]
+               [ResultStmt con_expr tycon_loc]
 
        mk_qual a b c = BindStmt (VarPatIn c)
                                 (HsApp (HsVar range_RDR) 
@@ -730,12 +701,12 @@ gen_Ix_binds tycon
       = mk_easy_FunMonoBind tycon_loc index_RDR 
                [TuplePatIn [con_pat as_needed, con_pat bs_needed] Boxed, 
                 con_pat cs_needed] [range_size] (
-       foldl mk_index (HsLit (HsInt 0)) (zip3 as_needed bs_needed cs_needed))
+       foldl mk_index (mkHsIntLit 0) (zip3 as_needed bs_needed cs_needed))
       where
        mk_index multiply_by (l, u, i)
          = genOpApp (
-              (HsApp (HsApp (HsVar index_RDR) 
-                     (ExplicitTuple [HsVar l, HsVar u] Boxed)) (HsVar i))
+              (mkHsApps index_RDR [ExplicitTuple [HsVar l, HsVar u] Boxed,  
+                                   HsVar i])
           ) plus_RDR (
                genOpApp (
                    (HsApp (HsVar rangeSize_RDR) 
@@ -747,9 +718,9 @@ gen_Ix_binds tycon
          = mk_easy_FunMonoBind tycon_loc rangeSize_RDR 
                        [TuplePatIn [a_Pat, b_Pat] Boxed] [] (
                genOpApp (
-                   (HsApp (HsApp (HsVar index_RDR) 
-                          (ExplicitTuple [a_Expr, b_Expr] Boxed)) b_Expr)
-               ) plus_RDR (HsLit (HsInt 1)))
+                   (mkHsApps index_RDR [ExplicitTuple [a_Expr, b_Expr] Boxed,
+                                        b_Expr])
+               ) plus_RDR (mkHsIntLit 1))
 
     ------------------
     single_con_inRange
@@ -759,9 +730,8 @@ gen_Ix_binds tycon
                           [] (
          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_RDR) 
-                                     (ExplicitTuple [HsVar a, HsVar b] Boxed)) 
-                              (HsVar c)
+       in_range a b c = mkHsApps inRange_RDR [ExplicitTuple [HsVar a, HsVar b] Boxed,
+                                              HsVar c]
 \end{code}
 
 %************************************************************************
@@ -770,157 +740,150 @@ gen_Ix_binds tycon
 %*                                                                     *
 %************************************************************************
 
+Example
+
+  infix 4 %%
+  data T = Int %% Int
+        | T1 { f1 :: Int }
+        | T2 Int
+
+
+instance Read T where
+  readPrec =
+    block
+    ( prec 4 (
+        do x           <- ReadP.step Read.readPrec
+           Symbol "%%" <- Lex.lex
+           y           <- ReadP.step Read.readPrec
+           return (x %% y))
+      +++
+      prec appPrec (
+       do Ident "T1" <- Lex.lex
+          Punc '{' <- Lex.lex
+          Ident "f1" <- Lex.lex
+          Punc '=' <- Lex.lex
+          x          <- ReadP.reset Read.readPrec
+          Punc '}' <- Lex.lex
+          return (T1 { f1 = x }))
+      +++
+      prec appPrec (
+        do Ident "T2" <- Lex.lexP
+           x          <- ReadP.step Read.readPrec
+           return (T2 x))
+    )
+
+  readListPrec = readListPrecDefault
+  readList     = readListDefault
+
+
 \begin{code}
-gen_Read_binds :: (Name -> Maybe Fixity) -> TyCon -> RdrNameMonoBinds
+gen_Read_binds :: FixityEnv -> TyCon -> RdrNameMonoBinds
 
 gen_Read_binds get_fixity tycon
-  = reads_prec `AndMonoBinds` read_list
+  = read_prec `AndMonoBinds` default_binds
   where
-    tycon_loc = getSrcLoc tycon
     -----------------------------------------------------------------------
-    read_list = mk_easy_FunMonoBind tycon_loc readList_RDR [] []
-                 (HsApp (HsVar readList___RDR) (HsPar (HsApp (HsVar readsPrec_RDR) (HsLit (HsInt 0)))))
+    default_binds 
+       = mk_easy_FunMonoBind loc readList_RDR     [] [] (HsVar readListDefault_RDR)
+               `AndMonoBinds`
+         mk_easy_FunMonoBind loc readListPrec_RDR [] [] (HsVar readListPrecDefault_RDR)
     -----------------------------------------------------------------------
-    reads_prec
-      = let
-           read_con_comprehensions
-             = map read_con (tyConDataCons tycon)
-       in
-       mk_easy_FunMonoBind tycon_loc readsPrec_RDR [zz_a_Pat, b_Pat] [] (
-             foldr1 append_Expr read_con_comprehensions
-       )
+
+    loc       = getSrcLoc tycon
+    data_cons = tyConDataCons tycon
+    (nullary_cons, non_nullary_cons) = partition isNullaryDataCon data_cons
+    
+    read_prec = mk_easy_FunMonoBind loc readPrec_RDR [] [] 
+                                   (HsApp (HsVar parens_RDR) read_cons)
+
+    read_cons            = foldr1 mk_alt (read_nullary_cons ++ read_non_nullary_cons)
+    read_non_nullary_cons = map read_non_nullary_con non_nullary_cons
+    
+    read_nullary_cons 
+      = case nullary_cons of
+           []    -> []
+           [con] -> [mkHsDo DoExpr [bindLex (ident_pat (data_con_str con)),
+                                    result_stmt con []] loc]
+            _     -> [HsApp (HsVar choose_RDR) 
+                           (ExplicitList placeHolderType (map mk_pair nullary_cons))]
+    
+    mk_pair con = ExplicitTuple [HsLit (data_con_str con),
+                                HsApp (HsVar returnM_RDR) (HsVar (qual_orig_name con))]
+                               Boxed
+    
+    read_non_nullary_con data_con
+      = mkHsApps prec_RDR [mkHsIntLit prec, mkHsDo DoExpr stmts loc]
       where
-       read_con data_con   -- note: "b" is the string being "read"
-         = HsApp (
-             readParen_Expr read_paren_arg $ HsPar $
-                HsLam (mk_easy_Match tycon_loc [c_Pat] [] $
-                       HsDo ListComp stmts tycon_loc)
-             ) (HsVar b_RDR)
-         where
-          data_con_RDR = qual_orig_name data_con
-          data_con_str = occNameUserString (getOccName data_con)
-          con_arity    = dataConSourceArity data_con
-          con_expr     = mk_easy_App data_con_RDR as_needed
-          nullary_con  = con_arity == 0
-          labels       = dataConFieldLabels data_con
-          lab_fields   = length labels
-          dc_nm        = getName data_con
-          is_infix     = isDataSymOcc (getOccName dc_nm)
-
-          as_needed    = take con_arity as_RDRs
-          bs_needed   
-            | is_infix        = take (1 + con_arity) bs_RDRs
-            | lab_fields == 0 = take con_arity bs_RDRs
-            | otherwise       = take (4*lab_fields + 1) bs_RDRs
-                                 -- (label, '=' and field)*n, (n-1)*',' + '{' + '}'
-
-          (as1:as2:_)     = as_needed
-          (bs1:bs2:bs3:_) = bs_needed
-
-          con_qual 
-            | not is_infix =
-                 BindStmt
-                 (TuplePatIn [LitPatIn (mkHsString data_con_str), d_Pat] Boxed)
-                 (HsApp (HsVar lex_RDR) c_Expr)
-                 tycon_loc
-            | otherwise    =
-                 BindStmt
-                 (TuplePatIn [LitPatIn (mkHsString data_con_str), VarPatIn bs2] Boxed)
-                 (HsApp (HsVar lex_RDR) (HsVar bs1))
-                 tycon_loc
-               
-
-          str_qual str res draw_from =
-               BindStmt
-                 (TuplePatIn [LitPatIn (mkHsString str), VarPatIn res] Boxed)
-                 (HsApp (HsVar lex_RDR) draw_from)
-                 tycon_loc
-  
-          str_qual_paren str res draw_from =
-               BindStmt
-                 (TuplePatIn [LitPatIn (mkHsString str), VarPatIn res] Boxed)
-                 (HsApp (readParen_Expr true_Expr (HsVar lex_RDR)) draw_from)
-                 tycon_loc
-  
-          read_label f = [rd_lab, str_qual "="] 
-                           -- There might be spaces between the label and '='
-               where
-                 rd_lab
-                  | is_op      = str_qual_paren nm
-                  | otherwise  = str_qual nm
-
-                 occ_nm  = getOccName (fieldLabelName f)
-                 is_op   = isSymOcc occ_nm
-                 nm      = occNameUserString occ_nm
-
-          field_quals
-             | is_infix  =
-                 snd (mapAccumL mk_qual_infix
-                                c_Expr
-                                [ (mk_read_qual lp as1, bs1, bs2)
-                                , (mk_read_qual rp as2, bs3, bs3)
-                                ])
-             | lab_fields == 0 =  -- common case.
-                 snd (mapAccumL mk_qual 
-                                d_Expr 
-                                (zipWithEqual "as_needed" 
-                                              (\ con_field draw_from -> (mk_read_qual 10 con_field,
-                                                                         draw_from))
-                                               as_needed bs_needed))
-              | otherwise =
-                 snd $
-                 mapAccumL mk_qual d_Expr
-                       (zipEqual "bs_needed"        
-                          ((str_qual "{":
-                            concat (
-                            intersperse [str_qual ","] $
-                            zipWithEqual 
-                               "field_quals"
-                               (\ as b -> as ++ [b])
-                                   -- The labels
-                               (map read_label labels)
-                                   -- The fields
-                               (map (mk_read_qual 10) as_needed))) ++ [str_qual "}"])
-                           bs_needed)
-
-          mk_qual_infix draw_from (f, str_left, str_left2) =
-               (HsVar str_left2,       -- what to draw from down the line...
-                f str_left draw_from)
-
-          mk_qual draw_from (f, str_left) =
-               (HsVar str_left,        -- what to draw from down the line...
-                f str_left draw_from)
-
-          mk_read_qual p con_field res draw_from =
-             BindStmt
-                (TuplePatIn [VarPatIn con_field, VarPatIn res] Boxed)
-                (HsApp (HsApp (HsVar readsPrec_RDR) (HsLit (HsInt p))) draw_from)
-                tycon_loc
-
-          result_expr = ExplicitTuple [con_expr, if null bs_needed 
-                                                   then d_Expr 
-                                                   else HsVar (last bs_needed)] Boxed
-
-           [lp,rp] = getLRPrecs is_infix get_fixity dc_nm
-
-           quals
-           | is_infix  = let (h:t) = field_quals in (h:con_qual:t)
-           | otherwise = con_qual:field_quals
-
-          stmts = quals ++ [ExprStmt result_expr tycon_loc]
-               
-           {-
-             c.f. Figure 18 in Haskell 1.1 report.
-           -}
-          paren_prec_limit
-            | not is_infix  = defaultPrecedence
-            | otherwise     = getPrecedence get_fixity dc_nm
-
-          read_paren_arg   -- parens depend on precedence...
-           | nullary_con  = false_Expr -- it's optional.
-           | otherwise    = HsPar (genOpApp zz_a_Expr gt_RDR (HsLit (HsInt paren_prec_limit)))
+               stmts | is_infix          = infix_stmts
+             | length labels > 0 = lbl_stmts
+             | otherwise         = prefix_stmts
+     
+               prefix_stmts            -- T a b c
+                 = [bindLex (ident_pat (data_con_str data_con))]
+                   ++ map read_arg as_needed
+                   ++ [result_stmt data_con as_needed]
+        
+               infix_stmts             -- a %% b
+                 = [read_arg a1, 
+            bindLex (symbol_pat (data_con_str data_con)),
+            read_arg a2,
+            result_stmt data_con [a1,a2]]
+     
+               lbl_stmts               -- T { f1 = a, f2 = b }
+                 = [bindLex (ident_pat (data_con_str data_con)),
+                    read_punc "{"]
+                   ++ concat (intersperse [read_punc ","] field_stmts)
+                   ++ [read_punc "}", result_stmt data_con as_needed]
+     
+               field_stmts  = zipWithEqual "lbl_stmts" read_field labels as_needed
+     
+               con_arity    = dataConSourceArity data_con
+               nullary_con  = con_arity == 0
+               labels       = dataConFieldLabels data_con
+               lab_fields   = length labels
+               dc_nm        = getName data_con
+               is_infix     = isDataSymOcc (getOccName dc_nm)
+               as_needed    = take con_arity as_RDRs
+               (a1:a2:_)    = as_needed
+               prec         = getPrec is_infix get_fixity dc_nm
+
+    ------------------------------------------------------------------------
+    --         Helpers
+    ------------------------------------------------------------------------
+    mk_alt e1 e2     = genOpApp e1 alt_RDR e2
+    bindLex pat             = BindStmt pat (HsVar lexP_RDR) loc
+    result_stmt c as = ResultStmt (HsApp (HsVar returnM_RDR) (con_app c as)) loc
+    con_app c as     = mkHsVarApps (qual_orig_name c) as
+    
+    punc_pat s   = ConPatIn punc_RDR [LitPatIn (mkHsString s)]   -- Punc 'c'
+    ident_pat s  = ConPatIn ident_RDR [LitPatIn s]               -- Ident "foo"
+    symbol_pat s = ConPatIn symbol_RDR [LitPatIn s]              -- Symbol ">>"
+    
+    data_con_str con = mkHsString (occNameUserString (getOccName con))
+    
+    read_punc c = bindLex (punc_pat c)
+    read_arg a  = BindStmt (VarPatIn a) (mkHsVarApps step_RDR [readPrec_RDR]) loc
+    
+    read_field lbl a = read_lbl lbl ++
+                      [read_punc "=",
+                       BindStmt (VarPatIn a) (mkHsVarApps reset_RDR [readPrec_RDR]) loc]
+
+       -- When reading field labels we might encounter
+       --      a = 3
+       -- or   (#) = 4
+       -- Note the parens!
+    read_lbl lbl | isAlpha (head lbl_str) 
+                = [bindLex (ident_pat lbl_lit)]
+                | otherwise
+                = [read_punc "(", 
+                   bindLex (symbol_pat lbl_lit),
+                   read_punc ")"]
+                where  
+                  lbl_str = occNameUserString (getOccName (fieldLabelName lbl)) 
+                  lbl_lit = mkHsString lbl_str
 \end{code}
 
+
 %************************************************************************
 %*                                                                     *
 \subsubsection{Generating @Show@ instance declarations}
@@ -928,7 +891,7 @@ gen_Read_binds get_fixity tycon
 %************************************************************************
 
 \begin{code}
-gen_Show_binds :: (Name -> Maybe Fixity) -> TyCon -> RdrNameMonoBinds
+gen_Show_binds :: FixityEnv -> TyCon -> RdrNameMonoBinds
 
 gen_Show_binds get_fixity tycon
   = shows_prec `AndMonoBinds` show_list
@@ -936,143 +899,91 @@ gen_Show_binds get_fixity tycon
     tycon_loc = getSrcLoc tycon
     -----------------------------------------------------------------------
     show_list = mk_easy_FunMonoBind tycon_loc showList_RDR [] []
-                 (HsApp (HsVar showList___RDR) (HsPar (HsApp (HsVar showsPrec_RDR) (HsLit (HsInt 0)))))
+                 (HsApp (HsVar showList___RDR) (HsPar (HsApp (HsVar showsPrec_RDR) (mkHsIntLit 0))))
     -----------------------------------------------------------------------
     shows_prec = mk_FunMonoBind tycon_loc showsPrec_RDR (map pats_etc (tyConDataCons tycon))
       where
        pats_etc data_con
          | nullary_con =  -- skip the showParen junk...
             ASSERT(null bs_needed)
-            ([wildPat, con_pat], show_con)
+            ([wildPat, con_pat], mk_showString_app con_str)
          | otherwise   =
             ([a_Pat, con_pat],
-                 showParen_Expr (HsPar (genOpApp a_Expr ge_RDR (HsLit (HsInt paren_prec_limit))))
+                 showParen_Expr (HsPar (genOpApp a_Expr ge_RDR (HsLit (HsInt con_prec))))
                                 (HsPar (nested_compose_Expr show_thingies)))
            where
-            data_con_RDR = qual_orig_name data_con
-            con_arity    = dataConSourceArity data_con
-            bs_needed    = take con_arity bs_RDRs
-            con_pat      = ConPatIn data_con_RDR (map VarPatIn bs_needed)
-            nullary_con  = con_arity == 0
-             labels       = dataConFieldLabels data_con
-            lab_fields   = length labels
+            data_con_RDR  = qual_orig_name data_con
+            con_arity     = dataConSourceArity data_con
+            bs_needed     = take con_arity bs_RDRs
+            con_pat       = ConPatIn data_con_RDR (map VarPatIn bs_needed)
+            nullary_con   = con_arity == 0
+             labels        = dataConFieldLabels data_con
+            lab_fields    = length labels
+            record_syntax = lab_fields > 0
 
             dc_nm          = getName data_con
             dc_occ_nm      = getOccName data_con
-             dc_occ_nm_str  = occNameUserString dc_occ_nm
-
-            is_infix     = isDataSymOcc dc_occ_nm
-
+             con_str        = occNameUserString dc_occ_nm
 
-            show_con
-              | is_infix  = mk_showString_app (' ':dc_occ_nm_str)
-              | otherwise = mk_showString_app (dc_occ_nm_str ++ space_ocurly_maybe)
-                where
-                 space_ocurly_maybe
-                    | nullary_con     = ""
-                   | lab_fields == 0 = " "
-                   | otherwise       = "{"
-                
-
-            show_all con fs@(x:xs)
-               | is_infix  = x:con:xs
-               | otherwise = 
-                 let
-                    ccurly_maybe 
-                      | lab_fields > 0  = [mk_showString_app "}"]
-                      | otherwise       = []
-                 in
-                 con:fs ++ ccurly_maybe
-
-            show_thingies = show_all show_con real_show_thingies_with_labs
+            show_thingies 
+               | is_infix      = [show_arg1, mk_showString_app (" " ++ con_str ++ " "), show_arg2]
+               | record_syntax = mk_showString_app (con_str ++ " {") : 
+                                 show_record_args ++ [mk_showString_app "}"]
+               | otherwise     = mk_showString_app (con_str ++ " ") : show_prefix_args
                 
             show_label l = mk_showString_app (the_name ++ "=")
                 where
                   occ_nm   = getOccName (fieldLabelName l)
-                   -- legal, but rare.
-                  is_op    = isSymOcc occ_nm
+                  nm       = occNameUserString occ_nm
+
+                  is_op    = isSymOcc occ_nm       -- Legal, but rare.
                   the_name 
                     | is_op     = '(':nm ++ ")"
                     | otherwise = nm
 
-                  nm       = occNameUserString occ_nm
-               
-
-             mk_showString_app str = HsApp (HsVar showString_RDR)
-                                          (HsLit (mkHsString str))
-
-             prec_cons = getLRPrecs is_infix get_fixity dc_nm
-
-             real_show_thingies
-               | is_infix  = 
-                    [ HsApp (HsApp (HsVar showsPrec_RDR) (HsLit (HsInt p))) (HsVar b)
-                    | (p,b) <- zip prec_cons bs_needed ]
-               | otherwise =
-                    [ HsApp (HsApp (HsVar showsPrec_RDR) (HsLit (HsInt 10))) (HsVar b)
-                    | b <- bs_needed ]
-
-             real_show_thingies_with_labs
-               | lab_fields == 0 = intersperse (HsVar showSpace_RDR) real_show_thingies
-               | otherwise       = --Assumption: no of fields == no of labelled fields 
-                                    --            (and in same order)
-                   concat $
-                   intersperse ([mk_showString_app ","]) $ -- Using SLIT()s containing ,s spells trouble.
-                   zipWithEqual "gen_Show_binds"
-                                (\ a b -> [a,b])
-                                (map show_label labels) 
-                                real_show_thingies
+             show_args = [ mkHsApps showsPrec_RDR [HsLit (HsInt arg_prec), HsVar b]
+                        | b <- bs_needed ]
+            (show_arg1:show_arg2:_) = show_args
+            show_prefix_args = intersperse (HsVar showSpace_RDR) show_args
+
+
+               --  Assumption for record syntax: no of fields == no of labelled fields 
+               --            (and in same order)
+            show_record_args = concat $
+                               intersperse [mk_showString_app ", "] $
+                               [ [show_label lbl, arg] 
+                               | (lbl,arg) <- zipEqual "gen_Show_binds" 
+                                                       labels show_args ]
                               
-             {-
-               c.f. Figure 16 and 17 in Haskell 1.1 report
-             -}  
-            paren_prec_limit
-               | not is_infix = defaultPrecedence + 1
-               | otherwise    = getPrecedence get_fixity dc_nm + 1
+               -- Fixity stuff
+            is_infix = isDataSymOcc dc_occ_nm
+             con_prec = 1 + getPrec is_infix get_fixity dc_nm
+            arg_prec | record_syntax = 0       -- Record fields don't need parens
+                     | otherwise     = con_prec        
 
+mk_showString_app str = HsApp (HsVar showString_RDR) (HsLit (mkHsString str))
 \end{code}
 
 \begin{code}
-getLRPrecs :: Bool -> (Name -> Maybe Fixity) -> Name -> [Integer]
-getLRPrecs is_infix get_fixity 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 get_fixity nm
-     paren_con_prec = getPrecedence get_fixity nm
-
-     lp
-      | not is_infix   = defaultPrecedence + 1
-      | con_left_assoc = paren_con_prec
-      | otherwise      = paren_con_prec + 1
-                 
-     rp
-      | not is_infix    = defaultPrecedence + 1
-      | con_right_assoc = paren_con_prec
-      | otherwise       = paren_con_prec + 1
+getPrec :: Bool -> FixityEnv -> Name -> Integer
+getPrec is_infix get_fixity nm 
+  | not is_infix   = appPrecedence
+  | otherwise      = getPrecedence get_fixity nm
                  
-defaultPrecedence :: Integer
-defaultPrecedence = fromInt maxPrecedence
+appPrecedence :: Integer
+appPrecedence = fromIntegral maxPrecedence
 
-getPrecedence :: (Name -> Maybe Fixity) -> Name -> Integer
+getPrecedence :: FixityEnv -> Name -> Integer
 getPrecedence get_fixity nm 
-   = case get_fixity nm of
-        Just (Fixity x _) -> fromInt x
-        other            -> defaultPrecedence
+   = case lookupFixity get_fixity nm of
+        Fixity x _ -> fromIntegral x
 
-isLRAssoc :: (Name -> Maybe Fixity) -> Name -> (Bool, Bool)
+isLRAssoc :: FixityEnv -> Name -> (Bool, Bool)
 isLRAssoc get_fixity nm =
-     case get_fixity nm `orElse` defaultFixity of
+     case lookupFixity get_fixity nm of
        Fixity _ InfixN -> (False, False)
        Fixity _ InfixR -> (False, True)
        Fixity _ InfixL -> (True,  False)
-
-isInfixOccName :: String -> Bool
-isInfixOccName str = 
-   case str of
-     (':':_) -> True
-     _       -> False
 \end{code}
 
 
@@ -1181,24 +1092,25 @@ mk_FunMonoBind loc fun pats_and_exprs
                loc
 
 mk_match loc pats expr binds
-  = Match [] (map paren pats) Nothing 
-         (GRHSs (unguardedRHS expr loc) binds Nothing)
+  = Match (map paren pats) Nothing 
+         (GRHSs (unguardedRHS expr loc) binds placeHolderType)
   where
     paren p@(VarPatIn _) = p
     paren other_p       = ParPatIn other_p
 \end{code}
 
 \begin{code}
-mk_easy_App f xs = foldl HsApp (HsVar f) (map HsVar xs)
+mkHsApps    f xs = foldl HsApp (HsVar f) xs
+mkHsVarApps f xs = foldl HsApp (HsVar f) (map HsVar xs)
+
+mkHsIntLit n = HsLit (HsInt n)
+mkHsString s = HsString (mkFastString s)
+mkHsChar c   = HsChar   (ord c)
 \end{code}
 
 ToDo: Better SrcLocs.
 
 \begin{code}
-compare_Case ::
-         RdrNameHsExpr -> RdrNameHsExpr -> RdrNameHsExpr
-         -> RdrNameHsExpr -> RdrNameHsExpr
-         -> RdrNameHsExpr
 compare_gen_Case ::
          RdrName
          -> RdrNameHsExpr -> RdrNameHsExpr -> RdrNameHsExpr
@@ -1210,22 +1122,21 @@ careful_compare_Case :: -- checks for primitive types...
          -> RdrNameHsExpr -> RdrNameHsExpr
          -> RdrNameHsExpr
 
-compare_Case = compare_gen_Case compare_RDR
 cmp_eq_Expr a b = HsApp (HsApp (HsVar cmp_eq_RDR) a) b
        -- Was: compare_gen_Case cmp_eq_RDR
 
 compare_gen_Case fun lt eq gt a b
   = HsCase (HsPar (HsApp (HsApp (HsVar fun) a) b)) {-of-}
-      [mkSimpleMatch [ConPatIn ltTag_RDR []] lt Nothing generatedSrcLoc,
-       mkSimpleMatch [ConPatIn eqTag_RDR []] eq Nothing generatedSrcLoc,
-       mkSimpleMatch [ConPatIn gtTag_RDR []] gt Nothing generatedSrcLoc]
+      [mkSimpleMatch [ConPatIn ltTag_RDR []] lt placeHolderType generatedSrcLoc,
+       mkSimpleMatch [ConPatIn eqTag_RDR []] eq placeHolderType generatedSrcLoc,
+       mkSimpleMatch [ConPatIn gtTag_RDR []] gt placeHolderType generatedSrcLoc]
       generatedSrcLoc
 
 careful_compare_Case ty lt eq gt a b
-  = if not (isUnLiftedType ty) then
+  | not (isUnLiftedType ty) =
        compare_gen_Case compare_RDR lt eq gt a b
-
-    else -- we have to do something special for primitive things...
+  | otherwise               =
+         -- we have to do something special for primitive things...
        HsIf (genOpApp a relevant_eq_op b)
            eq
            (HsIf (genOpApp a relevant_lt_op b) lt gt generatedSrcLoc)
@@ -1238,7 +1149,7 @@ assoc_ty_id tyids ty
   = if null res then panic "assoc_ty"
     else head res
   where
-    res = [id | (ty',id) <- tyids, ty == ty']
+    res = [id | (ty',id) <- tyids, ty `tcEqType` ty']
 
 eq_op_tbl =
     [(charPrimTy,      eqH_Char_RDR)
@@ -1268,13 +1179,14 @@ append_Expr a b = genOpApp a append_RDR b
 -----------------------------------------------------------------------
 
 eq_Expr :: Type -> RdrNameHsExpr -> RdrNameHsExpr -> RdrNameHsExpr
-eq_Expr ty a b
-  = if not (isUnLiftedType ty) then
-       genOpApp a eq_RDR  b
-    else -- we have to do something special for primitive things...
-       genOpApp a relevant_eq_op b
-  where
-    relevant_eq_op = assoc_ty_id eq_op_tbl ty
+eq_Expr ty a b = genOpApp a eq_op b
+ where
+   eq_op
+    | not (isUnLiftedType ty) = eq_RDR
+    | otherwise               =
+         -- we have to do something special for primitive things...
+       assoc_ty_id eq_op_tbl ty
+
 \end{code}
 
 \begin{code}
@@ -1282,7 +1194,7 @@ untag_Expr :: TyCon -> [(RdrName, RdrName)] -> RdrNameHsExpr -> RdrNameHsExpr
 untag_Expr tycon [] expr = expr
 untag_Expr tycon ((untag_this, put_tag_here) : more) expr
   = HsCase (HsPar (HsApp (con2tag_Expr tycon) (HsVar untag_this))) {-of-}
-      [mkSimpleMatch [VarPatIn put_tag_here] (untag_Expr tycon more expr) Nothing generatedSrcLoc]
+      [mkSimpleMatch [VarPatIn put_tag_here] (untag_Expr tycon more expr) placeHolderType generatedSrcLoc]
       generatedSrcLoc
 
 cmp_tags_Expr :: RdrName               -- Comparison op
@@ -1304,12 +1216,11 @@ enum_from_then_to_Expr
 enum_from_to_Expr      f   t2 = HsApp (HsApp (HsVar enumFromTo_RDR) f) t2
 enum_from_then_to_Expr f t t2 = HsApp (HsApp (HsApp (HsVar enumFromThenTo_RDR) f) t) t2
 
-showParen_Expr, readParen_Expr
+showParen_Expr
        :: RdrNameHsExpr -> RdrNameHsExpr
        -> RdrNameHsExpr
 
 showParen_Expr e1 e2 = HsApp (HsApp (HsVar showParen_RDR) e1) e2
-readParen_Expr e1 e2 = HsApp (HsApp (HsVar readParen_RDR) e1) e2
 
 nested_compose_Expr :: [RdrNameHsExpr] -> RdrNameHsExpr
 
@@ -1319,31 +1230,31 @@ nested_compose_Expr (e:es)
 
 -- impossible_Expr is used in case RHSs that should never happen.
 -- We generate these to keep the desugarer from complaining that they *might* happen!
-impossible_Expr = HsApp (HsVar error_RDR) (HsLit (HsString (_PK_ "Urk! in TcGenDeriv")))
+impossible_Expr = HsApp (HsVar error_RDR) (HsLit (HsString (mkFastString "Urk! in TcGenDeriv")))
 
 -- illegal_Expr is used when signalling error conditions in the RHS of a derived
 -- method. It is currently only used by Enum.{succ,pred}
 illegal_Expr meth tp msg = 
-   HsApp (HsVar error_RDR) (HsLit (HsString (_PK_ (meth ++ '{':tp ++ "}: " ++ msg))))
+   HsApp (HsVar error_RDR) (HsLit (HsString (mkFastString (meth ++ '{':tp ++ "}: " ++ msg))))
 
 -- illegal_toEnum_tag is an extended version of illegal_Expr, which also allows you
 -- to include the value of a_RDR in the error string.
 illegal_toEnum_tag tp maxtag =
    HsApp (HsVar error_RDR) 
          (HsApp (HsApp (HsVar append_RDR)
-                      (HsLit (HsString (_PK_ ("toEnum{" ++ tp ++ "}: tag (")))))
+                      (HsLit (HsString (mkFastString ("toEnum{" ++ tp ++ "}: tag (")))))
                       (HsApp (HsApp (HsApp 
                           (HsVar showsPrec_RDR)
-                          (HsLit (HsInt 0)))
+                          (mkHsIntLit 0))
                           (HsVar a_RDR))
                           (HsApp (HsApp 
                               (HsVar append_RDR)
-                              (HsLit (HsString (_PK_ ") is outside of enumeration's range (0,"))))
+                              (HsLit (HsString (mkFastString ") is outside of enumeration's range (0,"))))
                               (HsApp (HsApp (HsApp 
                                        (HsVar showsPrec_RDR)
-                                       (HsLit (HsInt 0)))
+                                       (mkHsIntLit 0))
                                        (HsVar maxtag))
-                                       (HsLit (HsString (_PK_ ")")))))))
+                                       (HsLit (HsString (mkFastString ")")))))))
 
 parenify e@(HsVar _) = e
 parenify e          = HsPar e
@@ -1360,23 +1271,21 @@ genOpApp e1 op e2 = mkHsOpApp e1 op e2
 qual_orig_name n = nameRdrName (getName n)
 varUnqual n      = mkUnqual varName n
 
-zz_a_RDR       = varUnqual SLIT("_a")
-a_RDR          = varUnqual SLIT("a")
-b_RDR          = varUnqual SLIT("b")
-c_RDR          = varUnqual SLIT("c")
-d_RDR          = varUnqual SLIT("d")
-ah_RDR         = varUnqual SLIT("a#")
-bh_RDR         = varUnqual SLIT("b#")
-ch_RDR         = varUnqual SLIT("c#")
-dh_RDR         = varUnqual SLIT("d#")
-cmp_eq_RDR     = varUnqual SLIT("cmp_eq")
-rangeSize_RDR  = varUnqual SLIT("rangeSize")
-
-as_RDRs                = [ varUnqual (_PK_ ("a"++show i)) | i <- [(1::Int) .. ] ]
-bs_RDRs                = [ varUnqual (_PK_ ("b"++show i)) | i <- [(1::Int) .. ] ]
-cs_RDRs                = [ varUnqual (_PK_ ("c"++show i)) | i <- [(1::Int) .. ] ]
-
-mkHsString s = HsString (_PK_ s)
+zz_a_RDR       = varUnqual FSLIT("_a")
+a_RDR          = varUnqual FSLIT("a")
+b_RDR          = varUnqual FSLIT("b")
+c_RDR          = varUnqual FSLIT("c")
+d_RDR          = varUnqual FSLIT("d")
+ah_RDR         = varUnqual FSLIT("a#")
+bh_RDR         = varUnqual FSLIT("b#")
+ch_RDR         = varUnqual FSLIT("c#")
+dh_RDR         = varUnqual FSLIT("d#")
+cmp_eq_RDR     = varUnqual FSLIT("cmp_eq")
+rangeSize_RDR  = varUnqual FSLIT("rangeSize")
+
+as_RDRs                = [ varUnqual (mkFastString ("a"++show i)) | i <- [(1::Int) .. ] ]
+bs_RDRs                = [ varUnqual (mkFastString ("b"++show i)) | i <- [(1::Int) .. ] ]
+cs_RDRs                = [ varUnqual (mkFastString ("c"++show i)) | i <- [(1::Int) .. ] ]
 
 zz_a_Expr      = HsVar zz_a_RDR
 a_Expr         = HsVar a_RDR
@@ -1402,7 +1311,7 @@ d_Pat             = VarPatIn d_RDR
 
 con2tag_RDR, tag2con_RDR, maxtag_RDR :: TyCon -> RdrName
 
-con2tag_RDR tycon = varUnqual (_PK_ ("con2tag_" ++ occNameString (getOccName tycon) ++ "#"))
-tag2con_RDR tycon = varUnqual (_PK_ ("tag2con_" ++ occNameString (getOccName tycon) ++ "#"))
-maxtag_RDR tycon  = varUnqual (_PK_ ("maxtag_"  ++ occNameString (getOccName tycon) ++ "#"))
+con2tag_RDR tycon = varUnqual (mkFastString ("con2tag_" ++ occNameString (getOccName tycon) ++ "#"))
+tag2con_RDR tycon = varUnqual (mkFastString ("tag2con_" ++ occNameString (getOccName tycon) ++ "#"))
+maxtag_RDR tycon  = varUnqual (mkFastString ("maxtag_"  ++ occNameString (getOccName tycon) ++ "#"))
 \end{code}