HsTypes: Abstract syntax: user-defined types
\begin{code}
+{-# LANGUAGE DeriveDataTypeable #-}
+
module HsTypes (
HsType(..), LHsType,
HsTyVarBndr(..), LHsTyVarBndr,
hsTyVarKind, hsTyVarNameKind,
hsLTyVarName, hsLTyVarNames, hsLTyVarLocName, hsLTyVarLocNames,
splitHsInstDeclTy, splitHsFunType,
+ splitHsAppTys, mkHsAppTys,
-- Type place holder
PostTcType, placeHolderType, PostTcKind, placeHolderKind,
import StaticFlags
import Outputable
import FastString
+
+import Data.Data
\end{code}
id -- The quasi-quoter
SrcSpan -- The span of the enclosed string
FastString -- The enclosed string
+ deriving (Data, Typeable)
instance OutputableBndr id => Outputable (HsQuasiQuote id) where
ppr = ppr_qq
type LBangType name = Located (BangType name)
type BangType name = HsType name -- Bangs are in the HsType data type
-data HsBang = HsNoBang -- Only used as a return value for getBangStrictness,
- -- never appears on a HsBangTy
- | HsStrict -- !
- | HsUnbox -- {-# UNPACK #-} ! (GHC extension, meaning "unbox")
-
-instance Outputable HsBang where
- ppr (HsNoBang) = empty
- ppr (HsStrict) = char '!'
- ppr (HsUnbox) = ptext (sLit "!!")
-
getBangType :: LHsType a -> LHsType a
getBangType (L _ (HsBangTy _ ty)) = ty
getBangType ty = ty
data HsPred name = HsClassP name [LHsType name] -- class constraint
| HsEqualP (LHsType name) (LHsType name)-- equality constraint
| HsIParam (IPName name) (LHsType name)
+ deriving (Data, Typeable)
type LHsType name = Located (HsType name)
| HsPArrTy (LHsType name) -- Elem. type of parallel array: [:t:]
+ | HsModalBoxType name (LHsType name) -- modal types; first argument is the environment classifier
+
| HsTupleTy Boxity
[LHsType name] -- Element types (length gives arity)
-- interface files smaller), so when printing a HsType we may need to
-- add parens.
- | HsNumTy Integer -- Generics only
-
| HsPredTy (HsPred name) -- Only used in the type of an instance
-- declaration, eg. Eq [a] -> Eq a
-- ^^^^
-- HsPredTy
-- Note no need for location info on the
- -- enclosed HsPred; the one on the type will do
+ -- Enclosed HsPred; the one on the type will do
| HsKindSig (LHsType name) -- (ty :: kind)
Kind -- A type with a kind signature
| HsBangTy HsBang (LHsType name) -- Bang-style type annotations
| HsRecTy [ConDeclField name] -- Only in data type declarations
-data HsExplicitFlag = Explicit | Implicit
+ | HsCoreTy Type -- An escape hatch for tunnelling a *closed*
+ -- Core Type through HsSyn.
+
+ deriving (Data, Typeable)
+
+data HsExplicitFlag = Explicit | Implicit deriving (Data, Typeable)
data ConDeclField name -- Record fields have Haddoc docs on them
= ConDeclField { cd_fld_name :: Located name,
cd_fld_type :: LBangType name,
cd_fld_doc :: Maybe LHsDocString }
-
+ deriving (Data, Typeable)
-----------------------
-- Combine adjacent for-alls.
-- *** NOTA BENE *** A "monotype" in a pragma can have
-- for-alls in it, (mostly to do with dictionaries). These
-- must be explicitly Kinded.
+ deriving (Data, Typeable)
hsTyVarName :: HsTyVarBndr name -> name
hsTyVarName (UserTyVar n _) = n
\begin{code}
+splitHsAppTys :: LHsType n -> [LHsType n] -> (LHsType n, [LHsType n])
+splitHsAppTys (L _ (HsAppTy f a)) as = splitHsAppTys f (a:as)
+splitHsAppTys f as = (f,as)
+
+mkHsAppTys :: OutputableBndr n => LHsType n -> [LHsType n] -> HsType n
+mkHsAppTys fun_ty [] = pprPanic "mkHsAppTys" (ppr fun_ty)
+mkHsAppTys fun_ty (arg_ty:arg_tys)
+ = foldl mk_app (HsAppTy fun_ty arg_ty) arg_tys
+ where
+ mk_app fun arg = HsAppTy (noLoc fun) arg
+ -- Add noLocs for inner nodes of the application;
+ -- they are never used
+
splitHsInstDeclTy
:: OutputableBndr name
=> HsType name
forall_part = ptext (sLit "forall") <+> interppSP tvs <> dot
pprHsContext :: (OutputableBndr name) => HsContext name -> SDoc
-pprHsContext [] = empty
-pprHsContext cxt = ppr_hs_context cxt <+> ptext (sLit "=>")
+pprHsContext [] = empty
+pprHsContext [L _ pred]
+ | noParenHsPred pred = ppr pred <+> darrow
+pprHsContext cxt = ppr_hs_context cxt <+> darrow
+
+noParenHsPred :: HsPred name -> Bool
+-- c.f. TypeRep.noParenPred
+noParenHsPred (HsClassP {}) = True
+noParenHsPred (HsEqualP {}) = True
+noParenHsPred (HsIParam {}) = False
ppr_hs_context :: (OutputableBndr name) => HsContext name -> SDoc
ppr_hs_context [] = empty
ppr_mono_ty _ (HsKindSig ty kind) = parens (ppr_mono_lty pREC_TOP ty <+> dcolon <+> pprKind kind)
ppr_mono_ty _ (HsListTy ty) = brackets (ppr_mono_lty pREC_TOP ty)
ppr_mono_ty _ (HsPArrTy ty) = pabrackets (ppr_mono_lty pREC_TOP ty)
+ppr_mono_ty _ (HsModalBoxType ecn ty) = ppr_modalBoxType (ppr ecn) (ppr_mono_lty pREC_TOP ty)
ppr_mono_ty _ (HsPredTy pred) = ppr pred
-ppr_mono_ty _ (HsNumTy n) = integer n -- generics only
ppr_mono_ty _ (HsSpliceTy s _ _) = pprSplice s
+ppr_mono_ty _ (HsCoreTy ty) = ppr ty
ppr_mono_ty ctxt_prec (HsAppTy fun_ty arg_ty)
= maybeParen ctxt_prec pREC_CON $
--------------------------
pabrackets :: SDoc -> SDoc
pabrackets p = ptext (sLit "[:") <> p <> ptext (sLit ":]")
+
+ppr_modalBoxType :: SDoc -> SDoc -> SDoc
+ppr_modalBoxType ecn p = ptext (sLit "<[") <> p <> ptext (sLit "]>@") <> ecn
+
\end{code}