[commit: ghc] wip/gadtpm: [ongoing] translation of guards (5919c36)

[git at git.haskell.org]

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

On branch  : wip/gadtpm
Link       : http://ghc.haskell.org/trac/ghc/changeset/5919c36e7b7ef5dd99d1ef29c2f6488583001dc6/ghc

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

commit 5919c36e7b7ef5dd99d1ef29c2f6488583001dc6
Author: George Karachalias <george.karachalias at gmail.com>
Date:   Thu Jun 25 16:21:20 2015 +0200

    [ongoing] translation of guards


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

5919c36e7b7ef5dd99d1ef29c2f6488583001dc6
 compiler/deSugar/Check.hs | 29 +++++++++++++++++++++++++++++
 1 file changed, 29 insertions(+)

diff --git a/compiler/deSugar/Check.hs b/compiler/deSugar/Check.hs
index 90cf37a..0a9cbda 100644
--- a/compiler/deSugar/Check.hs
+++ b/compiler/deSugar/Check.hs
@@ -378,6 +378,35 @@ translatePatVec pats = mapM translatePat pats
 translateEqnInfo :: EquationInfo -> UniqSM PatVec
 translateEqnInfo (EqnInfo { eqn_pats = ps })
   = concat <$> translatePatVec ps
+
+-- A. What to do with lets?
+-- B. write a function hsExprToPmExpr for better results? (it's a yes)
+translateGuards :: [GuardStmt Id] -> UniqSM PatVec
+translateGuards guards = concat <$> mapM translateGuard guards
+
+translateGuard :: GuardStmt Id -> UniqSM PatVec
+translateGuard (BodyStmt 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"
+
+hsExprToPmExpr :: HsExpr Id -> PmExpr
+hsExprToPmExpr = PmExprOther -- FOR NOW
+
+lhsExprToPmExpr :: LHsExpr Id -> PmExpr
+lhsExprToPmExpr (L _ e) = hsExprToPmExpr e
+
 -- -----------------------------------------------------------------------
 
 translateConPatVec :: DataCon -> HsConPatDetails Id -> UniqSM PatVec