import HscTypes
import PrelInfo
import PrelNames
-import MkId
import PrimOp
import SrcLoc
import TyCon
import MonadUtils
import Outputable
import FastString
-import OccName
import Bag
-
import Data.List ( partition, intersperse )
\end{code}
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
----- 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}
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
) 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
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}
%************************************************************************
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)
_ -> [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
= (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))
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
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
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