X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FhsSyn%2FHsBinds.lhs;h=f3a0d0b31646aa7600b19b57a4fc9631de665172;hb=5d541fe7c43a1dc4c1b2dd9ee49e64238b0754ca;hp=78a22343bb9fe87b67750e1f21d3018a04c91bb1;hpb=0d7cc019c65244968f8bc9cbeb5501a3bb832776;p=ghc-hetmet.git

diff --git a/compiler/hsSyn/HsBinds.lhs b/compiler/hsSyn/HsBinds.lhs
index 78a2234..f3a0d0b 100644
--- a/compiler/hsSyn/HsBinds.lhs
+++ b/compiler/hsSyn/HsBinds.lhs
@@ -16,14 +16,16 @@ import {-# SOURCE #-} HsExpr ( HsExpr, pprExpr, LHsExpr,
 import {-# SOURCE #-} HsPat  ( LPat )
 
 import HsTypes		( LHsType, PostTcType )
-import Type		( Type )
+import PprCore		( {- instances -} )
+import Coercion		( Coercion )
+import Type		( Type, pprParendType )
 import Name		( Name )
 import NameSet		( NameSet, elemNameSet )
 import BasicTypes	( IPName, RecFlag(..), InlineSpec(..), Fixity )
 import Outputable	
 import SrcLoc		( Located(..), SrcSpan, unLoc )
 import Util		( sortLe )
-import Var		( TyVar, DictId, Id )
+import Var		( TyVar, DictId, Id, Var )
 import Bag		( Bag, emptyBag, isEmptyBag, bagToList, unionBags, unionManyBags )
 \end{code}
 
@@ -59,14 +61,15 @@ type LHsBind  id  = Located (HsBind id)
 data HsBind id
   = FunBind {	-- FunBind is used for both functions 	f x = e
 		-- and variables			f = \x -> e
--- Reason 1: the Match stuff lets us have an optional
---	   result type sig	f :: a->a = ...mentions a...
+-- Reason 1: Special case for type inference: see TcBinds.tcMonoBinds
 --
--- Reason 2: Special case for type inference: see TcBinds.tcMonoBinds
---
--- Reason 3: instance decls can only have FunBinds, which is convenient
+-- Reason 2: instance decls can only have FunBinds, which is convenient
 --	     If you change this, you'll need tochange e.g. rnMethodBinds
 
+-- But note that the form	f :: a->a = ...
+-- parses as a pattern binding, just like
+--			(f :: a -> a) = ... 
+
 	fun_id :: Located id,
 
 	fun_infix :: Bool,	-- True => infix declaration
@@ -295,20 +298,44 @@ instance (OutputableBndr id) => Outputable (IPBind id) where
 %************************************************************************
 
 \begin{code}
--- A Coercion is an expression with a hole in it
+-- A ExprCoFn is an expression with a hole in it
 -- We need coercions to have concrete form so that we can zonk them
 
 data ExprCoFn
   = CoHole			-- The identity coercion
-  | CoCompose ExprCoFn ExprCoFn
-  | CoApps ExprCoFn [Id]		-- Non-empty list
-  | CoTyApps ExprCoFn [Type]		--   in all of these
-  | CoLams [Id] ExprCoFn		--   so that the identity coercion
-  | CoTyLams [TyVar] ExprCoFn		--   is just Hole
-  | CoLet (LHsBinds Id) ExprCoFn	-- Would be nicer to be core bindings
+
+  | CoCompose ExprCoFn ExprCoFn	-- (\a1..an. []) `CoCompose` (\x1..xn. [])
+				--	= (\a1..an \x1..xn. [])
+
+  | ExprCoFn Coercion		-- A cast:  [] `cast` co
+				-- Guaranteedn not the identity coercion
+
+	-- Non-empty list in all of these, so that the identity coercion
+	-- is always exactly CoHole, not, say, (CoTyLams [])
+  | CoApps [Var]		-- [] x1 .. xn; the xi are dicts or coercions
+  | CoTyApps [Type]		-- [] t1 .. tn
+  | CoLams [Id] 		-- \x1..xn. []; the xi are dicts or coercions
+  | CoTyLams [TyVar] 		-- \a1..an. []
+  | CoLet (LHsBinds Id)		-- let binds in []
+				-- (ould be nicer to be core bindings)
+
+instance Outputable ExprCoFn where
+  ppr CoHole	     = ptext SLIT("<>")
+  ppr (ExprCoFn co)  = ppr co
+  ppr (CoApps ids)   = ppr CoHole <+> interppSP ids
+  ppr (CoTyApps tys) = ppr CoHole <+> hsep (map pprParendType tys)
+  ppr (CoTyLams tvs) = sep [ptext SLIT("/\\") <> hsep (map (pprBndr LambdaBind) tvs),
+		 	    ptext SLIT("->") <+> ppr CoHole]
+  ppr (CoLams ids)   = sep [ptext SLIT("\\") <> hsep (map (pprBndr LambdaBind) ids),
+			    ptext SLIT("->") <+> ppr CoHole]
+  ppr (CoLet binds)  = sep [ptext SLIT("let") <+> braces (ppr binds),
+			    ppr CoHole]
+  ppr (CoCompose co1 co2) = sep [ppr co1, ptext SLIT("<.>"), ppr co2]
 
 (<.>) :: ExprCoFn -> ExprCoFn -> ExprCoFn
-(<.>) = CoCompose
+CoHole <.> c = c
+c <.> CoHole = c
+c1 <.> c2    = c1 `CoCompose` c2
 
 idCoercion :: ExprCoFn
 idCoercion = CoHole