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 IMP_Ubiq()
  12
  13 import HsSyn            ( OutPat(..), HsBinds(..), Bind(..), MonoBinds(..),
  14                           Sig, HsExpr, GRHSsAndBinds, Match, HsLit )
  15 import TcHsSyn          ( SYN_IE(TypecheckedPat), SYN_IE(TypecheckedBind),
  16                           SYN_IE(TypecheckedMonoBinds) )
  17
  18 import Id               ( idType )
  19 import TysWiredIn       ( 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 (RecPat _ ty _)      = ty
  37 outPatType (LitPat lit ty)      = ty
  38 outPatType (NPat lit ty _)      = ty
  39 outPatType (NPlusKPat _ _ ty _ _) = ty
  40 outPatType (DictPat ds ms)      = case (length ds_ms) of
  41                                     0 -> unitTy
  42                                     1 -> idType (head ds_ms)
  43                                     n -> mkTupleTy n (map idType ds_ms)
  44                                    where
  45                                     ds_ms = ds ++ ms
  46 \end{code}
  47
  48
  49 Nota bene: DsBinds relies on the fact that at least for simple
  50 tuple patterns @collectTypedPatBinders@ returns the binders in
  51 the same order as they appear in the tuple.
  52
  53 collectTypedBinders and collectedTypedPatBinders are the exportees.
  54
  55 \begin{code}
  56 collectTypedBinders :: TypecheckedBind -> [Id]
  57 collectTypedBinders EmptyBind       = []
  58 collectTypedBinders (NonRecBind bs) = collectTypedMonoBinders bs
  59 collectTypedBinders (RecBind    bs) = collectTypedMonoBinders bs
  60
  61 collectTypedMonoBinders :: TypecheckedMonoBinds -> [Id]
  62 collectTypedMonoBinders EmptyMonoBinds        = []
  63 collectTypedMonoBinders (PatMonoBind pat _ _) = collectTypedPatBinders pat
  64 collectTypedMonoBinders (FunMonoBind f _ _ _) = [f]
  65 collectTypedMonoBinders (VarMonoBind v _)     = [v]
  66 collectTypedMonoBinders (CoreMonoBind v _)     = [v]
  67 collectTypedMonoBinders (AndMonoBinds bs1 bs2)
  68  = collectTypedMonoBinders bs1 ++ collectTypedMonoBinders bs2
  69
  70 collectTypedPatBinders :: TypecheckedPat -> [Id]
  71 collectTypedPatBinders (VarPat var)         = [var]
  72 collectTypedPatBinders (LazyPat pat)        = collectTypedPatBinders pat
  73 collectTypedPatBinders (AsPat a pat)        = a : collectTypedPatBinders pat
  74 collectTypedPatBinders (ConPat _ _ pats)    = concat (map collectTypedPatBinders pats)
  75 collectTypedPatBinders (ConOpPat p1 _ p2 _) = collectTypedPatBinders p1 ++ collectTypedPatBinders p2
  76 collectTypedPatBinders (ListPat t pats)     = concat (map collectTypedPatBinders pats)
  77 collectTypedPatBinders (TuplePat pats)      = concat (map collectTypedPatBinders pats)
  78 collectTypedPatBinders (RecPat _ _ fields)  = concat (map (\ (f,pat,_) -> collectTypedPatBinders pat) fields)
  79 collectTypedPatBinders (DictPat ds ms)      = ds ++ ms
  80 collectTypedPatBinders any_other_pat        = [ {-no binders-} ]
  81 \end{code}