Commit 7d3f2dfc authored by Alan Zimmerman's avatar Alan Zimmerman Committed by Austin Seipp

PostTcType replaced with TypeAnnot

Summary:
This is a first step toward allowing generic traversals of the AST without 'landmines', by removing the `panic`s located throughout `placeHolderType`, `placeHolderKind` & co.

See more on the discussion at https://www.mail-archive.com/ghc-devs@haskell.org/msg05564.html

(This also makes a corresponding update to the `haddock` submodule.)

Test Plan: `sh validate` and new tests pass.

Reviewers: austin, simonpj, goldfire

Reviewed By: austin, simonpj, goldfire

Subscribers: edsko, Fuuzetsu, thomasw, holzensp, goldfire, simonmar, relrod, ezyang, carter

Projects: #ghc

Differential Revision: https://phabricator.haskell.org/D157
parent 7bf7ca2b
......@@ -220,7 +220,7 @@ check' ((n, EqnInfo { eqn_pats = ps, eqn_rhs = MatchResult can_fail _ }) : rs)
= ([], unitUniqSet n) -- One eqn, which can't fail
| first_eqn_all_vars && null rs -- One eqn, but it can fail
= ([(takeList ps (repeat nlWildPat),[])], unitUniqSet n)
= ([(takeList ps (repeat nlWildPatName),[])], unitUniqSet n)
| first_eqn_all_vars -- Several eqns, first can fail
= (pats, addOneToUniqSet indexs n)
......@@ -281,7 +281,8 @@ process_literals used_lits qs
default_eqns = ASSERT2( okGroup qs, pprGroup qs )
[remove_var q | q <- qs, is_var (firstPatN q)]
(pats',indexs') = check' default_eqns
pats_default = [(nlWildPat:ps,constraints) | (ps,constraints) <- (pats')] ++ pats
pats_default = [(nlWildPatName:ps,constraints) |
(ps,constraints) <- (pats')] ++ pats
indexs_default = unionUniqSets indexs' indexs
\end{code}
......@@ -326,9 +327,10 @@ nothing to do.
\begin{code}
first_column_only_vars :: [(EqnNo, EquationInfo)] -> ([ExhaustivePat],EqnSet)
first_column_only_vars qs = (map (\ (xs,ys) -> (nlWildPat:xs,ys)) pats,indexs)
where
(pats, indexs) = check' (map remove_var qs)
first_column_only_vars qs
= (map (\ (xs,ys) -> (nlWildPatName:xs,ys)) pats,indexs)
where
(pats, indexs) = check' (map remove_var qs)
\end{code}
This equation takes a matrix of patterns and split the equations by
......@@ -400,7 +402,8 @@ remove_first_column _ _ = panic "Check.remove_first_column: Not ConPatOut"
make_row_vars :: [HsLit] -> (EqnNo, EquationInfo) -> ExhaustivePat
make_row_vars used_lits (_, EqnInfo { eqn_pats = pats})
= (nlVarPat new_var:takeList (tail pats) (repeat nlWildPat),[(new_var,used_lits)])
= (nlVarPat new_var:takeList (tail pats) (repeat nlWildPatName)
,[(new_var,used_lits)])
where
new_var = hash_x
......@@ -411,7 +414,7 @@ hash_x = mkInternalName unboundKey {- doesn't matter much -}
make_row_vars_for_constructor :: (EqnNo, EquationInfo) -> [WarningPat]
make_row_vars_for_constructor (_, EqnInfo { eqn_pats = pats})
= takeList (tail pats) (repeat nlWildPat)
= takeList (tail pats) (repeat nlWildPatName)
compare_cons :: Pat Id -> Pat Id -> Bool
compare_cons (ConPatOut{ pat_con = L _ con1 }) (ConPatOut{ pat_con = L _ con2 })
......@@ -594,10 +597,14 @@ make_con (ConPatOut{ pat_con = L _ (RealDataCon id) }) (lp:lq:ps, constraints)
| isInfixCon id = (nlInfixConPat (getName id) lp lq : ps, constraints)
where q = unLoc lq
make_con (ConPatOut{ pat_con = L _ (RealDataCon id), pat_args = PrefixCon pats, pat_arg_tys = tys }) (ps, constraints)
| isTupleTyCon tc = (noLoc (TuplePat pats_con (tupleTyConBoxity tc) tys) : rest_pats, constraints)
| isPArrFakeCon id = (noLoc (PArrPat pats_con placeHolderType) : rest_pats, constraints)
| otherwise = (nlConPat name pats_con : rest_pats, constraints)
make_con (ConPatOut{ pat_con = L _ (RealDataCon id), pat_args = PrefixCon pats})
(ps, constraints)
| isTupleTyCon tc = (noLoc (TuplePat pats_con (tupleTyConBoxity tc) [])
: rest_pats, constraints)
| isPArrFakeCon id = (noLoc (PArrPat pats_con placeHolderType)
: rest_pats, constraints)
| otherwise = (nlConPatName name pats_con
: rest_pats, constraints)
where
name = getName id
(pats_con, rest_pats) = splitAtList pats ps
......@@ -612,11 +619,12 @@ make_con _ _ = panic "Check.make_con: Not ConPatOut"
-- representation
make_whole_con :: DataCon -> WarningPat
make_whole_con con | isInfixCon con = nlInfixConPat name nlWildPat nlWildPat
| otherwise = nlConPat name pats
make_whole_con con | isInfixCon con = nlInfixConPat name
nlWildPatName nlWildPatName
| otherwise = nlConPatName name pats
where
name = getName con
pats = [nlWildPat | _ <- dataConOrigArgTys con]
pats = [nlWildPatName | _ <- dataConOrigArgTys con]
\end{code}
------------------------------------------------------------------------
......@@ -745,7 +753,7 @@ tidy_con :: ConLike -> HsConPatDetails Id -> HsConPatDetails Id
tidy_con _ (PrefixCon ps) = PrefixCon (map tidy_lpat ps)
tidy_con _ (InfixCon p1 p2) = PrefixCon [tidy_lpat p1, tidy_lpat p2]
tidy_con con (RecCon (HsRecFields fs _))
| null fs = PrefixCon (replicate arity nlWildPat)
| null fs = PrefixCon (replicate arity nlWildPatId)
-- Special case for null patterns; maybe not a record at all
| otherwise = PrefixCon (map (tidy_lpat.snd) all_pats)
where
......@@ -755,7 +763,7 @@ tidy_con con (RecCon (HsRecFields fs _))
-- pad out all the missing fields with WildPats.
field_pats = case con of
RealDataCon dc -> map (\ f -> (f, nlWildPat)) (dataConFieldLabels dc)
RealDataCon dc -> map (\ f -> (f, nlWildPatId)) (dataConFieldLabels dc)
PatSynCon{} -> panic "Check.tidy_con: pattern synonym with record syntax"
all_pats = foldr (\(HsRecField id p _) acc -> insertNm (getName (unLoc id)) p acc)
field_pats fs
......
......@@ -676,7 +676,8 @@ makes all list literals be generated via the simple route.
\begin{code}
dsExplicitList :: PostTcType -> Maybe (SyntaxExpr Id) -> [LHsExpr Id] -> DsM CoreExpr
dsExplicitList :: PostTc Id Type -> Maybe (SyntaxExpr Id) -> [LHsExpr Id]
-> DsM CoreExpr
-- See Note [Desugaring explicit lists]
dsExplicitList elt_ty Nothing xs
= do { dflags <- getDynFlags
......
......@@ -280,6 +280,7 @@ Library
HsExpr
HsImpExp
HsLit
PlaceHolder
HsPat
HsSyn
HsTypes
......
......@@ -538,6 +538,7 @@ compiler_stage2_dll0_MODULES = \
HsExpr \
HsImpExp \
HsLit \
PlaceHolder \
HsPat \
HsSyn \
HsTypes \
......
......@@ -140,7 +140,7 @@ cvtDec (TH.ValD pat body ds)
; ds' <- cvtLocalDecs (ptext (sLit "a where clause")) ds
; returnL $ Hs.ValD $
PatBind { pat_lhs = pat', pat_rhs = GRHSs body' ds'
, pat_rhs_ty = void, bind_fvs = placeHolderNames
, pat_rhs_ty = placeHolderType, bind_fvs = placeHolderNames
, pat_ticks = (Nothing,[]) } }
cvtDec (TH.FunD nm cls)
......@@ -181,7 +181,8 @@ cvtDec (DataD ctxt tc tvs constrs derivs)
, dd_kindSig = Nothing
, dd_cons = cons', dd_derivs = derivs' }
; returnL $ TyClD (DataDecl { tcdLName = tc', tcdTyVars = tvs'
, tcdDataDefn = defn, tcdFVs = placeHolderNames }) }
, tcdDataDefn = defn
, tcdFVs = placeHolderNames }) }
cvtDec (NewtypeD ctxt tc tvs constr derivs)
= do { (ctxt', tc', tvs') <- cvt_tycl_hdr ctxt tc tvs
......@@ -192,7 +193,8 @@ cvtDec (NewtypeD ctxt tc tvs constr derivs)
, dd_kindSig = Nothing
, dd_cons = [con'], dd_derivs = derivs' }
; returnL $ TyClD (DataDecl { tcdLName = tc', tcdTyVars = tvs'
, tcdDataDefn = defn, tcdFVs = placeHolderNames }) }
, tcdDataDefn = defn
, tcdFVs = placeHolderNames }) }
cvtDec (ClassD ctxt cl tvs fds decs)
= do { (cxt', tc', tvs') <- cvt_tycl_hdr ctxt cl tvs
......@@ -248,7 +250,8 @@ cvtDec (DataInstD ctxt tc tys constrs derivs)
; returnL $ InstD $ DataFamInstD
{ dfid_inst = DataFamInstDecl { dfid_tycon = tc', dfid_pats = typats'
, dfid_defn = defn, dfid_fvs = placeHolderNames } }}
, dfid_defn = defn
, dfid_fvs = placeHolderNames } }}
cvtDec (NewtypeInstD ctxt tc tys constr derivs)
= do { (ctxt', tc', typats') <- cvt_tyinst_hdr ctxt tc tys
......@@ -260,7 +263,8 @@ cvtDec (NewtypeInstD ctxt tc tys constr derivs)
, dd_cons = [con'], dd_derivs = derivs' }
; returnL $ InstD $ DataFamInstD
{ dfid_inst = DataFamInstDecl { dfid_tycon = tc', dfid_pats = typats'
, dfid_defn = defn, dfid_fvs = placeHolderNames } }}
, dfid_defn = defn
, dfid_fvs = placeHolderNames } }}
cvtDec (TySynInstD tc eqn)
= do { tc' <- tconNameL tc
......@@ -327,7 +331,7 @@ cvt_tycl_hdr cxt tc tvs
cvt_tyinst_hdr :: TH.Cxt -> TH.Name -> [TH.Type]
-> CvtM ( LHsContext RdrName
, Located RdrName
, HsWithBndrs [LHsType RdrName])
, HsWithBndrs RdrName [LHsType RdrName])
cvt_tyinst_hdr cxt tc tys
= do { cxt' <- cvtContext cxt
; tc' <- tconNameL tc
......@@ -596,7 +600,9 @@ cvtl e = wrapL (cvt e)
cvt (ListE xs)
| Just s <- allCharLs xs = do { l' <- cvtLit (StringL s); return (HsLit l') }
-- Note [Converting strings]
| otherwise = do { xs' <- mapM cvtl xs; return $ ExplicitList void Nothing xs' }
| otherwise = do { xs' <- mapM cvtl xs
; return $ ExplicitList placeHolderType Nothing xs'
}
-- Infix expressions
cvt (InfixE (Just x) s (Just y)) = do { x' <- cvtl x; s' <- cvtl s; y' <- cvtl y
......@@ -734,7 +740,7 @@ cvtHsDo do_or_lc stmts
L loc (BodyStmt body _ _ _) -> return (L loc (mkLastStmt body))
_ -> failWith (bad_last last')
; return $ HsDo do_or_lc (stmts'' ++ [last'']) void }
; return $ HsDo do_or_lc (stmts'' ++ [last'']) placeHolderType }
where
bad_last stmt = vcat [ ptext (sLit "Illegal last statement of") <+> pprAStmtContext do_or_lc <> colon
, nest 2 $ Outputable.ppr stmt
......@@ -850,13 +856,16 @@ cvtp (ParensP p) = do { p' <- cvtPat p; return $ ParPat p' }
cvtp (TildeP p) = do { p' <- cvtPat p; return $ LazyPat p' }
cvtp (BangP p) = do { p' <- cvtPat p; return $ BangPat p' }
cvtp (TH.AsP s p) = do { s' <- vNameL s; p' <- cvtPat p; return $ AsPat s' p' }
cvtp TH.WildP = return $ WildPat void
cvtp TH.WildP = return $ WildPat placeHolderType
cvtp (RecP c fs) = do { c' <- cNameL c; fs' <- mapM cvtPatFld fs
; return $ ConPatIn c' $ Hs.RecCon (HsRecFields fs' Nothing) }
cvtp (ListP ps) = do { ps' <- cvtPats ps; return $ ListPat ps' void Nothing }
; return $ ConPatIn c'
$ Hs.RecCon (HsRecFields fs' Nothing) }
cvtp (ListP ps) = do { ps' <- cvtPats ps
; return $ ListPat ps' placeHolderType Nothing }
cvtp (SigP p t) = do { p' <- cvtPat p; t' <- cvtType t
; return $ SigPatIn p' (mkHsWithBndrs t') }
cvtp (ViewP e p) = do { e' <- cvtl e; p' <- cvtPat p; return $ ViewPat e' p' void }
cvtp (ViewP e p) = do { e' <- cvtl e; p' <- cvtPat p
; return $ ViewPat e' p' placeHolderType }
cvtPatFld :: (TH.Name, TH.Pat) -> CvtM (HsRecField RdrName (LPat RdrName))
cvtPatFld (s,p)
......@@ -1032,9 +1041,6 @@ overloadedLit (IntegerL _) = True
overloadedLit (RationalL _) = True
overloadedLit _ = False
void :: Type.Type
void = placeHolderType
cvtFractionalLit :: Rational -> FractionalLit
cvtFractionalLit r = FL { fl_text = show (fromRational r :: Double), fl_value = r }
......
......@@ -8,6 +8,11 @@ Datatype for: @BindGroup@, @Bind@, @Sig@, @Bind@.
\begin{code}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]
-- in module PlaceHolder
{-# LANGUAGE ConstraintKinds #-}
module HsBinds where
......@@ -16,7 +21,7 @@ import {-# SOURCE #-} HsExpr ( pprExpr, LHsExpr,
GRHSs, pprPatBind )
import {-# SOURCE #-} HsPat ( LPat )
import HsLit
import PlaceHolder ( PostTc,PostRn,DataId )
import HsTypes
import PprCore ()
import CoreSyn
......@@ -60,11 +65,13 @@ type HsLocalBinds id = HsLocalBindsLR id id
-- | Bindings in a 'let' expression
-- or a 'where' clause
data HsLocalBindsLR idL idR
data HsLocalBindsLR idL idR
= HsValBinds (HsValBindsLR idL idR)
| HsIPBinds (HsIPBinds idR)
| EmptyLocalBinds
deriving (Data, Typeable)
deriving (Typeable)
deriving instance (DataId idL, DataId idR)
=> Data (HsLocalBindsLR idL idR)
type HsValBinds id = HsValBindsLR id id
......@@ -83,7 +90,9 @@ data HsValBindsLR idL idR
| ValBindsOut
[(RecFlag, LHsBinds idL)]
[LSig Name]
deriving (Data, Typeable)
deriving (Typeable)
deriving instance (DataId idL, DataId idR)
=> Data (HsValBindsLR idL idR)
type LHsBind id = LHsBindLR id id
type LHsBinds id = LHsBindsLR id id
......@@ -124,7 +133,8 @@ data HsBindLR idL idR
-- type Int -> forall a'. a' -> a'
-- Notice that the coercion captures the free a'.
bind_fvs :: NameSet, -- ^ After the renamer, this contains the locally-bound
bind_fvs :: PostRn idL NameSet, -- ^ After the renamer, this contains
-- the locally-bound
-- free variables of this defn.
-- See Note [Bind free vars]
......@@ -134,11 +144,11 @@ data HsBindLR idL idR
-- | The pattern is never a simple variable;
-- That case is done by FunBind
| PatBind {
| PatBind {
pat_lhs :: LPat idL,
pat_rhs :: GRHSs idR (LHsExpr idR),
pat_rhs_ty :: PostTcType, -- ^ Type of the GRHSs
bind_fvs :: NameSet, -- ^ See Note [Bind free vars]
pat_rhs_ty :: PostTc idR Type, -- ^ Type of the GRHSs
bind_fvs :: PostRn idL NameSet, -- ^ See Note [Bind free vars]
pat_ticks :: (Maybe (Tickish Id), [Maybe (Tickish Id)])
-- ^ Tick to put on the rhs, if any, and ticks to put on
-- the bound variables.
......@@ -168,7 +178,10 @@ data HsBindLR idL idR
| PatSynBind (PatSynBind idL idR)
deriving (Data, Typeable)
deriving (Typeable)
deriving instance (DataId idL, DataId idR)
=> Data (HsBindLR idL idR)
-- Consider (AbsBinds tvs ds [(ftvs, poly_f, mono_f) binds]
--
-- Creates bindings for (polymorphic, overloaded) poly_f
......@@ -190,16 +203,15 @@ data ABExport id
} deriving (Data, Typeable)
data PatSynBind idL idR
= PSB { psb_id :: Located idL, -- ^ Name of the pattern synonym
psb_fvs :: NameSet, -- ^ See Note [Bind free vars]
= PSB { psb_id :: Located idL, -- ^ Name of the pattern synonym
psb_fvs :: PostRn idR NameSet, -- ^ See Note [Bind free vars]
psb_args :: HsPatSynDetails (Located idR), -- ^ Formal parameter names
psb_def :: LPat idR, -- ^ Right-hand side
psb_dir :: HsPatSynDir idR -- ^ Directionality
} deriving (Data, Typeable)
} deriving (Typeable)
deriving instance (DataId idL, DataId idR )
=> Data (PatSynBind idL idR)
-- | Used for the NameSet in FunBind and PatBind prior to the renamer
placeHolderNames :: NameSet
placeHolderNames = panic "placeHolderNames"
\end{code}
Note [AbsBinds]
......@@ -500,7 +512,8 @@ data HsIPBinds id
[LIPBind id]
TcEvBinds -- Only in typechecker output; binds
-- uses of the implicit parameters
deriving (Data, Typeable)
deriving (Typeable)
deriving instance (DataId id) => Data (HsIPBinds id)
isEmptyIPBinds :: HsIPBinds id -> Bool
isEmptyIPBinds (IPBinds is ds) = null is && isEmptyTcEvBinds ds
......@@ -514,7 +527,8 @@ that way until after type-checking when they are replaced with
evidene for the implicit parameter. -}
data IPBind id
= IPBind (Either HsIPName id) (LHsExpr id)
deriving (Data, Typeable)
deriving (Typeable)
deriving instance (DataId name) => Data (IPBind name)
instance (OutputableBndr id) => Outputable (HsIPBinds id) where
ppr (IPBinds bs ds) = pprDeeperList vcat (map ppr bs)
......@@ -543,7 +557,7 @@ serves for both.
type LSig name = Located (Sig name)
-- | Signatures and pragmas
data Sig name
data Sig name
= -- | An ordinary type signature
-- @f :: Num a => a -> a@
TypeSig [Located name] (LHsType name)
......@@ -605,7 +619,8 @@ data Sig name
-- > {-# MINIMAL a | (b, c | (d | e)) #-}
| MinimalSig (BooleanFormula (Located name))
deriving (Data, Typeable)
deriving (Typeable)
deriving instance (DataId name) => Data (Sig name)
type LFixitySig name = Located (FixitySig name)
......@@ -795,5 +810,6 @@ data HsPatSynDir id
= Unidirectional
| ImplicitBidirectional
| ExplicitBidirectional (MatchGroup id (LHsExpr id))
deriving (Data, Typeable)
deriving (Typeable)
deriving instance (DataId id) => Data (HsPatSynDir id)
\end{code}
This diff is collapsed.
This diff is collapsed.
\begin{code}
{-# LANGUAGE CPP, KindSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]
-- in module PlaceHolder
{-# LANGUAGE ConstraintKinds #-}
#if __GLASGOW_HASKELL__ > 706
{-# LANGUAGE RoleAnnotations #-}
#endif
module HsExpr where
import SrcLoc ( Located )
import Outputable ( SDoc, OutputableBndr, Outputable )
import {-# SOURCE #-} HsPat ( LPat )
import PlaceHolder ( DataId )
import Data.Data hiding ( Fixity )
import Data.Data
#if __GLASGOW_HASKELL__ > 706
type role HsExpr nominal
type role HsCmd nominal
type role MatchGroup nominal representational
type role GRHSs nominal representational
type role HsSplice nominal
#endif
data HsExpr (i :: *)
data HsCmd (i :: *)
data HsSplice (i :: *)
......@@ -27,11 +42,11 @@ instance Typeable2 MatchGroup
instance Typeable2 GRHSs
#endif
instance Data i => Data (HsSplice i)
instance Data i => Data (HsExpr i)
instance Data i => Data (HsCmd i)
instance (Data i, Data body) => Data (MatchGroup i body)
instance (Data i, Data body) => Data (GRHSs i body)
instance (DataId id) => Data (HsSplice id)
instance (DataId id) => Data (HsExpr id)
instance (DataId id) => Data (HsCmd id)
instance (Data body,DataId id) => Data (MatchGroup id body)
instance (Data body,DataId id) => Data (GRHSs id body)
instance OutputableBndr id => Outputable (HsExpr id)
instance OutputableBndr id => Outputable (HsCmd id)
......
......@@ -6,40 +6,32 @@
\begin{code}
{-# LANGUAGE CPP, DeriveDataTypeable #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]
-- in module PlaceHolder
{-# LANGUAGE ConstraintKinds #-}
module HsLit where
#include "HsVersions.h"
import {-# SOURCE #-} HsExpr( SyntaxExpr, pprExpr )
import BasicTypes ( FractionalLit(..) )
import Type ( Type, Kind )
import Type ( Type )
import Outputable
import FastString
import PlaceHolder ( PostTc,PostRn,DataId )
import Data.ByteString (ByteString)
import Data.Data
import Data.Data hiding ( Fixity )
\end{code}
%************************************************************************
%* *
\subsection{Annotating the syntax}
%* *
%************************************************************************
\begin{code}
type PostTcKind = Kind
type PostTcType = Type -- Used for slots in the abstract syntax
-- where we want to keep slot for a type
-- to be added by the type checker...but
-- before typechecking it's just bogus
placeHolderType :: PostTcType -- Used before typechecking
placeHolderType = panic "Evaluated the place holder for a PostTcType"
placeHolderKind :: PostTcKind -- Used before typechecking
placeHolderKind = panic "Evaluated the place holder for a PostTcKind"
\end{code}
%************************************************************************
%* *
......@@ -50,22 +42,24 @@ placeHolderKind = panic "Evaluated the place holder for a PostTcKind"
\begin{code}
data HsLit
= HsChar Char -- Character
| HsCharPrim Char -- Unboxed character
| HsString FastString -- String
| HsStringPrim ByteString -- Packed bytes
| HsInt Integer -- Genuinely an Int; arises from TcGenDeriv,
-- and from TRANSLATION
| HsIntPrim Integer -- literal Int#
| HsWordPrim Integer -- literal Word#
| HsInt64Prim Integer -- literal Int64#
| HsWord64Prim Integer -- literal Word64#
| HsInteger Integer Type -- Genuinely an integer; arises only from TRANSLATION
-- (overloaded literals are done with HsOverLit)
| HsRat FractionalLit Type -- Genuinely a rational; arises only from TRANSLATION
-- (overloaded literals are done with HsOverLit)
| HsFloatPrim FractionalLit -- Unboxed Float
| HsDoublePrim FractionalLit -- Unboxed Double
= HsChar Char -- Character
| HsCharPrim Char -- Unboxed character
| HsString FastString -- String
| HsStringPrim ByteString -- Packed bytes
| HsInt Integer -- Genuinely an Int; arises from
-- TcGenDeriv, and from TRANSLATION
| HsIntPrim Integer -- literal Int#
| HsWordPrim Integer -- literal Word#
| HsInt64Prim Integer -- literal Int64#
| HsWord64Prim Integer -- literal Word64#
| HsInteger Integer Type -- Genuinely an integer; arises only from
-- TRANSLATION (overloaded literals are
-- done with HsOverLit)
| HsRat FractionalLit Type -- Genuinely a rational; arises only from
-- TRANSLATION (overloaded literals are
-- done with HsOverLit)
| HsFloatPrim FractionalLit -- Unboxed Float
| HsDoublePrim FractionalLit -- Unboxed Double
deriving (Data, Typeable)
instance Eq HsLit where
......@@ -87,10 +81,11 @@ instance Eq HsLit where
data HsOverLit id -- An overloaded literal
= OverLit {
ol_val :: OverLitVal,
ol_rebindable :: Bool, -- Note [ol_rebindable]
ol_witness :: SyntaxExpr id, -- Note [Overloaded literal witnesses]
ol_type :: PostTcType }
deriving (Data, Typeable)
ol_rebindable :: PostRn id Bool, -- Note [ol_rebindable]
ol_witness :: SyntaxExpr id, -- Note [Overloaded literal witnesses]
ol_type :: PostTc id Type }
deriving (Typeable)
deriving instance (DataId id) => Data (HsOverLit id)
data OverLitVal
= HsIntegral !Integer -- Integer-looking literals;
......@@ -98,7 +93,7 @@ data OverLitVal
| HsIsString !FastString -- String-looking literals
deriving (Data, Typeable)
overLitType :: HsOverLit a -> Type
overLitType :: HsOverLit a -> PostTc a Type
overLitType = ol_type
\end{code}
......
......@@ -6,6 +6,12 @@
\begin{code}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]
-- in module PlaceHolder
{-# LANGUAGE ConstraintKinds #-}
module HsPat (
Pat(..), InPat, OutPat, LPat,
......@@ -28,6 +34,7 @@ import {-# SOURCE #-} HsExpr (SyntaxExpr, LHsExpr, HsSplice, pprLExpr
-- friends:
import HsBinds
import HsLit
import PlaceHolder ( PostTc,DataId )
import HsTypes
import TcEvidence
import BasicTypes
......@@ -43,7 +50,7 @@ import Type
import SrcLoc
import FastString
-- libraries:
import Data.Data hiding (TyCon)
import Data.Data hiding (TyCon,Fixity)
import Data.Maybe
\end{code}
......@@ -56,7 +63,7 @@ type LPat id = Located (Pat id)
data Pat id
= ------------ Simple patterns ---------------
WildPat PostTcType -- Wild card
WildPat (PostTc id Type) -- Wild card
-- The sole reason for a type on a WildPat is to
-- support hsPatType :: Pat Id -> Type
......@@ -69,17 +76,17 @@ data Pat id
------------ Lists, tuples, arrays ---------------
| ListPat [LPat id] -- Syntactic list
PostTcType -- The type of the elements
(Maybe (PostTcType, SyntaxExpr id)) -- For rebindable syntax
(PostTc id Type) -- The type of the elements
(Maybe (PostTc id Type, SyntaxExpr id)) -- For rebindable syntax
-- For OverloadedLists a Just (ty,fn) gives
-- overall type of the pattern, and the toList
-- function to convert the scrutinee to a list value
| TuplePat [LPat id] -- Tuple sub-patterns
Boxity -- UnitPat is TuplePat []
[PostTcType] -- [] before typechecker, filled in afterwards with
-- the types of the tuple components
-- You might think that the PostTcType was redundant, because we can
| TuplePat [LPat id] -- Tuple sub-patterns
Boxity -- UnitPat is TuplePat []
[PostTc id Type] -- [] before typechecker, filled in afterwards
-- with the types of the tuple components
-- You might think that the PostTc id Type was redundant, because we can
-- get the pattern type by getting the types of the sub-patterns.
-- But it's essential
-- data T a where
......@@ -96,7 +103,7 @@ data Pat id
-- will be wrapped in CoPats, no?)
| PArrPat [LPat id] -- Syntactic parallel array
PostTcType -- The type of the elements
(PostTc id Type) -- The type of the elements
------------ Constructor patterns ---------------
| ConPatIn (Located id)
......@@ -121,7 +128,7 @@ data Pat id
------------ View patterns ---------------
| ViewPat (LHsExpr id)
(LPat id)
PostTcType -- The overall type of the pattern
(PostTc id Type) -- The overall type of the pattern
-- (= the argument type of the view function)
-- for hsPatType.
......@@ -149,8 +156,9 @@ data Pat id
(SyntaxExpr id) -- Name of '-' (see RnEnv.lookupSyntaxName)
------------ Pattern type signatures ---------------
| SigPatIn (LPat id) -- Pattern with a type signature
(HsWithBndrs (LHsType id)) -- Signature can bind both kind and type vars
| SigPatIn (LPat id) -- Pattern with a type signature
(HsWithBndrs id (LHsType id)) -- Signature can bind both
-- kind and type vars
| SigPatOut (LPat id) -- Pattern with a type signature
Type
......@@ -162,7 +170,8 @@ data Pat id
Type -- Type of whole pattern, t1
-- During desugaring a (CoPat co pat) turns into a cast with 'co' on
-- the scrutinee, followed by a match on 'pat'
deriving (Data, Typeable)
deriving (Typeable)
deriving instance (DataId id) => Data (Pat id)
\end{code}
HsConDetails is use for patterns/expressions *and* for data type declarations
......
\begin{code}
{-# LANGUAGE CPP, KindSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]
-- in module PlaceHolder
{-# LANGUAGE ConstraintKinds #-}
#if __GLASGOW_HASKELL__ > 706
{-# LANGUAGE RoleAnnotations #-}
#endif
module HsPat where
import SrcLoc( Located )
import Data.Data
import Data.Data hiding (Fixity)
import Outputable
import PlaceHolder ( DataId )
#if __GLASGOW_HASKELL__ > 706
type role Pat nominal
#endif
data Pat (i :: *)
type LPat i = Located (Pat i)
......@@ -16,6 +27,6 @@ instance Typeable Pat
instance Typeable1 Pat
#endif
instance Data i => Data (Pat i)
instance (DataId id) => Data (Pat id)
instance (OutputableBndr name) => Outputable (Pat name)
\end{code}
......@@ -10,6 +10,11 @@ therefore, is almost nothing but re-exporting.
\begin{code}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]
-- in module PlaceHolder
{-# LANGUAGE ConstraintKinds #-}
module HsSyn (
module HsBinds,
......@@ -21,6 +26,7 @@ module HsSyn (
module HsTypes,
module HsUtils,
module HsDoc,
module PlaceHolder,
Fixity,
HsModule(..)
......@@ -32,6 +38,7 @@ import HsBinds
import HsExpr
import HsImpExp
import HsLit
import PlaceHolder
import HsPat
import HsTypes
import BasicTypes ( Fixity, WarningTxt )
......@@ -75,7 +82,8 @@ data HsModule name
-- ^ reason\/explanation for warning/deprecation of this module
hsmodHaddockModHeader :: Maybe LHsDocString
-- ^ Haddock module info and description, unparsed
} deriving (Data, Typeable)
} deriving (Typeable)
deriving instance (DataId name) => Data (HsModule name)
\end{code}
......
......@@ -7,6 +7,13 @@ HsTypes: Abstract syntax: user-defined types
\begin{code}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]
-- in module PlaceHolder
{-# LANGUAGE ConstraintKinds #-}
module HsTypes (
HsType(..), LHsType, HsKind, LHsKind,
......@@ -40,7 +47,7 @@ module HsTypes (
import {-# SOURCE #-} HsExpr ( HsSplice, pprUntypedSplice )
import HsLit
import PlaceHolder ( PostTc,PostRn,DataId,PlaceHolder(..) )
import Name( Name )
import RdrName( RdrName )
......@@ -54,7 +61,7 @@ import StaticFlags
import Outputable
import FastString
import Data.Data
import Data.Data hiding ( Fixity )
\end{code}
......@@ -131,17 +138,18 @@ type LHsKind name = Located (HsKind name)
type LHsTyVarBndr name = Located (HsTyVarBndr name)
</