The Big INLINE Patch: totally reorganise way that INLINE pragmas work

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

diff --git a/compiler/typecheck/TcGenDeriv.lhs b/compiler/typecheck/TcGenDeriv.lhs
index 7cee738..8bbc27a 100644 (file)
--- a/compiler/typecheck/TcGenDeriv.lhs
+++ b/compiler/typecheck/TcGenDeriv.lhs
@@ -42,7 +42,6 @@ import Name
 import HscTypes
 import PrelInfo
 import PrelNames
-import MkId
 import PrimOp
 import SrcLoc
 import TyCon
@@ -58,9 +57,7 @@ import Util
 import MonadUtils
 import Outputable
 import FastString
-import OccName
 import Bag
-
 import Data.List       ( partition, intersperse )
 \end{code}
 
@@ -569,8 +566,8 @@ gen_Bounded_binds loc tycon
     data_cons = tyConDataCons tycon
 
     ----- enum-flavored: ---------------------------
-    min_bound_enum = mkVarBind loc minBound_RDR (nlHsVar data_con_1_RDR)
-    max_bound_enum = mkVarBind loc maxBound_RDR (nlHsVar data_con_N_RDR)
+    min_bound_enum = mkHsVarBind loc minBound_RDR (nlHsVar data_con_1_RDR)
+    max_bound_enum = mkHsVarBind loc maxBound_RDR (nlHsVar data_con_N_RDR)
 
     data_con_1   = head data_cons
     data_con_N   = last data_cons
@@ -580,9 +577,9 @@ gen_Bounded_binds loc tycon
     ----- single-constructor-flavored: -------------
     arity         = dataConSourceArity data_con_1
 
-    min_bound_1con = mkVarBind loc minBound_RDR $
+    min_bound_1con = mkHsVarBind loc minBound_RDR $
                     nlHsVarApps data_con_1_RDR (nOfThem arity minBound_RDR)
-    max_bound_1con = mkVarBind loc maxBound_RDR $
+    max_bound_1con = mkHsVarBind loc maxBound_RDR $
                     nlHsVarApps data_con_1_RDR (nOfThem arity maxBound_RDR)
 \end{code}
 
@@ -721,7 +718,7 @@ gen_Ix_binds loc tycon
 
        mk_qual a b c = noLoc $ mkBindStmt (nlVarPat c)
                                 (nlHsApp (nlHsVar range_RDR) 
-                                       (nlTuple [nlHsVar a, nlHsVar b] Boxed))
+                                         (mkLHsVarTuple [a,b]))
 
     ----------------
     single_con_index
@@ -743,11 +740,11 @@ gen_Ix_binds loc tycon
            ) plus_RDR (
                genOpApp (
                    (nlHsApp (nlHsVar unsafeRangeSize_RDR) 
-                          (nlTuple [nlHsVar l, nlHsVar u] Boxed))
+                            (mkLHsVarTuple [l,u]))
                ) times_RDR (mk_index rest)
           )
        mk_one l u i
-         = nlHsApps unsafeIndex_RDR [nlTuple [nlHsVar l, nlHsVar u] Boxed, nlHsVar i]
+         = nlHsApps unsafeIndex_RDR [mkLHsVarTuple [l,u], nlHsVar i]
 
     ------------------
     single_con_inRange
@@ -756,8 +753,7 @@ gen_Ix_binds loc tycon
                 con_pat cs_needed] $
          foldl1 and_Expr (zipWith3Equal "single_con_inRange" in_range as_needed bs_needed cs_needed)
       where
-       in_range a b c = nlHsApps inRange_RDR [nlTuple [nlHsVar a, nlHsVar b] Boxed,
-                                              nlHsVar c]
+       in_range a b c = nlHsApps inRange_RDR [mkLHsVarTuple [a,b], nlHsVar c]
 \end{code}
 
 %************************************************************************
@@ -812,16 +808,16 @@ gen_Read_binds get_fixity loc tycon
   where
     -----------------------------------------------------------------------
     default_readlist 
-       = mkVarBind loc readList_RDR     (nlHsVar readListDefault_RDR)
+       = mkHsVarBind loc readList_RDR     (nlHsVar readListDefault_RDR)
 
     default_readlistprec
