- = tcLookupClassByKey cCallableClassKey `thenNF_Tc` \ cCallableClass ->
- newDicts (LitLitOrigin (_UNPK_ s))
- [(cCallableClass, [pat_ty])] `thenNF_Tc` \ (dicts, _) ->
- returnTc (LitPat lit pat_ty, dicts, emptyBag, emptyBag, emptyLIE)
+ = tcLookupClass cCallableClassName `thenNF_Tc` \ cCallableClass ->
+ newDicts (LitLitOrigin (unpackFS s))
+ [mkClassPred cCallableClass [pat_ty]] `thenNF_Tc` \ dicts ->
+ returnTc (LitPat (HsLitLit s pat_ty) pat_ty, mkLIE dicts, emptyBag, emptyBag, emptyLIE)
+
+tcPat tc_bndr pat@(LitPatIn lit@(HsString _)) pat_ty
+ = unifyTauTy pat_ty stringTy `thenTc_`
+ tcLookupGlobalId eqStringName `thenNF_Tc` \ eq_id ->
+ returnTc (NPat lit stringTy (HsVar eq_id `HsApp` HsLit lit),
+ emptyLIE, emptyBag, emptyBag, emptyLIE)
+
+tcPat tc_bndr (LitPatIn simple_lit) pat_ty
+ = unifyTauTy pat_ty (simpleHsLitTy simple_lit) `thenTc_`
+ returnTc (LitPat simple_lit pat_ty, emptyLIE, emptyBag, emptyBag, emptyLIE)
+
+tcPat tc_bndr pat@(NPatIn over_lit) pat_ty
+ = newOverloadedLit origin over_lit pat_ty `thenNF_Tc` \ (over_lit_expr, lie1) ->
+ newMethodFromName origin pat_ty eqName `thenNF_Tc` \ eq ->
+
+ returnTc (NPat lit' pat_ty (HsApp (HsVar (instToId eq)) over_lit_expr),
+ lie1 `plusLIE` unitLIE eq,
+ emptyBag, emptyBag, emptyLIE)
+ where
+ origin = PatOrigin pat
+ lit' = case over_lit of
+ HsIntegral i _ -> HsInteger i
+ HsFractional f _ -> HsRat f pat_ty