[project @ 2002-11-13 12:21:08 by simonmar]
[ghc-hetmet.git] / ghc / compiler / hsSyn / HsExpr.lhs
index e295905..0cdd2b2 100644 (file)
@@ -83,14 +83,9 @@ data HsExpr id
   | HsLet      (HsBinds id)    -- let(rec)
                (HsExpr  id)
 
-  | HsWith     (HsExpr id)     -- implicit parameter binding
-               [(IPName id, HsExpr id)]
-               Bool            -- True <=> this was a 'with' binding
-                               --  (tmp, until 'with' is removed)
-
   | HsDo       (HsStmtContext Name)    -- The parameterisation is unimportant
                                        -- because in this context we never use
-                                       -- the FunRhs variant
+                                       -- the PatGuard or ParStmt variant
                [Stmt id]       -- "do":one or more stmts
                [id]            -- Ids for [return,fail,>>=,>>]
                                --      Brutal but simple
@@ -164,15 +159,17 @@ data HsExpr id
                (HsExpr id)     -- expr whose cost is to be measured
                
   -- MetaHaskell Extensions
-  | HsBracket    (HsBracket id)
+  | HsBracket    (HsBracket id) SrcLoc
 
   | HsBracketOut (HsBracket Name)      -- Output of the type checker is the *original*
                 [PendingSplice]        -- renamed expression, plus *typechecked* splices
                                        -- to be pasted back in by the desugarer
 
-  | HsSplice id (HsExpr id )           -- $z  or $(f 4)
+  | HsSplice id (HsExpr id) SrcLoc     -- $z  or $(f 4)
                                        -- The id is just a unique name to 
                                        -- identify this splice point
+
+  | HsReify (HsReify id)               -- reifyType t, reifyDecl i, reifyFixity
 \end{code}
 
 
@@ -309,10 +306,6 @@ ppr_expr (HsLet binds expr)
   = sep [hang (ptext SLIT("let")) 2 (pprBinds binds),
         hang (ptext SLIT("in"))  2 (ppr expr)]
 
-ppr_expr (HsWith expr binds is_with)
-  = sep [hang (ptext SLIT("let")) 2 (pp_ipbinds binds),
-        hang (ptext SLIT("in"))  2 (ppr expr)]
-
 ppr_expr (HsDo do_or_list_comp stmts _ _ _) = pprDo do_or_list_comp stmts
 
 ppr_expr (ExplicitList _ exprs)
@@ -389,9 +382,10 @@ ppr_expr (DictApp expr dnames)
 
 ppr_expr (HsType id) = ppr id
 
-ppr_expr (HsSplice n e)      = char '$' <> brackets (ppr n) <> pprParendExpr e
-ppr_expr (HsBracket b)       = pprHsBracket b
+ppr_expr (HsSplice n e _)    = char '$' <> brackets (ppr n) <> pprParendExpr e
+ppr_expr (HsBracket b _)     = pprHsBracket b
 ppr_expr (HsBracketOut e ps) = ppr e $$ ptext SLIT("where") <+> ppr ps
+ppr_expr (HsReify r)        = ppr r
 
 -- add parallel array brackets around a document
 --
@@ -442,12 +436,6 @@ pp_rbinds thing rbinds
     pp_rbind (v, e) = hsep [pprBndr LetBind v, char '=', ppr e]
 \end{code}
 
-\begin{code}
-pp_ipbinds :: OutputableBndr id => [(IPName id, HsExpr id)] -> SDoc
-pp_ipbinds pairs = hsep (punctuate semi (map pp_item pairs))
-                where
-                  pp_item (id,rhs) = pprBndr LetBind id <+> equals <+> ppr_expr rhs
-\end{code}
 
 
 %************************************************************************
@@ -585,8 +573,13 @@ data Stmt id
        -- The ids are a subset of the variables bound by the stmts that
        -- either (a) are used before they are bound in the stmts
        -- or     (b) are used in stmts that follow the RecStmt
-  | RecStmt  [id]      
+  | RecStmt  [id]
             [Stmt id] 
+            [HsExpr id]        -- Post type-checking only; these expressions correspond
+                               -- 1-to-1 with the [id], and are the expresions that should
+                               -- be returned by the recursion.  They may not quite be the
+                               -- Ids themselves, because the Id may be polymorphic, but
+                               -- the returned thing has to be monomorphic.
 \end{code}
 
 ExprStmts and ResultStmts are a bit tricky, because what they mean
