From: Adam Megacz <megacz@cs.berkeley.edu>
Date: Mon, 14 Mar 2011 10:39:10 +0000 (-0700)
Subject: eliminate reliance on -XRebindableSyntax
X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=ad22ef24c74f54db4cb2326a85c06ae947c78ee3

eliminate reliance on -XRebindableSyntax
---

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index bc30d60..22df6a0 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -1693,7 +1693,7 @@ impliedFlags
 
     , (Opt_ModalTypes,                 turnOn,  Opt_RankNTypes)
     , (Opt_ModalTypes,                 turnOn,  Opt_ExplicitForAll)
-    , (Opt_ModalTypes,                 turnOn,  Opt_RebindableSyntax)
+    --, (Opt_ModalTypes,                 turnOn,  Opt_RebindableSyntax)
     , (Opt_ModalTypes,                 turnOff, Opt_MonomorphismRestriction)
 
     , (Opt_RebindableSyntax, turnOff, Opt_ImplicitPrelude)      -- NB: turn off!
diff --git a/compiler/typecheck/TcExpr.lhs b/compiler/typecheck/TcExpr.lhs
index 24399f9..976aca7 100644
--- a/compiler/typecheck/TcExpr.lhs
+++ b/compiler/typecheck/TcExpr.lhs
@@ -197,7 +197,8 @@ tcExpr (HsLit lit)   res_ty =
                                 (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
+                 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') }
@@ -214,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