+%************************************************************************
+%* *
+\subsection{Adding inline pragmas}
+%* *
+%************************************************************************
+
+\begin{code}
+decomposeRuleLhs :: [Var] -> CoreExpr -> Either SDoc ([Var], Id, [CoreExpr])
+-- Take apart the LHS of a RULE. It's suuposed to look like
+-- /\a. f a Int dOrdInt
+-- or /\a.\d:Ord a. let { dl::Ord [a] = dOrdList a d } in f [a] dl
+-- That is, the RULE binders are lambda-bound
+-- Returns Nothing if the LHS isn't of the expected shape
+decomposeRuleLhs bndrs lhs
+ = -- Note [Simplifying the left-hand side of a RULE]
+ case collectArgs opt_lhs of
+ (Var fn, args) -> check_bndrs fn args
+
+ (Case scrut bndr ty [(DEFAULT, _, body)], args)
+ | isDeadBinder bndr -- Note [Matching seqId]
+ -> check_bndrs seqId (args' ++ args)
+ where
+ args' = [Type (idType bndr), Type ty, scrut, body]
+
+ _other -> Left bad_shape_msg
+ where
+ opt_lhs = simpleOptExpr lhs
+
+ check_bndrs fn args
+ | null (dead_bndrs) = Right (extra_dict_bndrs ++ bndrs, fn, args)
+ | otherwise = Left (vcat (map dead_msg dead_bndrs))
+ where
+ arg_fvs = exprsFreeVars args
+
+ -- Check for dead binders: Note [Unused spec binders]
+ dead_bndrs = filterOut (`elemVarSet` arg_fvs) bndrs
+
+ -- Add extra dict binders: Note [Constant rule dicts]
+ extra_dict_bndrs = [ mkLocalId (localiseName (idName d)) (idType d)
+ | d <- varSetElems (arg_fvs `delVarSetList` bndrs)
+ , isDictId d]
+
+
+ bad_shape_msg = hang (ptext (sLit "RULE left-hand side too complicated to desugar"))
+ 2 (ppr opt_lhs)
+ dead_msg bndr = hang (ptext (sLit "Forall'd") <+> pp_bndr bndr
+ <+> ptext (sLit "is not bound in RULE lhs"))
+ 2 (ppr opt_lhs)
+ pp_bndr bndr
+ | isTyVar bndr = ptext (sLit "type variable") <+> ppr bndr
+ | isCoVar bndr = ptext (sLit "coercion variable") <+> ppr bndr
+ | isDictId bndr = ptext (sLit "constraint") <+> ppr (get_pred bndr)
+ | otherwise = ptext (sLit "variable") <+> ppr bndr
+
+ get_pred b = ASSERT( isId b ) expectJust "decomposeRuleLhs"
+ (tcSplitPredTy_maybe (idType b))
+\end{code}
+
+Note [Simplifying the left-hand side of a RULE]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+simpleOptExpr occurrence-analyses and simplifies the lhs
+and thereby
+(a) sorts dict bindings into NonRecs and inlines them
+(b) substitute trivial lets so that they don't get in the way
+ Note that we substitute the function too; we might
+ have this as a LHS: let f71 = M.f Int in f71
+(c) does eta reduction
+
+For (c) consider the fold/build rule, which without simplification
+looked like:
+ fold k z (build (/\a. g a)) ==> ...
+This doesn't match unless you do eta reduction on the build argument.
+Similarly for a LHS like
+ augment g (build h)
+we do not want to get
+ augment (\a. g a) (build h)
+otherwise we don't match when given an argument like
+ augment (\a. h a a) (build h)
+
+NB: tcSimplifyRuleLhs is very careful not to generate complicated
+ dictionary expressions that we might have to match
+
+
+Note [Matching seqId]
+~~~~~~~~~~~~~~~~~~~
+The desugarer turns (seq e r) into (case e of _ -> r), via a special-case hack
+and this code turns it back into an application of seq!
+See Note [Rules for seq] in MkId for the details.
+