-tcOverloadedLit :: InstOrigin
- -> HsOverLit Name
- -> TcType
- -> TcM (HsOverLit TcId)
-tcOverloadedLit orig lit@(HsIntegral i fi) expected_ty
- | not (fi `isHsVar` fromIntegerName) -- 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 { integer_ty <- tcMetaTy integerTyConName
- ; fi' <- tcSyntaxOp orig fi (mkFunTy integer_ty expected_ty)
- ; return (HsIntegral i (HsApp (noLoc fi') (nlHsLit (HsInteger i integer_ty)))) }
-
- | Just expr <- shortCutIntLit i expected_ty
- = return (HsIntegral i expr)
-
- | otherwise
- = do { expr <- newLitInst orig lit expected_ty
- ; return (HsIntegral i expr) }
-
-tcOverloadedLit orig lit@(HsFractional r fr) expected_ty
- | not (fr `isHsVar` fromRationalName) -- c.f. HsIntegral case
- = do { rat_ty <- tcMetaTy rationalTyConName
- ; fr' <- tcSyntaxOp orig fr (mkFunTy rat_ty expected_ty)
- ; return (HsFractional r (HsApp (noLoc fr') (nlHsLit (HsRat r rat_ty)))) }
-
- | Just expr <- shortCutFracLit r expected_ty
- = return (HsFractional r expr)
-
- | otherwise
- = do { expr <- newLitInst orig lit expected_ty
- ; return (HsFractional r expr) }
-
-newLitInst :: InstOrigin -> HsOverLit Name -> TcType -> TcM (HsExpr TcId)
-newLitInst orig lit expected_ty -- Make a LitInst
- = do { loc <- getInstLoc orig
- ; new_uniq <- newUnique
- ; let
- lit_nm = mkSystemVarName new_uniq FSLIT("lit")
- lit_inst = LitInst lit_nm lit expected_ty loc
- ; extendLIE lit_inst
- ; return (HsVar (instToId lit_inst)) }
-