+++ /dev/null
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1994
-%
-\section[PatSyntax]{Abstract Haskell syntax---patterns}
-
-\begin{code}
-#include "HsVersions.h"
-
-module HsPat where
-
-import AbsPrel ( mkTupleTy, mkListTy
- IF_ATTACK_PRAGMAS(COMMA tagOf_PrimOp)
- IF_ATTACK_PRAGMAS(COMMA pprPrimOp)
-#ifdef DPH
- , mkProcessorTy
-#endif
- )
-import AbsUniType
-import HsLit ( Literal )
-import HsExpr ( Expr, TypecheckedExpr(..) )
-import Id
-import IdInfo
-import Maybes ( maybeToBool, Maybe(..) )
-import Name ( Name )
-import ProtoName ( ProtoName(..) ) -- .. for pragmas only
-import Outputable
-import Pretty
-import Unique ( Unique )
-import Util
-\end{code}
-
-Patterns come in distinct before- and after-typechecking flavo(u)rs.
-\begin{code}
-data InPat name
- = WildPatIn --X wild card
- | VarPatIn name --X variable
- | LitPatIn Literal -- literal
- | LazyPatIn (InPat name) --X lazy pattern
- | AsPatIn name --X as pattern
- (InPat name)
- | ConPatIn name --X constructed type
- [(InPat name)]
- | ConOpPatIn (InPat name)
- name
- (InPat name)
- | ListPatIn [InPat name] --X syntactic list
- -- must have >= 1 elements
- | TuplePatIn [InPat name] --X tuple
- -- UnitPat is TuplePat []
- | NPlusKPatIn name -- n+k pattern
- Literal
-#ifdef DPH
- | ProcessorPatIn [(InPat name)]
- (InPat name) -- (|pat1,...,patK;pat|)
-#endif {- Data Parallel Haskell -}
-
-type ProtoNamePat = InPat ProtoName
-type RenamedPat = InPat Name
-
-data TypecheckedPat
- = WildPat UniType -- wild card
-
- | VarPat Id -- variable (type is in the Id)
-
- | LazyPat TypecheckedPat -- lazy pattern
-
- | AsPat Id -- as pattern
- TypecheckedPat
-
- | ConPat Id -- constructed type;
- UniType -- the type of the pattern
- [TypecheckedPat]
-
- | ConOpPat TypecheckedPat -- just a special case...
- Id
- TypecheckedPat
- UniType
- | ListPat -- syntactic list
- UniType -- the type of the elements
- [TypecheckedPat]
-
- | TuplePat [TypecheckedPat] -- tuple
- -- UnitPat is TuplePat []
-
- | LitPat -- Used for *non-overloaded* literal patterns:
- -- Int#, Char#, Int, Char, String, etc.
- Literal
- UniType -- type of pattern
-
- | NPat -- Used for *overloaded* literal patterns
- Literal -- the literal is retained so that
- -- the desugarer can readily identify
- -- equations with identical literal-patterns
- UniType -- type of pattern, t
- TypecheckedExpr -- Of type t -> Bool; detects match
-
- | NPlusKPat Id
- Literal -- Same reason as for LitPat
- -- (This could be an Integer, but then
- -- it's harder to partitionEqnsByLit
- -- in the desugarer.)
- UniType -- Type of pattern, t
- TypecheckedExpr -- "fromInteger literal"; of type t
- TypecheckedExpr -- Of type t-> t -> Bool; detects match
- TypecheckedExpr -- Of type t -> t -> t; subtracts k
-#ifdef DPH
- | ProcessorPat
- [TypecheckedPat] -- Typechecked Pattern
- [TypecheckedExpr] -- Of type t-> Integer; conversion
- TypecheckedPat -- Data at that processor
-#endif {- Data Parallel Haskell -}
-\end{code}
-
-Note: If @typeOfPat@ doesn't bear a strong resemblance to @typeOfCoreExpr@,
-then something is wrong.
-\begin{code}
-typeOfPat :: TypecheckedPat -> UniType
-typeOfPat (WildPat ty) = ty
-typeOfPat (VarPat var) = getIdUniType var
-typeOfPat (LazyPat pat) = typeOfPat pat
-typeOfPat (AsPat var pat) = getIdUniType var
-typeOfPat (ConPat _ ty _) = ty
-typeOfPat (ConOpPat _ _ _ ty) = ty
-typeOfPat (ListPat ty _) = mkListTy ty
-typeOfPat (TuplePat pats) = mkTupleTy (length pats) (map typeOfPat pats)
-typeOfPat (LitPat lit ty) = ty
-typeOfPat (NPat lit ty _) = ty
-typeOfPat (NPlusKPat n k ty _ _ _) = ty
-#ifdef DPH
--- Should be more efficient to find type of pid than pats
-typeOfPat (ProcessorPat pats _ pat)
- = mkProcessorTy (map typeOfPat pats) (typeOfPat pat)
-#endif {- Data Parallel Haskell -}
-\end{code}
-
-\begin{code}
-instance (NamedThing name) => NamedThing (InPat name) where
- hasType pat = False
-#ifdef DEBUG
- getExportFlag = panic "NamedThing.InPat.getExportFlag"
- isLocallyDefined = panic "NamedThing.InPat.isLocallyDefined"
- getOrigName = panic "NamedThing.InPat.getOrigName"
- getOccurrenceName = panic "NamedThing.InPat.getOccurrenceName"
- getInformingModules = panic "NamedThing.InPat.getOccurrenceName"
- getSrcLoc = panic "NamedThing.InPat.getSrcLoc"
- getTheUnique = panic "NamedThing.InPat.getTheUnique"
- getType pat = panic "NamedThing.InPat.getType"
- fromPreludeCore = panic "NamedThing.InPat.fromPreludeCore"
-#endif
-
-instance NamedThing TypecheckedPat where
- hasType pat = True
- getType = typeOfPat
-#ifdef DEBUG
- getExportFlag = panic "NamedThing.TypecheckedPat.getExportFlag"
- isLocallyDefined = panic "NamedThing.TypecheckedPat.isLocallyDefined"
- getOrigName = panic "NamedThing.TypecheckedPat.getOrigName"
- getOccurrenceName = panic "NamedThing.TypecheckedPat.getOccurrenceName"
- getInformingModules = panic "NamedThing.TypecheckedPat.getOccurrenceName"
- getSrcLoc = panic "NamedThing.TypecheckedPat.getSrcLoc"
- getTheUnique = panic "NamedThing.TypecheckedPat.getTheUnique"
- fromPreludeCore = panic "NamedThing.TypecheckedPat.fromPreludeCore"
-#endif
-\end{code}
-
-\begin{code}
-instance (Outputable name) => Outputable (InPat name) where
- ppr = pprInPat
-
-pprInPat :: (Outputable name) => PprStyle -> InPat name -> Pretty
-pprInPat sty (WildPatIn) = ppStr "_"
-pprInPat sty (VarPatIn var) = ppr sty var
-pprInPat sty (LitPatIn s) = ppr sty s
-pprInPat sty (LazyPatIn pat) = ppBeside (ppChar '~') (ppr sty pat)
-pprInPat sty (AsPatIn name pat)
- = ppBesides [ppLparen, ppr sty name, ppChar '@', ppr sty pat, ppRparen]
-
-pprInPat sty (ConPatIn c pats)
- = if null pats then
- ppr sty c
- else
- ppBesides [ppLparen, ppr sty c, ppSP, interppSP sty pats, ppRparen]
-
-
-pprInPat sty (ConOpPatIn pat1 op pat2)
- = ppBesides [ppLparen, ppr sty pat1, ppSP, ppr sty op, ppSP, ppr sty pat2, ppRparen]
-
--- ToDo: use pprOp to print op (but this involves fiddling various
--- contexts & I'm lazy...); *PatIns are *rarely* printed anyway... (WDP)
-
-pprInPat sty (ListPatIn pats)
- = ppBesides [ppLbrack, interpp'SP sty pats, ppRbrack]
-pprInPat sty (TuplePatIn pats)
- = ppBesides [ppLparen, interpp'SP sty pats, ppRparen]
-pprInPat sty (NPlusKPatIn n k)
- = ppBesides [ppLparen, ppr sty n, ppChar '+', ppr sty k, ppRparen]
-#ifdef DPH
-pprInPat sty (ProcessorPatIn pats pat)
- = ppBesides [ppStr "(|", interpp'SP sty pats,ppSemi ,
- ppr sty pat , ppStr "|)"]
-#endif {- Data Parallel Haskell -}
-\end{code}
-
-Problems with @Outputable@ instance for @TypecheckedPat@ when no
-original names.
-\begin{code}
-instance Outputable TypecheckedPat where
- ppr = pprTypecheckedPat
-\end{code}
-
-\begin{code}
-pprTypecheckedPat sty (WildPat ty) = ppChar '_'
-pprTypecheckedPat sty (VarPat var) = ppr sty var
-pprTypecheckedPat sty (LazyPat pat) = ppBesides [ppChar '~', ppr sty pat]
-pprTypecheckedPat sty (AsPat name pat)
- = ppBesides [ppLparen, ppr sty name, ppChar '@', ppr sty pat, ppRparen]
-
-pprTypecheckedPat sty (ConPat name ty [])
- = ppBeside (ppr sty name)
- (ifPprShowAll sty (pprConPatTy sty ty))
-
-pprTypecheckedPat sty (ConPat name ty pats)
- = ppBesides [ppLparen, ppr sty name, ppSP,
- interppSP sty pats, ppRparen,
- ifPprShowAll sty (pprConPatTy sty ty) ]
-
-pprTypecheckedPat sty (ConOpPat pat1 op pat2 ty)
- = ppBesides [ppLparen, ppr sty pat1, ppSP, pprOp sty op, ppSP, ppr sty pat2, ppRparen]
-
-pprTypecheckedPat sty (ListPat ty pats)
- = ppBesides [ppLbrack, interpp'SP sty pats, ppRbrack]
-pprTypecheckedPat sty (TuplePat pats)
- = ppBesides [ppLparen, interpp'SP sty pats, ppRparen]
-
-pprTypecheckedPat sty (LitPat l ty) = ppr sty l -- ToDo: print more
-pprTypecheckedPat sty (NPat l ty e) = ppr sty l -- ToDo: print more
-
-pprTypecheckedPat sty (NPlusKPat n k ty e1 e2 e3)
- = case sty of
- PprForUser -> basic_ppr
- _ -> ppHang basic_ppr 4 exprs_ppr
- where
- basic_ppr = ppBesides [ppLparen, ppr sty n, ppChar '+', ppr sty k, ppRparen]
- exprs_ppr = ppSep [ ppBeside (ppStr "{- ") (ppr sty ty),
- ppr sty e1, ppr sty e2,
- ppBeside (ppr sty e3) (ppStr " -}")]
-#ifdef DPH
-pprTypecheckedPat sty (ProcessorPat pats convs pat)
- = case sty of
- PprForUser -> basic_ppr
- _ -> ppHang basic_ppr 4 exprs_ppr
- where
- basic_ppr = ppBesides [ppStr "(|", interpp'SP sty pats,ppSemi ,
- ppr sty pat , ppStr "|)"]
- exprs_ppr = ppBesides [ppStr "{- " ,
- ppr sty convs,
- ppStr " -}"]
-#endif {- Data Parallel Haskell -}
-
-pprConPatTy :: PprStyle -> UniType -> Pretty
-pprConPatTy sty ty
- = ppBesides [ppLparen, ppr sty ty, ppRparen]
-\end{code}
-
-%************************************************************************
-%* *
-%* predicates for checking things about pattern-lists in EquationInfo *
-%* *
-%************************************************************************
-\subsection[Pat-list-predicates]{Look for interesting things in patterns}
-
-Unlike in the Wadler chapter, where patterns are either ``variables''
-or ``constructors,'' here we distinguish between:
-\begin{description}
-\item[unfailable:]
-Patterns that cannot fail to match: variables, wildcards, and lazy
-patterns.
-
-These are the irrefutable patterns; the two other categories
-are refutable patterns.
-
-\item[constructor:]
-A non-literal constructor pattern (see next category).
-
-\item[literal (including n+k patterns):]
-At least the numeric ones may be overloaded.
-\end{description}
-
-A pattern is in {\em exactly one} of the above three categories; `as'
-patterns are treated specially, of course.
-
-\begin{code}
-unfailablePats :: [TypecheckedPat] -> Bool
-unfailablePats pat_list = all unfailablePat pat_list
-
-unfailablePat (AsPat _ pat) = unfailablePat pat
-unfailablePat (WildPat _) = True
-unfailablePat (VarPat _) = True
-unfailablePat (LazyPat _) = True
-unfailablePat other = False
-
-patsAreAllCons :: [TypecheckedPat] -> Bool
-patsAreAllCons pat_list = all isConPat pat_list
-
-isConPat (AsPat _ pat) = isConPat pat
-isConPat (ConPat _ _ _) = True
-isConPat (ConOpPat _ _ _ _) = True
-isConPat (ListPat _ _) = True
-isConPat (TuplePat _) = True
-#ifdef DPH
-isConPat (ProcessorPat _ _ _) = True
-
-#endif {- Data Parallel Haskell -}
-isConPat other = False
-
-patsAreAllLits :: [TypecheckedPat] -> Bool
-patsAreAllLits pat_list = all isLitPat pat_list
-
-isLitPat (AsPat _ pat) = isLitPat pat
-isLitPat (LitPat _ _) = True
-isLitPat (NPat _ _ _) = True
-isLitPat (NPlusKPat _ _ _ _ _ _)= True
-isLitPat other = False
-
-#ifdef DPH
-patsAreAllProcessor :: [TypecheckedPat] -> Bool
-patsAreAllProcessor pat_list = all isProcessorPat pat_list
- where
- isProcessorPat (ProcessorPat _ _ _) = True
- isProcessorPat _ = False
-#endif
-\end{code}
-
-\begin{code}
--- A pattern is irrefutable if a match on it cannot fail
--- (at any depth)
-irrefutablePat :: TypecheckedPat -> Bool
-
-irrefutablePat (WildPat _) = True
-irrefutablePat (VarPat _) = True
-irrefutablePat (LazyPat _) = True
-irrefutablePat (AsPat _ pat) = irrefutablePat pat
-irrefutablePat (ConPat con tys pats) = all irrefutablePat pats && only_con con
-irrefutablePat (ConOpPat pat1 con pat2 _) = irrefutablePat pat1 && irrefutablePat pat1 && only_con con
-irrefutablePat (ListPat _ _) = False
-irrefutablePat (TuplePat pats) = all irrefutablePat pats
-irrefutablePat other_pat = False -- Literals, NPlusK, NPat
-
-only_con con = maybeToBool (maybeSingleConstructorTyCon tycon)
- where
- (_,_,_, tycon) = getDataConSig con
-\end{code}
projects / ghc-hetmet.git / blobdiff