[commit: ghc] imp-param-class: Change `let ?x = ...` to use the `IP` class. (13748fc)

[Iavor Diatchki]

Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : imp-param-class

http://hackage.haskell.org/trac/ghc/changeset/13748fcead3376f4cf2bd0198de7aa2fc4c033be

>---------------------------------------------------------------

commit 13748fcead3376f4cf2bd0198de7aa2fc4c033be
Author: Iavor S. Diatchki <diatchki at galois.com>
Date:   Fri May 25 17:31:40 2012 -0700

    Change `let ?x = ...` to use the `IP` class.
    
    XXX: Technically, the IP bindings that define the values of the implicit
    parameters should be cast to a dictionary for the class (see `mkIPBox` in
    module `MkCore`).  At the moment we don't do this, which is not quite
    right (although things still work because the value and the dictionary
    are represented in the same way).

>---------------------------------------------------------------

 compiler/coreSyn/MkCore.lhs    |    8 +++++++-
 compiler/typecheck/TcBinds.lhs |   12 +++++++++---
 2 files changed, 16 insertions(+), 4 deletions(-)

diff --git a/compiler/coreSyn/MkCore.lhs b/compiler/coreSyn/MkCore.lhs
index 53386fe..a2849a8 100644
--- a/compiler/coreSyn/MkCore.lhs
+++ b/compiler/coreSyn/MkCore.lhs
@@ -303,11 +303,17 @@ mkStringExprFS str
 
 \begin{code}
 
+-- XXX:  Here we should be casting the defintions of the implicit
+-- parameter to a dictionary for the IP class.  The class has only
+-- one method so the two use the same representaion, but it'd be
+-- nice to do this correctly.
+-- What is the appropriate coerciosn to use though?
 mkIPBox :: IPName IpId -> CoreExpr -> CoreExpr
-mkIPBox ipx e = e `Cast` mkSymCo (mkAxInstCo (ipCoAxiom ip) [ty])
+mkIPBox ipx e = e {-`Cast` mkSymCo (mkAxInstCo (ipCoAxiom ip) [ty])
   where x = ipNameName ipx
         Just (ip, ty) = getIPPredTy_maybe (evVarPred x)
         -- NB: don't use the DataCon work id because we don't generate code for it
+-}
 
 mkIPUnbox :: IPName IpId -> CoreExpr
 mkIPUnbox ipx = Var x `Cast` mkAxInstCo (ipCoAxiom ip) [ty]
diff --git a/compiler/typecheck/TcBinds.lhs b/compiler/typecheck/TcBinds.lhs
index e6e0757..6148fe3 100644
--- a/compiler/typecheck/TcBinds.lhs
+++ b/compiler/typecheck/TcBinds.lhs
@@ -45,6 +45,8 @@ import Util
 import BasicTypes
 import Outputable
 import FastString
+import Type(mkStrLitTy)
+import PrelNames(ipClassName)
 
 import Control.Monad
 
@@ -207,7 +209,9 @@ tcLocalBinds (HsValBinds (ValBindsOut binds sigs)) thing_inside
 tcLocalBinds (HsValBinds (ValBindsIn {})) _ = panic "tcLocalBinds"
 
 tcLocalBinds (HsIPBinds (IPBinds ip_binds _)) thing_inside
-  = do  { (given_ips, ip_binds') <- mapAndUnzipM (wrapLocSndM tc_ip_bind) ip_binds
+  = do  { ipClass <- tcLookupClass ipClassName
+        ; (given_ips, ip_binds') <- mapAndUnzipM
+                                    (wrapLocSndM (tc_ip_bind ipClass)) ip_binds
 
         -- If the binding binds ?x = E, we  must now 
         -- discharge any ?x constraints in expr_lie
@@ -222,9 +226,11 @@ tcLocalBinds (HsIPBinds (IPBinds ip_binds _)) thing_inside
         -- I wonder if we should do these one at at time
         -- Consider     ?x = 4
         --              ?y = ?x + 1
-    tc_ip_bind (IPBind ip expr) 
+    tc_ip_bind ipClass (IPBind ip expr) 
        = do { ty <- newFlexiTyVarTy argTypeKind
-            ; ip_id <- newIP ip ty
+              -- XXX: Just switch to string in the bind
+            ; let param = mkStrLitTy $ occNameFS $ nameOccName $ ipNameName ip
+            ; ip_id <- newDict ipClass [ param, ty ]
             ; expr' <- tcMonoExpr expr ty
             ; return (ip_id, (IPBind (IPName ip_id) expr')) }
 \end{code}