[project @ 2001-07-12 16:21:22 by simonpj]

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

diff --git a/ghc/compiler/deSugar/DsHsSyn.lhs b/ghc/compiler/deSugar/DsHsSyn.lhs
index 43bb8c7..9eee750 100644 (file)
--- a/ghc/compiler/deSugar/DsHsSyn.lhs
+++ b/ghc/compiler/deSugar/DsHsSyn.lhs
@@ -13,64 +13,6 @@ import TcHsSyn               ( TypecheckedPat,
                          TypecheckedMonoBinds )
 
 import Id              ( idType, Id )
-import TcType           ( Type )
-import TysWiredIn      ( mkListTy, mkTupleTy, unitTy )
-import BasicTypes      ( Boxity(..) )
+import Type            ( Type )
 \end{code}
 
-Note: If @outPatType@ doesn't bear a strong resemblance to @exprType@,
-then something is wrong.
-\begin{code}
-outPatType :: TypecheckedPat -> Type
-
-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 (ListPat ty _)      = mkListTy ty
-outPatType (TuplePat pats box) = mkTupleTy box (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)
-                                   n -> mkTupleTy Boxed n (map idType ds_ms)
-                                  where
-                                   ds_ms = ds ++ ms
-\end{code}
-
-
-Nota bene: @DsBinds@ relies on the fact that at least for simple
-tuple patterns @collectTypedPatBinders@ returns the binders in
-the same order as they appear in the tuple.
-
-@collectTypedBinders@ and @collectedTypedPatBinders@ are the exportees.
-
-\begin{code}
-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 (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 (NPlusKPat var _ _ _ _) = [var]
-collectTypedPatBinders any_other_pat          = [ {-no binders-} ]
-\end{code}