-       = mkVarBind loc readListPrec_RDR (nlHsVar readListPrecDefault_RDR)
+       = mkHsVarBind loc readListPrec_RDR (nlHsVar readListPrecDefault_RDR)
     -----------------------------------------------------------------------
 
     data_cons = tyConDataCons tycon
     (nullary_cons, non_nullary_cons) = partition isNullarySrcDataCon data_cons
     
-    read_prec = mkVarBind loc readPrec_RDR
+    read_prec = mkHsVarBind loc readPrec_RDR
                              (nlHsApp (nlHsVar parens_RDR) read_cons)
 
     read_cons            = foldr1 mk_alt (read_nullary_cons ++ read_non_nullary_cons)
@@ -835,9 +831,8 @@ gen_Read_binds get_fixity loc tycon
             _     -> [nlHsApp (nlHsVar choose_RDR) 
                              (nlList (map mk_pair nullary_cons))]
     
-    mk_pair con = nlTuple [nlHsLit (mkHsString (data_con_str con)), 
-                          result_expr con []]
-                         Boxed
+    mk_pair con = mkLHsTupleExpr [nlHsLit (mkHsString (data_con_str con)), 
+                                 result_expr con []]
     
     read_non_nullary_con data_con
       | is_infix  = mk_parser infix_prec  infix_stmts  body
@@ -966,7 +961,7 @@ gen_Show_binds get_fixity loc tycon
   = (listToBag [shows_prec, show_list], [])
   where
     -----------------------------------------------------------------------
-    show_list = mkVarBind loc showList_RDR
+    show_list = mkHsVarBind loc showList_RDR
                  (nlHsApp (nlHsVar showList___RDR) (nlHsPar (nlHsApp (nlHsVar showsPrec_RDR) (nlHsIntLit 0))))
     -----------------------------------------------------------------------
     shows_prec = mk_FunBind loc showsPrec_RDR (map pats_etc (tyConDataCons tycon))
@@ -1478,7 +1473,7 @@ gen_Foldable_binds loc tycon
   where
     data_cons = tyConDataCons tycon
 
-    foldr_bind = L loc $ mkFunBind (L loc foldr_RDR) (map foldr_eqn data_cons)
+    foldr_bind = L loc $ mkFunBind (L loc foldable_foldr_RDR) (map foldr_eqn data_cons)
     foldr_eqn con = evalState (match_for_con z_Expr [f_Pat,z_Pat] con parts) bs_RDRs
       where 
         parts = foldDataConArgs ft_foldr con
@@ -1621,7 +1616,7 @@ genAuxBind loc (GenTag2Con tycon)
     rdr_name = tag2con_RDR tycon
 
 genAuxBind loc (GenMaxTag tycon)
-  = mkVarBind loc rdr_name 
+  = mkHsVarBind loc rdr_name 
                  (nlHsApp (nlHsVar intDataCon_RDR) (nlHsLit (HsIntPrim max_tag)))
   where
     rdr_name = maxtag_RDR tycon
@@ -1629,16 +1624,16 @@ genAuxBind loc (GenMaxTag tycon)
                 data_cons -> toInteger ((length data_cons) - fIRST_TAG)
 
 genAuxBind loc (MkTyCon tycon) --  $dT
-  = mkVarBind loc (mk_data_type_name tycon)
-                 ( nlHsVar mkDataType_RDR 
+  = mkHsVarBind loc (mk_data_type_name tycon)
+                   ( nlHsVar mkDataType_RDR 
                     `nlHsApp` nlHsLit (mkHsString (showSDocOneLine (ppr tycon)))
                     `nlHsApp` nlList constrs )
   where
     constrs = [nlHsVar (mk_constr_name con) | con <- tyConDataCons tycon]
 
 genAuxBind loc (MkDataCon dc)  --  $cT1 etc
-  = mkVarBind loc (mk_constr_name dc) 
-                 (nlHsApps mkConstr_RDR constr_args)
+  = mkHsVarBind loc (mk_constr_name dc) 
+                   (nlHsApps mkConstr_RDR constr_args)
   where
     constr_args 
        = [ -- nlHsIntLit (toInteger (dataConTag dc)),    -- Tag