[project @ 1996-06-30 15:56:44 by partain]

[ghc-hetmet.git] / ghc / compiler / deSugar / DsHsSyn.lhs

diff --git a/ghc/compiler/deSugar/DsHsSyn.lhs b/ghc/compiler/deSugar/DsHsSyn.lhs
index 3adfab1..08288bd 100644 (file)
--- a/ghc/compiler/deSugar/DsHsSyn.lhs
+++ b/ghc/compiler/deSugar/DsHsSyn.lhs
@@ -8,15 +8,15 @@
 
 module DsHsSyn where
 
-import Ubiq
+IMP_Ubiq()
 
 import HsSyn           ( OutPat(..), HsBinds(..), Bind(..), MonoBinds(..),
                          Sig, HsExpr, GRHSsAndBinds, Match, HsLit )
-import TcHsSyn         ( TypecheckedPat(..), TypecheckedBind(..), 
-                         TypecheckedMonoBinds(..) )
+import TcHsSyn         ( SYN_IE(TypecheckedPat), SYN_IE(TypecheckedBind), 
+                         SYN_IE(TypecheckedMonoBinds) )
 
 import Id              ( idType )
-import PrelInfo                ( mkListTy, mkTupleTy, unitTy )
+import TysWiredIn      ( mkListTy, mkTupleTy, unitTy )
 import Util            ( panic )
 \end{code}
 
@@ -33,12 +33,15 @@ outPatType (ConPat _ ty _)  = ty
 outPatType (ConOpPat _ _ _ ty) = ty
 outPatType (ListPat ty _)      = mkListTy ty
 outPatType (TuplePat pats)     = mkTupleTy (length pats) (map outPatType pats)
+outPatType (RecPat _ ty _)      = ty
 outPatType (LitPat lit ty)     = ty
 outPatType (NPat lit ty _)     = ty
-outPatType (DictPat ds ms)      = case (length ds + length ms) of
+outPatType (DictPat ds ms)      = case (length ds_ms) of
                                    0 -> unitTy
-                                   1 -> idType (head (ds ++ ms))
-                                   n -> mkTupleTy n (map idType (ds ++ ms))
+                                   1 -> idType (head ds_ms)
+                                   n -> mkTupleTy n (map idType ds_ms)
+                                  where
+                                   ds_ms = ds ++ ms
 \end{code}
 
 
@@ -70,6 +73,7 @@ collectTypedPatBinders (ConPat _ _ pats)    = concat (map collectTypedPatBinders
 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-} ]
 \end{code}