tcExpr (HsApp e1 e2) res_ty = tcApp e1 [e2] res_ty
-tcExpr (HsLit lit) res_ty = do { let lit_ty = hsLitType lit
- ; tcWrapResult (HsLit lit) lit_ty res_ty }
-
+tcExpr (HsLit lit) res_ty =
+ getHetMetLevel >>= \lev ->
+ case lev of
+ [] -> do { let lit_ty = hsLitType lit
+ ; tcWrapResult (HsLit lit) lit_ty res_ty }
+ (ec:rest) -> let n = case lit of
+ (HsChar c) -> hetmet_guest_char_literal_name
+ (HsString str) -> hetmet_guest_string_literal_name
+ (HsInteger i _) -> hetmet_guest_integer_literal_name
+ (HsInt i) -> hetmet_guest_integer_literal_name
+ _ -> error "literals of this sort are not allowed at depth >0"
+ in tcExpr (HsHetMetEsc (TyVarTy ec) placeHolderType $ noLoc $
+ (HsApp (noLoc $ HsVar n) (noLoc $ HsLit lit))) res_ty
+
tcExpr (HsPar expr) res_ty = do { expr' <- tcMonoExprNC expr res_ty
; return (HsPar expr') }
= do { expr' <- tcMonoExpr expr res_ty
; return (HsCoreAnn lbl expr') }
-tcExpr (HsOverLit lit) res_ty
- = do { lit' <- newOverloadedLit (LiteralOrigin lit) lit res_ty
- ; return (HsOverLit lit') }
+tcExpr (HsOverLit lit) res_ty =
+ getHetMetLevel >>= \lev ->
+ case lev of
+ [] -> do { lit' <- newOverloadedLit (LiteralOrigin lit) lit res_ty
+ ; return (HsOverLit lit') }
+ (ec:rest) -> let n = case lit of
+ (OverLit { ol_val = HsIntegral i }) -> hetmet_guest_integer_literal_name
+ (OverLit { ol_val = HsIsString fs }) -> hetmet_guest_string_literal_name
+ (OverLit { ol_val = HsFractional f }) -> error "fractional literals not allowed at depth >0"
+ in tcExpr (HsHetMetEsc (TyVarTy ec) placeHolderType $ noLoc $
+ (HsApp (noLoc $ HsVar n) (noLoc $ HsOverLit lit))) res_ty
+
tcExpr (NegApp expr neg_expr) res_ty
= do { neg_expr' <- tcSyntaxOp NegateOrigin neg_expr