X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcExpr.lhs;h=976aca7e8d230447be64dea37744f3d3e8c60cb2;hb=ad22ef24c74f54db4cb2326a85c06ae947c78ee3;hp=a068e5318ed8ead5cacd5f453b6af3eff59d561d;hpb=34c8d0312071f7d0f4d221a997d3408c653ef9e5;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcExpr.lhs b/compiler/typecheck/TcExpr.lhs
index a068e53..976aca7 100644
--- a/compiler/typecheck/TcExpr.lhs
+++ b/compiler/typecheck/TcExpr.lhs
@@ -50,6 +50,7 @@ import TysWiredIn
 import TysPrim( intPrimTy )
 import PrimOp( tagToEnumKey )
 import PrelNames
+import Module
 import DynFlags
 import SrcLoc
 import Util
@@ -185,9 +186,20 @@ tcExpr (HsHetMetCSP _ e) res_ty =
 
 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') }
 
@@ -203,9 +215,18 @@ tcExpr (HsCoreAnn lbl expr) res_ty
   = 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
@@ -778,7 +799,7 @@ tcExpr (PArrSeq _ seq@(FromTo expr1 expr2)) res_ty
 	; expr1' <- tcPolyExpr expr1 elt_ty
 	; expr2' <- tcPolyExpr expr2 elt_ty
 	; enum_from_to <- newMethodFromName (PArrSeqOrigin seq) 
-				 enumFromToPName elt_ty 
+				 (enumFromToPName basePackageId) elt_ty    -- !!!FIXME: chak
 	; return $ mkHsWrapCoI coi 
                      (PArrSeq enum_from_to (FromTo expr1' expr2')) }
 
@@ -788,7 +809,7 @@ tcExpr (PArrSeq _ seq@(FromThenTo expr1 expr2 expr3)) res_ty
 	; expr2' <- tcPolyExpr expr2 elt_ty
 	; expr3' <- tcPolyExpr expr3 elt_ty
 	; eft <- newMethodFromName (PArrSeqOrigin seq)
-		      enumFromThenToPName elt_ty
+		      (enumFromThenToPName basePackageId) elt_ty        -- !!!FIXME: chak
 	; return $ mkHsWrapCoI coi 
                      (PArrSeq eft (FromThenTo expr1' expr2' expr3')) }