- -- wrapper constructor isn't inlined
- -- But we are sloppy about the argument demands, because we expect
- -- to inline the constructor very vigorously.
-
- wrap_rhs | isNewTyCon tycon
- = ASSERT( null ex_tyvars && null ex_dict_args && length orig_arg_tys == 1 )
- -- No existentials on a newtype, but it can have a context
- -- e.g. newtype Eq a => T a = MkT (...)
- mkLams tyvars $ mkLams dict_args $ Lam id_arg1 $
- mkNewTypeBody tycon result_ty id_arg1
-
- | null dict_args && not (any isMarkedStrict strict_marks)
- = Var work_id -- The common case. Not only is this efficient,
- -- but it also ensures that the wrapper is replaced
- -- by the worker even when there are no args.
- -- f (:) x
- -- becomes
- -- f $w: x
- -- This is really important in rule matching,
- -- (We could match on the wrappers,
- -- but that makes it less likely that rules will match
- -- when we bring bits of unfoldings together.)
- --
- -- NB: because of this special case, (map (:) ys) turns into
- -- (map $w: ys), and thence into (map (\x xs. $w: x xs) ys)
- -- in core-to-stg. The top-level defn for (:) is never used.
- -- This is somewhat of a bore, but I'm currently leaving it
- -- as is, so that there still is a top level curried (:) for
- -- the interpreter to call.
-
- | otherwise
- = mkLams all_tyvars $ mkLams dict_args $
- mkLams ex_dict_args $ mkLams id_args $
- foldr mk_case con_app
- (zip (ex_dict_args++id_args) strict_marks) i3 []
-
- con_app i rep_ids = mkApps (Var work_id)
- (map varToCoreExpr (all_tyvars ++ reverse rep_ids))
-
- (tyvars, theta, ex_tyvars, ex_theta, orig_arg_tys, tycon) = dataConSig data_con
- all_tyvars = tyvars ++ ex_tyvars
-
- dict_tys = mkPredTys theta
- ex_dict_tys = mkPredTys ex_theta
- all_arg_tys = dict_tys ++ ex_dict_tys ++ orig_arg_tys
- result_ty = mkTyConApp tycon (mkTyVarTys tyvars)
-
- mkLocals i tys = (zipWith mkTemplateLocal [i..i+n-1] tys, i+n)
- where
- n = length tys
-
- (dict_args, i1) = mkLocals 1 dict_tys
- (ex_dict_args,i2) = mkLocals i1 ex_dict_tys
- (id_args,i3) = mkLocals i2 orig_arg_tys
- arity = i3-1
- (id_arg1:_) = id_args -- Used for newtype only
-
- strict_marks = dataConStrictMarks data_con
+ -- wrapper constructor isn't inlined.
+ -- And the argument strictness can be important too; we
+ -- may not inline a contructor when it is partially applied.
+ -- For example:
+ -- data W = C !Int !Int !Int
+ -- ...(let w = C x in ...(w p q)...)...
+ -- we want to see that w is strict in its two arguments
+
+ alg_unf = mkTopUnfolding $ Note InlineMe $
+ mkLams tyvars $
+ mkLams dict_args $ mkLams id_args $
+ foldr mk_case con_app
+ (zip (dict_args ++ id_args) all_strict_marks)
+ i3 []
+
+ con_app i rep_ids = mkApps (Var wrk_id)
+ (map varToCoreExpr (tyvars ++ reverse rep_ids))
+
+ (dict_args,i2) = mkLocals 1 dict_tys
+ (id_args,i3) = mkLocals i2 orig_arg_tys
+ alg_arity = i3-1