+
+%************************************************************************
+%* *
+\subsection{Argument analysis}
+%* *
+%************************************************************************
+
+This code deals with analysing call-site arguments to see whether
+they are constructor applications.
+
+\begin{code}
+ -- argToPat takes an actual argument, and returns an abstracted
+ -- version, consisting of just the "constructor skeleton" of the
+ -- argument, with non-constructor sub-expression replaced by new
+ -- placeholder variables. For example:
+ -- C a (D (f x) (g y)) ==> C p1 (D p2 p3)
+
+argToPat :: ConstrEnv -> UniqSupply -> CoreArg -> (UniqSupply, CoreExpr)
+argToPat env us (Type ty)
+ = (us, Type ty)
+
+argToPat env us arg
+ | Just (dc,args) <- is_con_app_maybe env arg
+ = let
+ (us',args') = argsToPats env us args
+ in
+ (us', mk_con_app dc args')
+
+argToPat env us (Var v) -- Don't uniqify existing vars,
+ = (us, Var v) -- so that we can spot when we pass them twice
+
+argToPat env us arg
+ = (us1, Var (mkSysLocal SLIT("sc") (uniqFromSupply us2) (exprType arg)))
+ where
+ (us1,us2) = splitUniqSupply us
+
+argsToPats :: ConstrEnv -> UniqSupply -> [CoreArg] -> (UniqSupply, [CoreExpr])
+argsToPats env us args = mapAccumL (argToPat env) us args
+\end{code}
+
+
+\begin{code}
+is_con_app_maybe :: ConstrEnv -> CoreExpr -> Maybe (AltCon, [CoreExpr])
+is_con_app_maybe env (Var v)
+ = lookupVarEnv env v
+ -- You might think we could look in the idUnfolding here
+ -- but that doesn't take account of which branch of a
+ -- case we are in, which is the whole point
+
+is_con_app_maybe env (Lit lit)
+ = Just (LitAlt lit, [])
+
+is_con_app_maybe env expr
+ = case collectArgs expr of
+ (Var fun, args) | Just con <- isDataConId_maybe fun,
+ length args >= dataConRepArity con
+ -- Might be > because the arity excludes type args
+ -> Just (DataAlt con,args)
+
+ other -> Nothing
+
+mk_con_app :: AltCon -> [CoreArg] -> CoreExpr
+mk_con_app (LitAlt lit) [] = Lit lit
+mk_con_app (DataAlt con) args = mkConApp con args
+\end{code}