ghc/compiler/deSugar/DsHsSyn.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1996
   3 %
   4 \section[DsHsSyn]{Haskell abstract syntax---added things for desugarer}
   5
   6 \begin{code}
   7 #include "HsVersions.h"
   8
   9 module DsHsSyn where
  10
  11 import Ubiq
  12
  13 import HsSyn            ( OutPat(..), HsBinds(..), Bind(..), MonoBinds(..),
  14                           Sig, HsExpr, GRHSsAndBinds, Match, HsLit )
  15 import TcHsSyn          ( TypecheckedPat(..), TypecheckedBind(..),
  16                           TypecheckedMonoBinds(..) )
  17
  18 import Id               ( idType )
  19 import PrelInfo         ( mkListTy, mkTupleTy, unitTy )
  20 import Util             ( panic )
  21 \end{code}
  22
  23 Note: If @outPatType@ doesn't bear a strong resemblance to @coreExprType@,
  24 then something is wrong.
  25 \begin{code}
  26 outPatType :: TypecheckedPat -> Type
  27
  28 outPatType (WildPat ty)         = ty
  29 outPatType (VarPat var)         = idType var
  30 outPatType (LazyPat pat)        = outPatType pat
  31 outPatType (AsPat var pat)      = idType var
  32 outPatType (ConPat _ ty _)      = ty
  33 outPatType (ConOpPat _ _ _ ty)  = ty
  34 outPatType (ListPat ty _)       = mkListTy ty
  35 outPatType (TuplePat pats)      = mkTupleTy (length pats) (map outPatType pats)
  36 outPatType (LitPat lit ty)      = ty
  37 outPatType (NPat lit ty _)      = ty
  38 outPatType (DictPat ds ms)      = case (length ds + length ms) of
  39                                     0 -> unitTy
  40                                     1 -> idType (head (ds ++ ms))
  41                                     n -> mkTupleTy n (map idType (ds ++ ms))
  42 \end{code}
  43
  44
  45 Nota bene: DsBinds relies on the fact that at least for simple
  46 tuple patterns @collectTypedPatBinders@ returns the binders in
  47 the same order as they appear in the tuple.
  48
  49 collectTypedBinders and collectedTypedPatBinders are the exportees.
  50
  51 \begin{code}
  52 collectTypedBinders :: TypecheckedBind -> [Id]
  53 collectTypedBinders EmptyBind       = []
  54 collectTypedBinders (NonRecBind bs) = collectTypedMonoBinders bs
  55 collectTypedBinders (RecBind    bs) = collectTypedMonoBinders bs
  56
  57 collectTypedMonoBinders :: TypecheckedMonoBinds -> [Id]
  58 collectTypedMonoBinders EmptyMonoBinds        = []
  59 collectTypedMonoBinders (PatMonoBind pat _ _) = collectTypedPatBinders pat
  60 collectTypedMonoBinders (FunMonoBind f _ _)   = [f]
  61 collectTypedMonoBinders (VarMonoBind v _)     = [v]
  62 collectTypedMonoBinders (AndMonoBinds bs1 bs2)
  63  = collectTypedMonoBinders bs1 ++ collectTypedMonoBinders bs2
  64
  65 collectTypedPatBinders :: TypecheckedPat -> [Id]
  66 collectTypedPatBinders (VarPat var)         = [var]
  67 collectTypedPatBinders (LazyPat pat)        = collectTypedPatBinders pat
  68 collectTypedPatBinders (AsPat a pat)        = a : collectTypedPatBinders pat
  69 collectTypedPatBinders (ConPat _ _ pats)    = concat (map collectTypedPatBinders pats)
  70 collectTypedPatBinders (ConOpPat p1 _ p2 _) = collectTypedPatBinders p1 ++ collectTypedPatBinders p2
  71 collectTypedPatBinders (ListPat t pats)     = concat (map collectTypedPatBinders pats)
  72 collectTypedPatBinders (TuplePat pats)      = concat (map collectTypedPatBinders pats)
  73 collectTypedPatBinders (DictPat ds ms)      = ds ++ ms
  74 collectTypedPatBinders any_other_pat        = [ {-no binders-} ]
  75 \end{code}