[commit: ghc] wip/gadtpm: Finished 'translateGuard' (856ab33)

[git at git.haskell.org]

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

On branch  : wip/gadtpm
Link       : http://ghc.haskell.org/trac/ghc/changeset/856ab33f19e775a4eb986a81815e9d7c78c8b0b6/ghc

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

commit 856ab33f19e775a4eb986a81815e9d7c78c8b0b6
Author: George Karachalias <george.karachalias at gmail.com>
Date:   Fri Jun 26 15:44:37 2015 +0200

    Finished 'translateGuard'


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

856ab33f19e775a4eb986a81815e9d7c78c8b0b6
 compiler/deSugar/Check.hs | 40 ++++++++++++++++++++++++++--------------
 1 file changed, 26 insertions(+), 14 deletions(-)

diff --git a/compiler/deSugar/Check.hs b/compiler/deSugar/Check.hs
index 4b925a8..90d5b2e 100644
--- a/compiler/deSugar/Check.hs
+++ b/compiler/deSugar/Check.hs
@@ -405,21 +405,33 @@ translateGuards :: [GuardStmt Id] -> UniqSM PatVec
 translateGuards guards = concat <$> mapM translateGuard guards
 
 translateGuard :: GuardStmt Id -> UniqSM PatVec
-translateGuard (BodyStmt e _ _ _)
+translateGuard (BodyStmt e _ _ _) = translateBoolGuard e
+translateGuard (LetStmt    binds) = translateLet binds
+translateGuard (BindStmt p e _ _) = translateBind p e
+translateGuard (LastStmt      {}) = panic "translateGuard LastStmt"
+translateGuard (ParStmt       {}) = panic "translateGuard ParStmt"
+translateGuard (TransStmt     {}) = panic "translateGuard TransStmt"
+translateGuard (RecStmt       {}) = panic "translateGuard RecStmt"
+
+translateLet :: HsLocalBinds Id -> UniqSM PatVec
+translateLet binds = return [] -- NOT CORRECT: A let cannot fail so in a way we
+  -- are fine with it but it can bind things which we do not bring in scope.
+  -- Hence, they are free while they shouldn't. More constraints would make it
+  -- more expressive but omitting some is always safe (Is it? Make sure it is)
+
+translateBind :: LPat Id -> LHsExpr Id -> UniqSM PatVec
+translateBind (L _ p) e = do
+  ps <- translatePat p
+  let expr = lhsExprToPmExpr e
+  return [GBindAbs ps expr]
+
+translateBoolGuard :: LHsExpr Id -> UniqSM PatVec
+translateBoolGuard e
   | Just _ <- isTrueLHsExpr e = return []
-  | otherwise = let e' = lhsExprToPmExpr e
-                    ps = [truePmPat]
-                in  return [GBindAbs ps e']
-translateGuard (LetStmt binds)
-  = undefined {- WHAT TO DO WITH THIS THEN? WE CARE OR NOT? -}
-translateGuard (BindStmt p e _ _)
-  = do pats <- translatePat (unLoc p)
-       let e' = lhsExprToPmExpr e
-       return [GBindAbs pats e']
-translateGuard (LastStmt  {}) = panic "translateGuard LastStmt"
-translateGuard (ParStmt   {}) = panic "translateGuard ParStmt"
-translateGuard (TransStmt {}) = panic "translateGuard TransStmt"
-translateGuard (RecStmt   {}) = panic "translateGuard RecStmt"
+    -- The formal thing to do would be to generate (True <- True)
+    -- but it is trivial to solve so instead we give back an empty
+    -- PatVec for efficiency
+  | otherwise = return [GBindAbs [truePmPat] (lhsExprToPmExpr e)]
 
 -- -----------------------------------------------------------------------
 -- | Transform source expressions (HsExpr Id) to PmExpr