More hacking on monad-comp
[ghc-hetmet.git] / compiler / hsSyn / HsExpr.lhs
index cf9c0d7..6dd1381 100644 (file)
@@ -833,7 +833,8 @@ type Stmt id = StmtLR id id
 -- The SyntaxExprs in here are used *only* for do-notation and monad
 -- comprehensions, which have rebindable syntax. Otherwise they are unused.
 data StmtLR idL idR
-  = LastStmt  -- Always the last Stmt in ListComp, MonadComp, PArrComp, DoExpr, MDoExpr
+  = LastStmt  -- Always the last Stmt in ListComp, MonadComp, PArrComp, 
+             -- and (after the renamer) DoExpr, MDoExpr
               -- Not used for GhciStmt, PatGuard, which scope over other stuff
                (LHsExpr idR)
                (SyntaxExpr idR)   -- The return operator, used only for MonadComp
@@ -863,48 +864,24 @@ data StmtLR idL idR
                                        -- with type (forall a. a -> m a)
                                         -- See notes [Monad Comprehensions]
            -- After renaming, the ids are the binders 
-           -- bound by the stmts and used after them
+           -- bound by the stmts and used after themp
 
-  -- "qs, then f by e" ==> TransformStmt qs binders f (Just e) (return) (>>=)
-  -- "qs, then f"      ==> TransformStmt qs binders f Nothing  (return) (>>=)
-  | TransformStmt 
-         [LStmt idL]   -- Stmts are the ones to the left of the 'then'
-
-         [idR]                 -- After renaming, the Ids are the binders occurring 
-                       -- within this transform statement that are used after it
-
-         (LHsExpr idR)         -- "then f"
-
-         (Maybe (LHsExpr idR)) -- "by e" (optional)
-
-         (SyntaxExpr idR)       -- The 'return' function for inner monad
-                                -- comprehensions
-         (SyntaxExpr idR)       -- The '(>>=)' operator.
-                                -- See Note [Monad Comprehensions]
-
-  | GroupStmt {
-      grpS_stmts :: [LStmt idL],      -- Stmts to the *left* of the 'group'
+  | TransStmt {
+      trS_form  :: TransForm,
+      trS_stmts :: [LStmt idL],      -- Stmts to the *left* of the 'group'
                                      -- which generates the tuples to be grouped
 
-      grpS_bndrs :: [(idR, idR)],     -- See Note [GroupStmt binder map]
+      trS_bndrs :: [(idR, idR)],     -- See Note [TransStmt binder map]
                                
-      grpS_by :: Maybe (LHsExpr idR),  -- "by e" (optional)
-
-      grpS_using :: LHsExpr idR,
-      grpS_explicit :: Bool,   -- True  <=> explicit "using f"
-                               -- False <=> implicit; grpS_using is filled in with 
-                                --     'groupWith' (list comprehensions) or 
-                               --     'groupM' (monad comprehensions)
-
-       -- Invariant: if grpS_explicit = False, then grp_by = Just e
-       -- That is, we can have    group by e
-       --                         group using f
-       --                         group by e using f
-
-      grpS_ret :: SyntaxExpr idR,      -- The 'return' function for inner monad
-                                       -- comprehensions
-      grpS_bind :: SyntaxExpr idR,     -- The '(>>=)' operator
-      grpS_fmap :: SyntaxExpr idR      -- The polymorphic 'fmap' function for desugaring
+      trS_using :: LHsExpr idR,
+      trS_by :: Maybe (LHsExpr idR),   -- "by e" (optional)
+       -- Invariant: if trS_form = GroupBy, then grp_by = Just e
+
+      trS_ret :: SyntaxExpr idR,      -- The monomorphic 'return' function for 
+                                       -- the inner monad comprehensions
+      trS_bind :: SyntaxExpr idR,     -- The '(>>=)' operator
+      trS_fmap :: SyntaxExpr idR      -- The polymorphic 'fmap' function for desugaring
+                                      -- Only for 'group' forms
     }                                  -- See Note [Monad Comprehensions]
 
   -- Recursive statement (see Note [How RecStmt works] below)
@@ -942,6 +919,15 @@ data StmtLR idL idR
                                     -- be quite as simple as (m (tya, tyb, tyc)).
       }
   deriving (Data, Typeable)
+
+data TransForm         -- The 'f' below is the 'using' function, 'e' is the by function
+  = ThenForm           -- then f          or    then f by e
+  | GroupFormU         -- group using f   or    group using f by e
+  | GroupFormB         -- group by e  
+      -- In the GroupByFormB, trS_using is filled in with
+      --    'groupWith' (list comprehensions) or 
+      --    'groupM' (monad comprehensions)
+  deriving (Data, Typeable)
 \end{code}
 
 Note [The type of bind in Stmts]
@@ -955,9 +941,9 @@ exotic type, such as
 So we must be careful not to make assumptions about the type.
 In particular, the monad may not be uniform throughout.
 
-Note [GroupStmt binder map]
+Note [TransStmt binder map]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
-The [(idR,idR)] in a GroupStmt behaves as follows:
+The [(idR,idR)] in a TransStmt behaves as follows:
 
   * Before renaming: []
 