@@ -644,7 +637,7 @@ pprStmt (ParStmt stmtss)
  = hsep (map (\stmts -> ptext SLIT("| ") <> ppr stmts) stmtss)
 pprStmt (ParStmtOut stmtss)
  = hsep (map (\stmts -> ptext SLIT("| ") <> ppr stmts) stmtss)
-pprStmt (RecStmt _ segment) = vcat (map ppr segment)
+pprStmt (RecStmt _ segment _) = vcat (map ppr segment)
 
 pprDo :: OutputableBndr id => HsStmtContext any -> [Stmt id] -> SDoc
 pprDo DoExpr stmts   = hang (ptext SLIT("do")) 2 (vcat (map ppr stmts))
@@ -685,6 +678,22 @@ pprHsBracket (TypBr t) = thBrackets (char 't') (ppr t)
 
 thBrackets pp_kind pp_body = char '[' <> pp_kind <> char '|' <+> 
                             pp_body <+> ptext SLIT("|]")
+
+data HsReify id = Reify    ReifyFlavour id     -- Pre typechecking
+               | ReifyOut ReifyFlavour Name    -- Post typechecking
+                                               -- The Name could be the name of
+                                               -- an Id, TyCon, or Class
+
+data ReifyFlavour = ReifyDecl | ReifyType | ReifyFixity
+
+instance Outputable id => Outputable (HsReify id) where
+   ppr (Reify flavour id) = ppr flavour <+> ppr id
+   ppr (ReifyOut flavour thing) = ppr flavour <+> ppr thing
+
+instance Outputable ReifyFlavour where
+   ppr ReifyDecl   = ptext SLIT("reifyDecl")
+   ppr ReifyType   = ptext SLIT("reifyType")
+   ppr ReifyFixity = ptext SLIT("reifyFixity")
 \end{code}
 
 %************************************************************************
@@ -740,6 +749,7 @@ data HsStmtContext id
   | MDoExpr                            -- Recursive do-expression
   | PArrComp                           -- Parallel array comprehension
   | PatGuard (HsMatchContext id)       -- Pattern guard for specified thing
+  | ParStmtCtxt (HsStmtContext id)     -- A branch of a parallel stmt 
 \end{code}
 
 \begin{code}
@@ -772,6 +782,7 @@ pprMatchRhsContext PatBindRhs       = ptext SLIT("the right-hand side of a pattern bin
 pprMatchRhsContext LambdaExpr  = ptext SLIT("the body of a lambda")
 pprMatchRhsContext RecUpd      = panic "pprMatchRhsContext"
 
+pprStmtContext (ParStmtCtxt c) = sep [ptext SLIT("a parallel branch of"), pprStmtContext c]
 pprStmtContext (PatGuard ctxt) = ptext SLIT("a pattern guard for") $$ pprMatchContext ctxt
 pprStmtContext DoExpr          = ptext SLIT("a 'do' expression")
 pprStmtContext MDoExpr         = ptext SLIT("an 'mdo' expression")
@@ -786,14 +797,15 @@ pprStmtResultContext other             = ptext SLIT("the result of") <+> pprStmtContext
 
 
 -- Used to generate the string for a *runtime* error message
-matchContextErrString (FunRhs fun)           = "function " ++ showSDoc (ppr fun)
-matchContextErrString CaseAlt                = "case"
-matchContextErrString PatBindRhs             = "pattern binding"
-matchContextErrString RecUpd                 = "record update"
-matchContextErrString LambdaExpr             = "lambda"
-matchContextErrString (StmtCtxt (PatGuard _)) = "pattern gaurd"
-matchContextErrString (StmtCtxt DoExpr)       = "'do' expression"
-matchContextErrString (StmtCtxt MDoExpr)      = "'mdo' expression"
-matchContextErrString (StmtCtxt ListComp)     = "list comprehension"
-matchContextErrString (StmtCtxt PArrComp)     = "array comprehension"
+matchContextErrString (FunRhs fun)              = "function " ++ showSDoc (ppr fun)
+matchContextErrString CaseAlt                   = "case"
+matchContextErrString PatBindRhs                = "pattern binding"
+matchContextErrString RecUpd                    = "record update"
+matchContextErrString LambdaExpr                = "lambda"
+matchContextErrString (StmtCtxt (ParStmtCtxt c)) = matchContextErrString (StmtCtxt c)
+matchContextErrString (StmtCtxt (PatGuard _))   = "pattern guard"
+matchContextErrString (StmtCtxt DoExpr)         = "'do' expression"
+matchContextErrString (StmtCtxt MDoExpr)        = "'mdo' expression"
+matchContextErrString (StmtCtxt ListComp)       = "list comprehension"
+matchContextErrString (StmtCtxt PArrComp)       = "array comprehension"
 \end{code}