import Demand ( StrictnessInfo )
import Literal ( Literal, maybeLitLit )
import PrimOp ( CCall, pprCCallOp )
-import DataCon ( dataConTyCon )
+import DataCon ( dataConTyCon, dataConSourceArity )
import TyCon ( isTupleTyCon, tupleTyConBoxity )
import Type ( Kind )
import FiniteMap ( lookupFM )
toUfAlt (c,bs,r) = (toUfCon c, map getName bs, toUfExpr r)
---------------------
-toUfCon (DataAlt dc) | isTupleTyCon tc = UfTupleAlt (HsTupCon (getName dc) (tupleTyConBoxity tc))
+toUfCon (DataAlt dc) | isTupleTyCon tc = UfTupleAlt (mk_hs_tup_con tc dc)
| otherwise = UfDataAlt (getName dc)
where
tc = dataConTyCon dc
toUfCon DEFAULT = UfDefault
---------------------
+mk_hs_tup_con tc dc = HsTupCon (getName dc) (tupleTyConBoxity tc) (dataConSourceArity dc)
+
+---------------------
toUfBndr x | isId x = UfValBinder (getName x) (toHsType (varType x))
| otherwise = UfTyBinder (getName x) (varType x)
= case isDataConId_maybe v of
-- We convert the *worker* for tuples into UfTuples
Just dc | isTupleTyCon tc && saturated
- -> UfTuple (HsTupCon (getName dc) (tupleTyConBoxity tc)) tup_args
+ -> UfTuple (mk_hs_tup_con tc dc) tup_args
where
val_args = dropWhile isTypeArg as
saturated = length val_args == idArity v