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}
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
%************************************************************************
\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
+
+ | CoApp Var -- [] x; the xi are dicts or coercions
+ | CoTyApp Type -- [] t
+ | CoLam Id -- \x. []; the xi are dicts or coercions
+ | CoTyLam TyVar -- \a. []
+
+ -- Non-empty bindings, so that the identity coercion
+ -- is always exactly CoHole
+ | CoLet (LHsBinds Id) -- let binds in []
+ -- (ould be nicer to be core bindings)
+
+instance Outputable ExprCoFn where
+ ppr co_fn = pprCoFn (ptext SLIT("<>")) co_fn
+
+pprCoFn it CoHole = it
+pprCoFn it (CoCompose f1 f2) = pprCoFn (pprCoFn it f2) f1
+pprCoFn it (ExprCoFn co) = it <+> ptext SLIT("`cast`") <+> pprParendType co
+pprCoFn it (CoApp id) = it <+> ppr id
+pprCoFn it (CoTyApp ty) = it <+> ptext SLIT("@") <+> pprParendType ty
+pprCoFn it (CoLam id) = ptext SLIT("\\") <> pprBndr LambdaBind id <> dot <+> it
+pprCoFn it (CoTyLam tv) = ptext SLIT("/\\") <> pprBndr LambdaBind tv <> dot <+> it
+pprCoFn it (CoLet binds) = sep [ptext SLIT("let") <+> braces (ppr binds), it]
(<.>) :: ExprCoFn -> ExprCoFn -> ExprCoFn
-(<.>) = CoCompose
+CoHole <.> c = c
+c <.> CoHole = c
+c1 <.> c2 = c1 `CoCompose` c2
+
+mkCoTyApps :: [Type] -> ExprCoFn
+mkCoTyApps tys = mk_co_fn CoTyApp (reverse tys)
+
+mkCoApps :: [Id] -> ExprCoFn
+mkCoApps ids = mk_co_fn CoApp (reverse ids)
+
+mkCoTyLams :: [TyVar] -> ExprCoFn
+mkCoTyLams ids = mk_co_fn CoTyLam ids
+
+mkCoLams :: [Id] -> ExprCoFn
+mkCoLams ids = mk_co_fn CoLam ids
+
+mk_co_fn :: (a -> ExprCoFn) -> [a] -> ExprCoFn
+mk_co_fn f as = foldr (CoCompose . f) CoHole as
idCoercion :: ExprCoFn
idCoercion = CoHole