+
+
+%************************************************************************
+%* *
+\subsection{Tidying lit pats}
+%* *
+%************************************************************************
+
+\begin{code}
+tidyLitPat lit lit_ty default_pat
+ | lit_ty == charTy = ConPat charDataCon lit_ty [] [] [LitPat (mk_char lit) charPrimTy]
+ | lit_ty == intTy = ConPat intDataCon lit_ty [] [] [LitPat (mk_int lit) intPrimTy]
+ | lit_ty == wordTy = ConPat wordDataCon lit_ty [] [] [LitPat (mk_word lit) wordPrimTy]
+ | lit_ty == addrTy = ConPat addrDataCon lit_ty [] [] [LitPat (mk_addr lit) addrPrimTy]
+ | lit_ty == floatTy = ConPat floatDataCon lit_ty [] [] [LitPat (mk_float lit) floatPrimTy]
+ | lit_ty == doubleTy = ConPat doubleDataCon lit_ty [] [] [LitPat (mk_double lit) doublePrimTy]
+
+ -- Convert literal patterns like "foo" to 'f':'o':'o':[]
+ | str_lit lit = mk_list lit
+
+ | otherwise = default_pat
+
+ where
+ mk_int (HsInt i) = HsIntPrim i
+ mk_int l@(HsLitLit s) = l
+
+ mk_char (HsChar c) = HsCharPrim c
+ mk_char l@(HsLitLit s) = l
+
+ mk_word l@(HsLitLit s) = l
+
+ mk_addr l@(HsLitLit s) = l
+
+ mk_float (HsInt i) = HsFloatPrim (fromInteger i)
+ mk_float (HsFrac f) = HsFloatPrim f
+ mk_float l@(HsLitLit s) = l
+
+ mk_double (HsInt i) = HsDoublePrim (fromInteger i)
+ mk_double (HsFrac f) = HsDoublePrim f
+ mk_double l@(HsLitLit s) = l
+
+ null_str_lit (HsString s) = _NULL_ s
+ null_str_lit other_lit = False
+
+ str_lit (HsString s) = True
+ str_lit _ = False
+
+ mk_list (HsString s) = foldr
+ (\c pat -> ConPat consDataCon lit_ty [] [] [mk_char_lit c,pat])
+ (ConPat nilDataCon lit_ty [] [] []) (_UNPK_ s)
+
+ mk_char_lit c = ConPat charDataCon charTy [] [] [LitPat (HsCharPrim c) charPrimTy]
+\end{code}
+
+
+%************************************************************************
+%* *
+\subsection{Building lets}
+%* *
+%************************************************************************
+
+Use case, not let for unlifted types. The simplifier will turn some
+back again.
+
+\begin{code}
+mkDsLet :: CoreBind -> CoreExpr -> CoreExpr
+mkDsLet (NonRec bndr rhs) body
+ | isUnLiftedType (idType bndr) = Case rhs bndr [(DEFAULT,[],body)]
+mkDsLet bind body
+ = Let bind body
+
+mkDsLets :: [CoreBind] -> CoreExpr -> CoreExpr
+mkDsLets binds body = foldr mkDsLet body binds
+\end{code}
+
+
+%************************************************************************
+%* *
+\subsection{ Selecting match variables}
+%* *
+%************************************************************************
+
+We're about to match against some patterns. We want to make some
+@Ids@ to use as match variables. If a pattern has an @Id@ readily at
+hand, which should indeed be bound to the pattern as a whole, then use it;
+otherwise, make one up.
+
+\begin{code}
+selectMatchVar :: TypecheckedPat -> DsM Id
+selectMatchVar (VarPat var) = returnDs var
+selectMatchVar (AsPat var pat) = returnDs var
+selectMatchVar (LazyPat pat) = selectMatchVar pat
+selectMatchVar other_pat = newSysLocalDs (outPatType other_pat) -- OK, better make up one...
+\end{code}
+
+