X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FdeSugar%2FDsHsSyn.lhs;h=10cf88deb5b2bfc5d73013e94dacd524c640d133;hb=438596897ebbe25a07e1c82085cfbc5bdb00f09e;hp=08288bd97c858f8fadb76ba70747ddd837ebb609;hpb=9d4c03805bafb6b1e1d47306b6a6c591c998e517;p=ghc-hetmet.git

diff --git a/ghc/compiler/deSugar/DsHsSyn.lhs b/ghc/compiler/deSugar/DsHsSyn.lhs
index 08288bd..10cf88d 100644
--- a/ghc/compiler/deSugar/DsHsSyn.lhs
+++ b/ghc/compiler/deSugar/DsHsSyn.lhs
@@ -1,22 +1,20 @@
 %
-% (c) The AQUA Project, Glasgow University, 1996
+% (c) The AQUA Project, Glasgow University, 1996-1998
 %
 \section[DsHsSyn]{Haskell abstract syntax---added things for desugarer}
 
 \begin{code}
-#include "HsVersions.h"
-
 module DsHsSyn where
 
-IMP_Ubiq()
+#include "HsVersions.h"
 
-import HsSyn		( OutPat(..), HsBinds(..), Bind(..), MonoBinds(..),
-			  Sig, HsExpr, GRHSsAndBinds, Match, HsLit )
-import TcHsSyn		( SYN_IE(TypecheckedPat), SYN_IE(TypecheckedBind), 
-			  SYN_IE(TypecheckedMonoBinds) )
+import HsSyn		( OutPat(..), MonoBinds(..) )
+import TcHsSyn		( TypecheckedPat,
+			  TypecheckedMonoBinds )
 
-import Id		( idType )
-import TysWiredIn	( mkListTy, mkTupleTy, unitTy )
+import Id		( idType, Id )
+import Type             ( Type )
+import TysWiredIn	( mkListTy, mkTupleTy, mkUnboxedTupleTy, unitTy )
 import Util		( panic )
 \end{code}
 
@@ -29,13 +27,14 @@ outPatType (WildPat ty)		= ty
 outPatType (VarPat var)		= idType var
 outPatType (LazyPat pat)	= outPatType pat
 outPatType (AsPat var pat)	= idType var
-outPatType (ConPat _ ty _)	= ty
-outPatType (ConOpPat _ _ _ ty)	= ty
+outPatType (ConPat _ ty _ _ _)	= ty
 outPatType (ListPat ty _)	= mkListTy ty
-outPatType (TuplePat pats)	= mkTupleTy (length pats) (map outPatType pats)
-outPatType (RecPat _ ty _)      = ty
+outPatType (TuplePat pats True)	= mkTupleTy (length pats) (map outPatType pats)
+outPatType (TuplePat pats False)= mkUnboxedTupleTy (length pats) (map outPatType pats)
+outPatType (RecPat _ ty _ _ _)  = ty
 outPatType (LitPat lit ty)	= ty
 outPatType (NPat lit ty _)	= ty
+outPatType (NPlusKPat _ _ ty _ _) = ty
 outPatType (DictPat ds ms)      = case (length ds_ms) of
 				    0 -> unitTy
 				    1 -> idType (head ds_ms)
@@ -52,28 +51,26 @@ the same order as they appear in the tuple.
 collectTypedBinders and collectedTypedPatBinders are the exportees.
 
 \begin{code}
-collectTypedBinders :: TypecheckedBind -> [Id]
-collectTypedBinders EmptyBind	    = []
-collectTypedBinders (NonRecBind bs) = collectTypedMonoBinders bs
-collectTypedBinders (RecBind    bs) = collectTypedMonoBinders bs
-
 collectTypedMonoBinders :: TypecheckedMonoBinds -> [Id]
 collectTypedMonoBinders EmptyMonoBinds	      = []
 collectTypedMonoBinders (PatMonoBind pat _ _) = collectTypedPatBinders pat
 collectTypedMonoBinders (FunMonoBind f _ _ _) = [f]
 collectTypedMonoBinders (VarMonoBind v _)     = [v]
+collectTypedMonoBinders (CoreMonoBind v _)     = [v]
 collectTypedMonoBinders (AndMonoBinds bs1 bs2)
  = collectTypedMonoBinders bs1 ++ collectTypedMonoBinders bs2
+collectTypedMonoBinders (AbsBinds _ _ exports _)
+  = [global | (_, global, local) <- exports]
 
 collectTypedPatBinders :: TypecheckedPat -> [Id]
-collectTypedPatBinders (VarPat var)	    = [var]
-collectTypedPatBinders (LazyPat pat)	    = collectTypedPatBinders pat
-collectTypedPatBinders (AsPat a pat)	    = a : collectTypedPatBinders pat
-collectTypedPatBinders (ConPat _ _ pats)    = concat (map collectTypedPatBinders pats)
-collectTypedPatBinders (ConOpPat p1 _ p2 _) = collectTypedPatBinders p1 ++ collectTypedPatBinders p2
-collectTypedPatBinders (ListPat t pats)     = concat (map collectTypedPatBinders pats)
-collectTypedPatBinders (TuplePat pats)	    = concat (map collectTypedPatBinders pats)
-collectTypedPatBinders (RecPat _ _ fields)  = concat (map (\ (f,pat,_) -> collectTypedPatBinders pat) fields)
-collectTypedPatBinders (DictPat ds ms)	    = ds ++ ms
-collectTypedPatBinders any_other_pat	    = [ {-no binders-} ]
+collectTypedPatBinders (VarPat var)	     = [var]
+collectTypedPatBinders (LazyPat pat)	     = collectTypedPatBinders pat
+collectTypedPatBinders (AsPat a pat)	     = a : collectTypedPatBinders pat
+collectTypedPatBinders (ConPat _ _ _ _ pats) = concat (map collectTypedPatBinders pats)
+collectTypedPatBinders (ListPat t pats)      = concat (map collectTypedPatBinders pats)
+collectTypedPatBinders (TuplePat pats _)     = concat (map collectTypedPatBinders pats)
+collectTypedPatBinders (RecPat _ _ _ _ fields) = concat (map (\ (f,pat,_) -> collectTypedPatBinders pat)
+							fields)
+collectTypedPatBinders (DictPat ds ms)	     = ds ++ ms
+collectTypedPatBinders any_other_pat	     = [ {-no binders-} ]
 \end{code}