[commit: ghc] wip/gadtpm: Changed translation of CoPats (data families) (58de1bf)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/gadtpm
Link       : http://ghc.haskell.org/trac/ghc/changeset/58de1bf0393d5070834a336ff49ac08d75e4ff3d/ghc

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

commit 58de1bf0393d5070834a336ff49ac08d75e4ff3d
Author: George Karachalias <george.karachalias at gmail.com>
Date:   Tue Jun 23 20:34:27 2015 +0200

    Changed translation of CoPats (data families)


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

58de1bf0393d5070834a336ff49ac08d75e4ff3d
 compiler/deSugar/Check.hs | 11 ++++++++---
 1 file changed, 8 insertions(+), 3 deletions(-)

diff --git a/compiler/deSugar/Check.hs b/compiler/deSugar/Check.hs
index 2af3083..5779bb5 100644
--- a/compiler/deSugar/Check.hs
+++ b/compiler/deSugar/Check.hs
@@ -254,7 +254,7 @@ mkPmConPat con arg_tys ex_tvs dicts args
 
 translatePat :: Pat Id -> UniqSM PatVec
 translatePat pat = case pat of
-  WildPat ty         -> getUniqueSupplyM >>= \us -> return [mkPmVar us ty]
+  WildPat ty         -> (:[]) <$> mkPmVarSM ty
   VarPat  id         -> return [VarAbs id]
   ParPat p           -> translatePat (unLoc p)
   LazyPat p          -> translatePat (unLoc p) -- COMEHERE: We ignore laziness   for now
@@ -267,8 +267,13 @@ translatePat pat = case pat of
         g   = GBindAbs ps (PmExprVar (unLoc lid))
     return [idp, g]
 
-  SigPatOut p ty     -> translatePat (unLoc p) -- TODO: Use the signature?
-  CoPat wrapper p ty -> translatePat p         -- TODO: Check if we need the coercion
+  SigPatOut p ty -> translatePat (unLoc p) -- TODO: Use the signature?
+
+  CoPat wrapper p ty -> do
+    ps      <- translatePat p
+    (xp,xe) <- mkPmId2FormsSM ty {- IS THIS TYPE CORRECT OR IS IT THE OPPOSITE?? -}
+    let g = GBindAbs ps $ PmExprOther $ HsWrap wrapper (unLoc xe)
+    return [xp,g]
 
   -- (n + k)  ===>   x (True <- x >= k) (n <- x-k)
   NPlusKPat n k ge minus -> do