2 % (c) The AQUA Project, Glasgow University, 1996
4 \section[DsHsSyn]{Haskell abstract syntax---added things for desugarer}
9 #include "HsVersions.h"
11 import HsSyn ( OutPat(..), MonoBinds(..),
12 HsExpr, GRHSsAndBinds, Match, HsLit )
13 import TcHsSyn ( TypecheckedPat,
14 TypecheckedMonoBinds )
16 import Id ( idType, Id )
18 import TysWiredIn ( mkListTy, mkTupleTy, unitTy )
22 Note: If @outPatType@ doesn't bear a strong resemblance to @coreExprType@,
23 then something is wrong.
25 outPatType :: TypecheckedPat -> Type
27 outPatType (WildPat ty) = ty
28 outPatType (VarPat var) = idType var
29 outPatType (LazyPat pat) = outPatType pat
30 outPatType (AsPat var pat) = idType var
31 outPatType (ConPat _ ty _) = ty
32 outPatType (ConOpPat _ _ _ ty) = ty
33 outPatType (ListPat ty _) = mkListTy ty
34 outPatType (TuplePat pats) = mkTupleTy (length pats) (map outPatType pats)
35 outPatType (RecPat _ ty _) = ty
36 outPatType (LitPat lit ty) = ty
37 outPatType (NPat lit ty _) = ty
38 outPatType (NPlusKPat _ _ ty _ _) = ty
39 outPatType (DictPat ds ms) = case (length ds_ms) of
41 1 -> idType (head ds_ms)
42 n -> mkTupleTy n (map idType ds_ms)
48 Nota bene: DsBinds relies on the fact that at least for simple
49 tuple patterns @collectTypedPatBinders@ returns the binders in
50 the same order as they appear in the tuple.
52 collectTypedBinders and collectedTypedPatBinders are the exportees.
55 collectTypedMonoBinders :: TypecheckedMonoBinds -> [Id]
56 collectTypedMonoBinders EmptyMonoBinds = []
57 collectTypedMonoBinders (PatMonoBind pat _ _) = collectTypedPatBinders pat
58 collectTypedMonoBinders (FunMonoBind f _ _ _) = [f]
59 collectTypedMonoBinders (VarMonoBind v _) = [v]
60 collectTypedMonoBinders (CoreMonoBind v _) = [v]
61 collectTypedMonoBinders (AndMonoBinds bs1 bs2)
62 = collectTypedMonoBinders bs1 ++ collectTypedMonoBinders bs2
63 collectTypedMonoBinders (AbsBinds _ _ exports _)
64 = [global | (_, global, local) <- exports]
66 collectTypedPatBinders :: TypecheckedPat -> [Id]
67 collectTypedPatBinders (VarPat var) = [var]
68 collectTypedPatBinders (LazyPat pat) = collectTypedPatBinders pat
69 collectTypedPatBinders (AsPat a pat) = a : collectTypedPatBinders pat
70 collectTypedPatBinders (ConPat _ _ pats) = concat (map collectTypedPatBinders pats)
71 collectTypedPatBinders (ConOpPat p1 _ p2 _) = collectTypedPatBinders p1 ++ collectTypedPatBinders p2
72 collectTypedPatBinders (ListPat t pats) = concat (map collectTypedPatBinders pats)
73 collectTypedPatBinders (TuplePat pats) = concat (map collectTypedPatBinders pats)
74 collectTypedPatBinders (RecPat _ _ fields) = concat (map (\ (f,pat,_) -> collectTypedPatBinders pat) fields)
75 collectTypedPatBinders (DictPat ds ms) = ds ++ ms
76 collectTypedPatBinders any_other_pat = [ {-no binders-} ]