update submodules for GHC.HetMet.GArrow -> Control.GArrow renaming

[ghc-hetmet.git] / compiler / hsSyn / HsExpr.lhs

diff --git a/compiler/hsSyn/HsExpr.lhs b/compiler/hsSyn/HsExpr.lhs
index cf9c0d7..8ea0c4f 100644 (file)
--- a/compiler/hsSyn/HsExpr.lhs
+++ b/compiler/hsSyn/HsExpr.lhs
@@ -106,6 +106,10 @@ data HsExpr id
 
   | HsApp     (LHsExpr id) (LHsExpr id) -- Application
 
 
   | HsApp     (LHsExpr id) (LHsExpr id) -- Application
 

+  | HsKappa    (MatchGroup id)
+
+  | HsKappaApp (LHsExpr id) (LHsExpr id)
+

   -- Operator applications:
   -- NB Bracketed ops such as (+) come out as Vars.
 
   -- Operator applications:
   -- NB Bracketed ops such as (+) come out as Vars.
 

@@ -223,6 +227,13 @@ data HsExpr id
                 (LHsCmdTop id)          -- body of the abstraction
                                         -- always has an empty stack
 
                 (LHsCmdTop id)          -- body of the abstraction
                                         -- always has an empty stack
 

+  -----------------------------------------------------------
+  -- Heterogeneous Metaprogramming extension
+
+  | HsHetMetBrak  PostTcType            (LHsExpr id)            -- code type brackets
+  | HsHetMetEsc   PostTcType PostTcType (LHsExpr id)            -- code type escape
+  | HsHetMetCSP   PostTcType            (LHsExpr id)            -- code type cross-stage persistence
+

   ---------------------------------------
   -- The following are commands, not expressions proper
 
   ---------------------------------------
   -- The following are commands, not expressions proper
 

@@ -353,10 +364,15 @@ ppr_expr (HsIPVar v)     = ppr v
 ppr_expr (HsLit lit)     = ppr lit
 ppr_expr (HsOverLit lit) = ppr lit
 ppr_expr (HsPar e)       = parens (ppr_lexpr e)
 ppr_expr (HsLit lit)     = ppr lit
 ppr_expr (HsOverLit lit) = ppr lit
 ppr_expr (HsPar e)       = parens (ppr_lexpr e)

+ppr_expr (HsHetMetBrak  _   e) = ptext (sLit "<[") <> (ppr_lexpr e) <> ptext (sLit "]>")
+ppr_expr (HsHetMetEsc   _ _ e) = ptext (sLit "~~") <> (ppr_lexpr e)
+ppr_expr (HsHetMetCSP   _   e) = ptext (sLit "%%") <> (ppr_lexpr e)

 
 ppr_expr (HsCoreAnn s e)
   = vcat [ptext (sLit "HsCoreAnn") <+> ftext s, ppr_lexpr e]
 
 
 ppr_expr (HsCoreAnn s e)
   = vcat [ptext (sLit "HsCoreAnn") <+> ftext s, ppr_lexpr e]
 

+ppr_expr (HsKappaApp e1 e2) = ppr_expr $ HsApp e1 e2
+ppr_expr (HsKappa    e) = ppr_expr $ HsLam e

 ppr_expr (HsApp e1 e2)
   = let (fun, args) = collect_args e1 [e2] in
     hang (ppr_lexpr fun) 2 (sep (map pprParendExpr args))
 ppr_expr (HsApp e1 e2)
   = let (fun, args) = collect_args e1 [e2] in
     hang (ppr_lexpr fun) 2 (sep (map pprParendExpr args))

@@ -833,7 +849,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
 -- 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
               -- Not used for GhciStmt, PatGuard, which scope over other stuff
                (LHsExpr idR)
                (SyntaxExpr idR)   -- The return operator, used only for MonadComp

@@ -863,48 +880,24 @@ data StmtLR idL idR
                                        -- with type (forall a. a -> m a)
                                         -- See notes [Monad Comprehensions]
            -- After renaming, the ids are the binders 
                                        -- 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
-
-  -- "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"
+           -- bound by the stmts and used after themp

 
 

-         (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
 
                                      -- 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)
     }                                  -- See Note [Monad Comprehensions]
 
   -- Recursive statement (see Note [How RecStmt works] below)

@@ -942,6 +935,15 @@ data StmtLR idL idR
                                     -- be quite as simple as (m (tya, tyb, tyc)).
       }
   deriving (Data, Typeable)
                                     -- 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]
 \end{code}
 
 Note [The type of bind in Stmts]

@@ -955,9 +957,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.
 
 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: []
 
 
   * Before renaming: []
 

