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 <[email protected]> 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} _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
