eliminate reliance on -XRebindableSyntax

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index bc30d60..22df6a0 100644 (file)
--- 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_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!
     , (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 (file)
--- 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"
                                 (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') }
   
 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') }
 
   = 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
 
 tcExpr (NegApp expr neg_expr) res_ty
   = do { neg_expr' <- tcSyntaxOp NegateOrigin neg_expr