@@ -1090,18 +1092,15 @@ instance (OutputableBndr idL, OutputableBndr idR) => Outputable (StmtLR idL idR)
     ppr stmt = pprStmt stmt
 
 pprStmt :: (OutputableBndr idL, OutputableBndr idR) => (StmtLR idL idR) -> SDoc
     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 (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 })
 
 pprStmt (RecStmt { recS_stmts = segment, recS_rec_ids = rec_ids
                  , recS_later_ids = later_ids })

@@ -1116,14 +1115,15 @@ pprTransformStmt bndrs using by
         , nest 2 (ppr using)
         , nest 2 (pprBy 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
                                  -> 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
 
 pprBy :: OutputableBndr id => Maybe (LHsExpr id) -> SDoc
 pprBy Nothing  = empty

@@ -1132,6 +1132,7 @@ pprBy (Just e) = ptext (sLit "by") <+> ppr e
 pprDo :: OutputableBndr id => HsStmtContext any -> [LStmt id] -> SDoc
 pprDo DoExpr      stmts = ptext (sLit "do")  <+> ppr_do_stmts stmts
 pprDo GhciStmt    stmts = ptext (sLit "do")  <+> ppr_do_stmts stmts
 pprDo :: OutputableBndr id => HsStmtContext any -> [LStmt id] -> SDoc
 pprDo DoExpr      stmts = ptext (sLit "do")  <+> ppr_do_stmts stmts
 pprDo GhciStmt    stmts = ptext (sLit "do")  <+> ppr_do_stmts stmts

+pprDo ArrowExpr   stmts = ptext (sLit "do")  <+> ppr_do_stmts stmts

 pprDo MDoExpr     stmts = ptext (sLit "mdo") <+> ppr_do_stmts stmts
 pprDo ListComp    stmts = brackets    $ pprComp stmts
 pprDo PArrComp    stmts = pa_brackets $ pprComp stmts
 pprDo MDoExpr     stmts = ptext (sLit "mdo") <+> ppr_do_stmts stmts
 pprDo ListComp    stmts = brackets    $ pprComp stmts
 pprDo PArrComp    stmts = pa_brackets $ pprComp stmts

@@ -1277,32 +1278,30 @@ data HsStmtContext id
 
   | DoExpr                              -- do { ... }
   | MDoExpr                              -- mdo { ... }  ie recursive do-expression 
 
   | DoExpr                              -- do { ... }
   | MDoExpr                              -- mdo { ... }  ie recursive do-expression 

+  | ArrowExpr                           -- do-notation in an arrow-command context

 
   | GhciStmt                            -- A command-line Stmt in GHCi pat <- rhs
   | PatGuard (HsMatchContext id)         -- Pattern guard for specified thing
   | ParStmtCtxt (HsStmtContext id)       -- A branch of a parallel stmt
 
   | GhciStmt                            -- A command-line Stmt in GHCi pat <- rhs
   | PatGuard (HsMatchContext id)         -- Pattern guard for specified thing
   | ParStmtCtxt (HsStmtContext id)       -- A branch of a parallel stmt

-  | TransformStmtCtxt (HsStmtContext id) -- A branch of a transform stmt
+  | TransStmtCtxt (HsStmtContext id)     -- A branch of a transform stmt

   deriving (Data, Typeable)
 \end{code}
 
 \begin{code}
   deriving (Data, Typeable)
 \end{code}
 
 \begin{code}

-isDoExpr :: HsStmtContext id -> Bool
-isDoExpr DoExpr   = True
-isDoExpr MDoExpr  = True
-isDoExpr GhciStmt = True
-isDoExpr _        = False
-

 isListCompExpr :: HsStmtContext id -> Bool
 isListCompExpr :: HsStmtContext id -> Bool

-isListCompExpr ListComp  = True
-isListCompExpr PArrComp  = True
-isListCompExpr MonadComp = True
-isListCompExpr _         = False
+-- Uses syntax [ e | quals ]
+isListCompExpr ListComp         = True
+isListCompExpr PArrComp         = True
+isListCompExpr MonadComp        = True  
+isListCompExpr (ParStmtCtxt c)   = isListCompExpr c
+isListCompExpr (TransStmtCtxt c) = isListCompExpr c
+isListCompExpr _                 = False

 
 isMonadCompExpr :: HsStmtContext id -> Bool
 
 isMonadCompExpr :: HsStmtContext id -> Bool

-isMonadCompExpr MonadComp                = True
-isMonadCompExpr (ParStmtCtxt ctxt)       = isMonadCompExpr ctxt
-isMonadCompExpr (TransformStmtCtxt ctxt) = isMonadCompExpr ctxt
-isMonadCompExpr _                        = False
+isMonadCompExpr MonadComp            = True
+isMonadCompExpr (ParStmtCtxt ctxt)   = isMonadCompExpr ctxt
+isMonadCompExpr (TransStmtCtxt ctxt) = isMonadCompExpr ctxt
+isMonadCompExpr _                    = False

 \end{code}
 
 \begin{code}
 \end{code}
 
 \begin{code}

@@ -1354,8 +1353,9 @@ pprAStmtContext ctxt = article <+> pprStmtContext ctxt
 
 -----------------
 pprStmtContext GhciStmt        = ptext (sLit "interactive GHCi command")
 
 -----------------
 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 ArrowExpr       = ptext (sLit "'do' block in an arrow command")

 pprStmtContext ListComp        = ptext (sLit "list comprehension")
 pprStmtContext MonadComp       = ptext (sLit "monad comprehension")
 pprStmtContext PArrComp        = ptext (sLit "array comprehension")
 pprStmtContext ListComp        = ptext (sLit "list comprehension")
 pprStmtContext MonadComp       = ptext (sLit "monad comprehension")
 pprStmtContext PArrComp        = ptext (sLit "array comprehension")

@@ -1369,7 +1369,7 @@ pprStmtContext (PatGuard ctxt) = ptext (sLit "pattern guard for") $$ pprMatchCon
 pprStmtContext (ParStmtCtxt c)
  | opt_PprStyle_Debug = sep [ptext (sLit "parallel branch of"), pprAStmtContext c]
  | otherwise          = pprStmtContext c
 pprStmtContext (ParStmtCtxt c)
  | opt_PprStyle_Debug = sep [ptext (sLit "parallel branch of"), pprAStmtContext c]
  | otherwise          = pprStmtContext c

-pprStmtContext (TransformStmtCtxt c)
+pprStmtContext (TransStmtCtxt c)

  | opt_PprStyle_Debug = sep [ptext (sLit "transformed branch of"), pprAStmtContext c]
  | otherwise          = pprStmtContext c
 
  | opt_PprStyle_Debug = sep [ptext (sLit "transformed branch of"), pprAStmtContext c]
  | otherwise          = pprStmtContext c
 

@@ -1383,15 +1383,16 @@ matchContextErrString RecUpd                     = ptext (sLit "record update")
 matchContextErrString LambdaExpr                 = ptext (sLit "lambda")
 matchContextErrString ProcExpr                   = ptext (sLit "proc")
 matchContextErrString ThPatQuote                 = panic "matchContextErrString"  -- Not used at runtime
 matchContextErrString LambdaExpr                 = ptext (sLit "lambda")
 matchContextErrString ProcExpr                   = ptext (sLit "proc")
 matchContextErrString ThPatQuote                 = panic "matchContextErrString"  -- Not used at runtime

-matchContextErrString (StmtCtxt (ParStmtCtxt c)) = matchContextErrString (StmtCtxt c)
-matchContextErrString (StmtCtxt (TransformStmtCtxt c)) = matchContextErrString (StmtCtxt c)
-matchContextErrString (StmtCtxt (PatGuard _))    = ptext (sLit "pattern guard")
-matchContextErrString (StmtCtxt GhciStmt)        = ptext (sLit "interactive GHCi command")
-matchContextErrString (StmtCtxt DoExpr)          = ptext (sLit "'do' expression")
-matchContextErrString (StmtCtxt MDoExpr)         = ptext (sLit "'mdo' expression")
-matchContextErrString (StmtCtxt ListComp)        = ptext (sLit "list comprehension")
-matchContextErrString (StmtCtxt MonadComp)       = ptext (sLit "monad comprehension")
-matchContextErrString (StmtCtxt PArrComp)        = ptext (sLit "array comprehension")
+matchContextErrString (StmtCtxt (ParStmtCtxt c))   = matchContextErrString (StmtCtxt c)
+matchContextErrString (StmtCtxt (TransStmtCtxt c)) = matchContextErrString (StmtCtxt c)
+matchContextErrString (StmtCtxt (PatGuard _))      = ptext (sLit "pattern guard")
+matchContextErrString (StmtCtxt GhciStmt)          = ptext (sLit "interactive GHCi command")
+matchContextErrString (StmtCtxt DoExpr)            = ptext (sLit "'do' block")
+matchContextErrString (StmtCtxt ArrowExpr)         = ptext (sLit "'do' block")
+matchContextErrString (StmtCtxt MDoExpr)           = ptext (sLit "'mdo' block")
+matchContextErrString (StmtCtxt ListComp)          = ptext (sLit "list comprehension")
+matchContextErrString (StmtCtxt MonadComp)         = ptext (sLit "monad comprehension")
+matchContextErrString (StmtCtxt PArrComp)          = ptext (sLit "array comprehension")

 \end{code}
 
 \begin{code}
 \end{code}
 
 \begin{code}

@@ -1402,12 +1403,16 @@ pprMatchInCtxt ctxt match  = hang (ptext (sLit "In") <+> pprMatchContext ctxt <>
 
 pprStmtInCtxt :: (OutputableBndr idL, OutputableBndr idR)
               => HsStmtContext idL -> StmtLR idL idR -> SDoc
 
 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!
   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}
 \end{code}