@@ -1090,18 +1076,15 @@ instance (OutputableBndr idL, OutputableBndr idR) => Outputable (StmtLR idL idR)
     ppr stmt = pprStmt stmt
 
 pprStmt :: (OutputableBndr idL, OutputableBndr idR) => (StmtLR idL idR) -> SDoc
-pprStmt (LastStmt expr _)         = ppr expr
+pprStmt (LastStmt expr _)         = ifPprDebug (ptext (sLit "[last]")) <+> ppr expr
 pprStmt (BindStmt pat expr _ _)   = hsep [ppr pat, ptext (sLit "<-"), ppr expr]
 pprStmt (LetStmt binds)           = hsep [ptext (sLit "let"), pprBinds binds]
 pprStmt (ExprStmt expr _ _ _)     = ppr expr
 pprStmt (ParStmt stmtss _ _ _)    = hsep (map doStmts stmtss)
   where doStmts stmts = ptext (sLit "| ") <> ppr stmts
 
-pprStmt (TransformStmt stmts bndrs using by _ _)
-  = sep (ppr_lc_stmts stmts ++ [pprTransformStmt bndrs using by])
-
-pprStmt (GroupStmt { grpS_stmts = stmts, grpS_by = by, grpS_using = using, grpS_explicit = explicit })
-  = sep (ppr_lc_stmts stmts ++ [pprGroupStmt by using explicit])
+pprStmt (TransStmt { trS_stmts = stmts, trS_by = by, trS_using = using, trS_form = form })
+  = sep (ppr_lc_stmts stmts ++ [pprTransStmt by using form])
 
 pprStmt (RecStmt { recS_stmts = segment, recS_rec_ids = rec_ids
                  , recS_later_ids = later_ids })
@@ -1116,14 +1099,15 @@ pprTransformStmt bndrs using by
         , nest 2 (ppr using)
         , nest 2 (pprBy by)]
 
-pprGroupStmt :: OutputableBndr id => Maybe (LHsExpr id)
-                                  -> LHsExpr id -> Bool
+pprTransStmt :: OutputableBndr id => Maybe (LHsExpr id)
+                                  -> LHsExpr id -> TransForm
                                  -> SDoc
-pprGroupStmt by using explicit
-  = sep [ ptext (sLit "then group"), nest 2 (pprBy by), nest 2 pp_using ]
-  where
-    pp_using | explicit  = ptext (sLit "using") <+> ppr using
-             | otherwise = empty
+pprTransStmt by using ThenForm
+  = sep [ ptext (sLit "then"), nest 2 (ppr using), nest 2 (pprBy by)]
+pprTransStmt by _ GroupFormB
+  = sep [ ptext (sLit "then group"), nest 2 (pprBy by) ]
+pprTransStmt by using GroupFormU
+  = sep [ ptext (sLit "then group"), nest 2 (pprBy by), nest 2 (ptext (sLit "using") <+> ppr using)]
 
 pprBy :: OutputableBndr id => Maybe (LHsExpr id) -> SDoc
 pprBy Nothing  = empty
@@ -1354,8 +1338,8 @@ pprAStmtContext ctxt = article <+> pprStmtContext ctxt
 
 -----------------
 pprStmtContext GhciStmt        = ptext (sLit "interactive GHCi command")
-pprStmtContext DoExpr          = ptext (sLit "'do' expression")
-pprStmtContext MDoExpr         = ptext (sLit "'mdo' expression")
+pprStmtContext DoExpr          = ptext (sLit "'do' block")
+pprStmtContext MDoExpr         = ptext (sLit "'mdo' block")
 pprStmtContext ListComp        = ptext (sLit "list comprehension")
 pprStmtContext MonadComp       = ptext (sLit "monad comprehension")
 pprStmtContext PArrComp        = ptext (sLit "array comprehension")
@@ -1402,12 +1386,16 @@ pprMatchInCtxt ctxt match  = hang (ptext (sLit "In") <+> pprMatchContext ctxt <>
 
 pprStmtInCtxt :: (OutputableBndr idL, OutputableBndr idR)
               => HsStmtContext idL -> StmtLR idL idR -> SDoc
-pprStmtInCtxt ctxt stmt = hang (ptext (sLit "In a stmt of") <+> pprAStmtContext ctxt <> colon)
-                         4 (ppr_stmt stmt)
+pprStmtInCtxt ctxt (LastStmt e _)
+  | isListCompExpr ctxt      -- For [ e | .. ], do not mutter about "stmts"
+  = hang (ptext (sLit "In the expression:")) 2 (ppr e)
+
+pprStmtInCtxt ctxt stmt 
+  = hang (ptext (sLit "In a stmt of") <+> pprAStmtContext ctxt <> colon)
+       2 (ppr_stmt stmt)
   where
     -- For Group and Transform Stmts, don't print the nested stmts!
-    ppr_stmt (GroupStmt { grpS_by = by, grpS_using = using
-                        , grpS_explicit = explicit }) = pprGroupStmt by using explicit
-    ppr_stmt (TransformStmt _ bndrs using by _ _) = pprTransformStmt bndrs using by
-    ppr_stmt stmt                                 = pprStmt stmt
+    ppr_stmt (TransStmt { trS_by = by, trS_using = using
+                        , trS_form = form }) = pprTransStmt by using form
+    ppr_stmt stmt = pprStmt stmt
 \end{code}