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