-
-%************************************************************************
-%* *
- Overloaded literals
-%* *
-%************************************************************************
-
-In tcOverloadedLit we convert directly to an Int or Integer if we
-know that's what we want. This may save some time, by not
-temporarily generating overloaded literals, but it won't catch all
-cases (the rest are caught in lookupInst).
-
-\begin{code}
-tcOverloadedLit :: InstOrigin
- -> HsOverLit Name
- -> BoxyRhoType
- -> TcM (HsOverLit TcId)
-tcOverloadedLit orig lit@(OverLit { ol_val = val, ol_rebindable = rebindable
- , ol_witness = meth_name }) res_ty
- | rebindable
- -- Do not generate a LitInst for rebindable syntax.
- -- Reason: If we do, tcSimplify will call lookupInst, which
- -- will call tcSyntaxName, which does unification,
- -- which tcSimplify doesn't like
- -- ToDo: noLoc sadness
- = do { hs_lit <- mkOverLit val
- ; let lit_ty = hsLitType hs_lit
- ; fi' <- tcSyntaxOp orig meth_name (mkFunTy lit_ty res_ty)
- -- Overloaded literals must have liftedTypeKind, because
- -- we're instantiating an overloaded function here,
- -- whereas res_ty might be openTypeKind. This was a bug in 6.2.2
- -- However this'll be picked up by tcSyntaxOp if necessary
- ; let witness = HsApp (noLoc fi') (noLoc (HsLit hs_lit))
- ; return (lit { ol_witness = witness, ol_type = res_ty }) }
-
- | Just expr <- shortCutLit val res_ty
- = return (lit { ol_witness = expr, ol_type = res_ty })
-
- | otherwise
- = do { loc <- getInstLoc orig
- ; res_tau <- zapToMonotype res_ty
- ; new_uniq <- newUnique
- ; let lit_nm = mkSystemVarName new_uniq (fsLit "lit")
- lit_inst = LitInst {tci_name = lit_nm, tci_lit = lit,
- tci_ty = res_tau, tci_loc = loc}
- witness = HsVar (instToId lit_inst)
- ; extendLIE lit_inst
- ; return (lit { ol_witness = witness, ol_type = res_ty }) }
-\end{code}
-
-