% -----------------------------------------------------------------------------
% $Id: HsSyn.lhs,v 1.22 2004/08/09 11:55:07 simonmar Exp $
%
% (c) The GHC Team, 1997-2002
%
% A suite of datatypes describing the abstract syntax of Haskell 98.
%
% -----------------------------------------------------------------------------
\begin{code}
module HsSyn (
SrcLoc(..), Module(..), HsQName(..), HsName(..), HsIdentifier(..),
HsModule(..), HsExportSpec(..), ModuleInfo(..),
HsImportDecl(..), HsImportSpec(..), HsAssoc(..),
HsDecl(..), HsMatch(..), HsConDecl(..), HsFieldDecl(..),
HsBangType(..), HsRhs(..),
HsGuardedRhs(..), HsType(..), HsContext, HsAsst, HsIPContext, HsCtxt(..),
HsLiteral(..), HsExp(..), HsPat(..), HsPatField(..), HsStmt(..),
HsFieldUpdate(..), HsAlt(..), HsGuardedAlts(..), HsGuardedAlt(..),
HsCallConv(..), HsFISafety(..), HsFunDep,
mkHsForAllType,
prelude_mod, main_mod,
unit_con_name, tuple_con_name, nil_con_name,
as_name, qualified_name, hiding_name, minus_name, pling_name, dot_name,
forall_name, unsafe_name, safe_name, threadsafe_name, export_name,
stdcall_name, ccall_name, dotnet_name,
unit_tycon_name, fun_tycon_name, list_tycon_name, tuple_tycon_name,
unit_tycon_qname, fun_tycon_qname, list_tycon_qname, tuple_tycon_qname,
unit_tycon, fun_tycon, list_tycon, tuple_tycon,
emptyModuleInfo,
hsIdentifierStr, hsAnchorNameStr, hsNameStr,
GenDoc(..), Doc, DocMarkup(..),
markup, mapIdent, idMarkup,
docAppend, docParagraph,
) where
import Char (isSpace)
data SrcLoc = SrcLoc Int Int -- (Line, Indentation)
deriving (Eq,Ord,Show)
newtype Module = Module String
deriving (Eq,Ord)
instance Show Module where
showsPrec _ (Module m) = showString m
data HsQName
= Qual Module HsName
| UnQual HsName
deriving (Eq,Ord)
instance Show HsQName where
showsPrec _ (Qual (Module m) s) =
showString m . showString "." . shows s
showsPrec _ (UnQual s) = shows s
data HsName
= HsTyClsName HsIdentifier
| HsVarName HsIdentifier
deriving (Eq,Ord)
instance Show HsName where
showsPrec p (HsTyClsName i) = showsPrec p i
showsPrec p (HsVarName i) = showsPrec p i
data HsIdentifier
= HsIdent String
| HsSymbol String
| HsSpecial String
deriving (Eq,Ord)
instance Show HsIdentifier where
showsPrec _ (HsIdent s) = showString s
showsPrec _ (HsSymbol s) = showString s
showsPrec _ (HsSpecial s) = showString s
data HsModule = HsModule Module (Maybe [HsExportSpec])
[HsImportDecl] [HsDecl]
(Maybe String) -- the doc options
ModuleInfo -- the info (portability etc.)
(Maybe Doc) -- the module doc.
deriving Show
data ModuleInfo = ModuleInfo
{ description :: Maybe Doc,
portability :: Maybe String,
stability :: Maybe String,
maintainer :: Maybe String
}
deriving Show
emptyModuleInfo :: ModuleInfo
emptyModuleInfo = ModuleInfo {
description = Nothing,
portability = Nothing,
stability = Nothing,
maintainer = Nothing
}
-- Export/Import Specifications
data HsExportSpec
= HsEVar HsQName -- variable
| HsEAbs HsQName -- T
| HsEThingAll HsQName -- T(..)
| HsEThingWith HsQName [HsQName] -- T(C_1,...,C_n)
| HsEModuleContents Module -- module M (not for imports)
| HsEGroup Int Doc -- a doc section heading
| HsEDoc Doc -- some documentation
| HsEDocNamed String -- a reference to named doc
deriving (Eq,Show)
data HsImportDecl
= HsImportDecl SrcLoc Module Bool (Maybe Module)
(Maybe (Bool,[HsImportSpec]))
deriving (Eq,Show)
data HsImportSpec
= HsIVar HsName -- variable
| HsIAbs HsName -- T
| HsIThingAll HsName -- T(..)
| HsIThingWith HsName [HsName] -- T(C_1,...,C_n)
deriving (Eq,Show)
data HsAssoc
= HsAssocNone
| HsAssocLeft
| HsAssocRight
deriving (Eq,Show)
data HsFISafety
= HsFIUnsafe
| HsFISafe
| HsFIThreadSafe
deriving (Eq,Show)
data HsCallConv
= HsCCall
| HsStdCall
| HsDotNetCall
deriving (Eq,Show)
data HsDecl
= HsTypeDecl SrcLoc HsName [HsName] HsType (Maybe Doc)
| HsDataDecl SrcLoc HsContext HsName [HsName] [HsConDecl] [HsQName]
(Maybe Doc)
| HsInfixDecl SrcLoc HsAssoc Int [HsName]
| HsNewTypeDecl SrcLoc HsContext HsName [HsName] HsConDecl [HsQName]
(Maybe Doc)
| HsClassDecl SrcLoc HsContext HsName [HsName] [HsFunDep] [HsDecl] (Maybe Doc)
| HsInstDecl SrcLoc HsContext HsAsst [HsDecl]
| HsDefaultDecl SrcLoc [HsType]
| HsTypeSig SrcLoc [HsName] HsType (Maybe Doc)
| HsFunBind [HsMatch]
| HsPatBind SrcLoc HsPat HsRhs {-where-} [HsDecl]
| HsForeignImport SrcLoc HsCallConv HsFISafety String HsName HsType
(Maybe Doc)
| HsForeignExport SrcLoc HsCallConv String HsName HsType
| HsDocCommentNext SrcLoc Doc -- a documentation annotation
| HsDocCommentPrev SrcLoc Doc -- a documentation annotation
| HsDocCommentNamed SrcLoc String Doc -- a documentation annotation
| HsDocGroup SrcLoc Int Doc -- a documentation group
deriving (Eq,Show)
data HsMatch
= HsMatch SrcLoc HsQName [HsPat] HsRhs {-where-} [HsDecl]
deriving (Eq,Show)
data HsConDecl
= HsConDecl SrcLoc HsName [HsName] HsContext [HsBangType] (Maybe Doc)
| HsRecDecl SrcLoc HsName [HsName] HsContext [HsFieldDecl] (Maybe Doc)
deriving (Eq,Show)
data HsFieldDecl
= HsFieldDecl [HsName] HsBangType (Maybe Doc)
deriving (Eq,Show)
data HsBangType
= HsBangedTy HsType
| HsUnBangedTy HsType
deriving (Eq,Show)
data HsRhs
= HsUnGuardedRhs HsExp
| HsGuardedRhss [HsGuardedRhs]
deriving (Eq,Show)
data HsGuardedRhs
= HsGuardedRhs SrcLoc [HsStmt] HsExp
deriving (Eq,Show)
data HsType
= HsForAllType (Maybe [HsName]) HsIPContext HsType
| HsTyFun HsType HsType
| HsTyTuple Bool{-boxed-} [HsType]
| HsTyApp HsType HsType
| HsTyVar HsName
| HsTyCon HsQName
| HsTyDoc HsType Doc
| HsTyIP HsName HsType
deriving (Eq,Show)
type HsFunDep = ([HsName], [HsName])
type HsContext = [HsAsst]
type HsIPContext = [HsCtxt]
data HsCtxt
= HsAssump HsAsst -- for multi-parameter type classes
| HsIP HsName HsType
deriving (Eq,Show)
type HsAsst = (HsQName,[HsType])
data HsLiteral
= HsInt Integer
| HsChar Char
| HsString String
| HsFrac Rational
-- GHC unboxed literals:
| HsCharPrim Char
| HsStringPrim String
| HsIntPrim Integer
| HsFloatPrim Rational
| HsDoublePrim Rational
deriving (Eq, Show)
data HsExp
= HsIPVar HsQName
| HsVar HsQName
| HsCon HsQName
| HsLit HsLiteral
| HsInfixApp HsExp HsExp HsExp
| HsApp HsExp HsExp
| HsNegApp HsExp
| HsLambda [HsPat] HsExp
| HsLet [HsDecl] HsExp
| HsIf HsExp HsExp HsExp
| HsCase HsExp [HsAlt]
| HsDo [HsStmt]
| HsTuple Bool{-boxed-} [HsExp]
| HsList [HsExp]
| HsParen HsExp
| HsLeftSection HsExp HsExp
| HsRightSection HsExp HsExp
| HsRecConstr HsQName [HsFieldUpdate]
| HsRecUpdate HsExp [HsFieldUpdate]
| HsEnumFrom HsExp
| HsEnumFromTo HsExp HsExp
| HsEnumFromThen HsExp HsExp
| HsEnumFromThenTo HsExp HsExp HsExp
| HsListComp HsExp [HsStmt]
| HsExpTypeSig SrcLoc HsExp HsType
| HsAsPat HsName HsExp -- pattern only
| HsWildCard -- ditto
| HsIrrPat HsExp -- ditto
-- HsCCall (ghc extension)
-- HsSCC (ghc extension)
deriving (Eq,Show)
data HsPat
= HsPVar HsName
| HsPLit HsLiteral
| HsPNeg HsPat
| HsPInfixApp HsPat HsQName HsPat
| HsPApp HsQName [HsPat]
| HsPTuple Bool{-boxed-} [HsPat]
| HsPList [HsPat]
| HsPParen HsPat
| HsPRec HsQName [HsPatField]
| HsPAsPat HsName HsPat
| HsPWildCard
| HsPIrrPat HsPat
| HsPTypeSig HsPat HsType
deriving (Eq,Show)
data HsPatField
= HsPFieldPat HsQName HsPat
deriving (Eq,Show)
data HsStmt
= HsGenerator HsPat HsExp
| HsParStmt [HsStmt]
| HsQualifier HsExp
| HsLetStmt [HsDecl]
deriving (Eq,Show)
data HsFieldUpdate
= HsFieldUpdate HsQName HsExp
deriving (Eq,Show)
data HsAlt
= HsAlt SrcLoc HsPat HsGuardedAlts [HsDecl]
deriving (Eq,Show)
data HsGuardedAlts
= HsUnGuardedAlt HsExp
| HsGuardedAlts [HsGuardedAlt]
deriving (Eq,Show)
data HsGuardedAlt
= HsGuardedAlt SrcLoc [HsStmt] HsExp
deriving (Eq,Show)
-----------------------------------------------------------------------------
-- Smart constructors
-- pinched from GHC
mkHsForAllType :: Maybe [HsName] -> HsIPContext -> HsType -> HsType
mkHsForAllType (Just []) [] ty = ty -- Explicit for-all with no tyvars
mkHsForAllType mtvs1 [] (HsForAllType mtvs2 ctxt ty)
= mkHsForAllType (mtvs1 `plus` mtvs2) ctxt ty
where
mtvs `plus` Nothing = mtvs
Nothing `plus` mtvs = mtvs
(Just tvs1) `plus` (Just tvs2) = Just (tvs1 ++ tvs2)
mkHsForAllType tvs ctxt ty = HsForAllType tvs ctxt ty
-----------------------------------------------------------------------------
-- Builtin names.
prelude_mod, main_mod :: Module
prelude_mod = Module "Prelude"
main_mod = Module "Main"
unit_ident, nil_ident :: HsIdentifier
unit_ident = HsSpecial "()"
nil_ident = HsSpecial "[]"
tuple_ident :: Int -> HsIdentifier
tuple_ident i = HsSpecial ("("++replicate i ','++")")
unit_con_name, nil_con_name :: HsQName
unit_con_name = Qual prelude_mod (HsVarName unit_ident)
nil_con_name = Qual prelude_mod (HsVarName nil_ident)
tuple_con_name :: Int -> HsQName
tuple_con_name i = Qual prelude_mod (HsVarName (tuple_ident i))
as_name, qualified_name, hiding_name, unsafe_name, safe_name
, forall_name, threadsafe_name, export_name, ccall_name, stdcall_name
, dotnet_name, minus_name, pling_name, dot_name :: HsName
as_name = HsVarName (HsIdent "as")
qualified_name = HsVarName (HsIdent "qualified")
hiding_name = HsVarName (HsIdent "hiding")
unsafe_name = HsVarName (HsIdent "unsafe")
safe_name = HsVarName (HsIdent "safe")
forall_name = HsVarName (HsIdent "forall")
threadsafe_name = HsVarName (HsIdent "threadsafe")
export_name = HsVarName (HsIdent "export")
ccall_name = HsVarName (HsIdent "ccall")
stdcall_name = HsVarName (HsIdent "stdcall")
dotnet_name = HsVarName (HsIdent "dotnet")
minus_name = HsVarName (HsSymbol "-")
pling_name = HsVarName (HsSymbol "!")
dot_name = HsVarName (HsSymbol ".")
unit_tycon_name, fun_tycon_name, list_tycon_name :: HsName
unit_tycon_name = HsTyClsName unit_ident
fun_tycon_name = HsTyClsName (HsSpecial "->")
list_tycon_name = HsTyClsName (HsSpecial "[]")
tuple_tycon_name :: Int -> HsName
tuple_tycon_name i = HsTyClsName (tuple_ident i)
unit_tycon_qname, fun_tycon_qname, list_tycon_qname :: HsQName
unit_tycon_qname = Qual prelude_mod unit_tycon_name
fun_tycon_qname = Qual prelude_mod fun_tycon_name
list_tycon_qname = Qual prelude_mod list_tycon_name
tuple_tycon_qname :: Int -> HsQName
tuple_tycon_qname i = Qual prelude_mod (tuple_tycon_name i)
unit_tycon, fun_tycon, list_tycon :: HsType
unit_tycon = HsTyCon unit_tycon_qname
fun_tycon = HsTyCon fun_tycon_qname
list_tycon = HsTyCon list_tycon_qname
tuple_tycon :: Int -> HsType
tuple_tycon i = HsTyCon (tuple_tycon_qname i)
hsIdentifierStr :: HsIdentifier -> String
hsIdentifierStr (HsIdent str) = str
hsIdentifierStr (HsSymbol str) = str
hsIdentifierStr (HsSpecial str) = str
hsAnchorNameStr :: HsName -> String
hsAnchorNameStr (HsTyClsName id0) = "t:" ++ hsIdentifierStr id0
hsAnchorNameStr (HsVarName id0) = "v:" ++ hsIdentifierStr id0
hsNameStr :: HsName -> String
hsNameStr (HsTyClsName id0) = hsIdentifierStr id0
hsNameStr (HsVarName id0) = hsIdentifierStr id0
-- -----------------------------------------------------------------------------
-- Doc strings and formatting
data GenDoc id
= DocEmpty
| DocAppend (GenDoc id) (GenDoc id)
| DocString String
| DocParagraph (GenDoc id)
| DocIdentifier id
| DocModule String
| DocEmphasis (GenDoc id)
| DocMonospaced (GenDoc id)
| DocUnorderedList [GenDoc id]
| DocOrderedList [GenDoc id]
| DocDefList [(GenDoc id, GenDoc id)]
| DocCodeBlock (GenDoc id)
| DocURL String
| DocAName String
deriving (Eq, Show)
type Doc = GenDoc [HsQName]
-- | DocMarkup is a set of instructions for marking up documentation.
-- In fact, it's really just a mapping from 'GenDoc' to some other
-- type [a], where [a] is usually the type of the output (HTML, say).
data DocMarkup id a = Markup {
markupEmpty :: a,
markupString :: String -> a,
markupParagraph :: a -> a,
markupAppend :: a -> a -> a,
markupIdentifier :: id -> a,
markupModule :: String -> a,
markupEmphasis :: a -> a,
markupMonospaced :: a -> a,
markupUnorderedList :: [a] -> a,
markupOrderedList :: [a] -> a,
markupDefList :: [(a,a)] -> a,
markupCodeBlock :: a -> a,
markupURL :: String -> a,
markupAName :: String -> a
}
markup :: DocMarkup id a -> GenDoc id -> a
markup m DocEmpty = markupEmpty m
markup m (DocAppend d1 d2) = markupAppend m (markup m d1) (markup m d2)
markup m (DocString s) = markupString m s
markup m (DocParagraph d) = markupParagraph m (markup m d)
markup m (DocIdentifier i) = markupIdentifier m i
markup m (DocModule mod0) = markupModule m mod0
markup m (DocEmphasis d) = markupEmphasis m (markup m d)
markup m (DocMonospaced d) = markupMonospaced m (markup m d)
markup m (DocUnorderedList ds) = markupUnorderedList m (map (markup m) ds)
markup m (DocOrderedList ds) = markupOrderedList m (map (markup m) ds)
markup m (DocDefList ds) = markupDefList m (map (markupPair m) ds)
markup m (DocCodeBlock d) = markupCodeBlock m (markup m d)
markup m (DocURL url) = markupURL m url
markup m (DocAName ref) = markupAName m ref
markupPair :: DocMarkup id a -> (GenDoc id, GenDoc id) -> (a, a)
markupPair m (a,b) = (markup m a, markup m b)
-- | The identity markup
idMarkup :: DocMarkup a (GenDoc a)
idMarkup = Markup {
markupEmpty = DocEmpty,
markupString = DocString,
markupParagraph = DocParagraph,
markupAppend = DocAppend,
markupIdentifier = DocIdentifier,
markupModule = DocModule,
markupEmphasis = DocEmphasis,
markupMonospaced = DocMonospaced,
markupUnorderedList = DocUnorderedList,
markupOrderedList = DocOrderedList,
markupDefList = DocDefList,
markupCodeBlock = DocCodeBlock,
markupURL = DocURL,
markupAName = DocAName
}
-- | Since marking up is just a matter of mapping 'Doc' into some
-- other type, we can \'rename\' documentation by marking up 'Doc' into
-- the same thing, modifying only the identifiers embedded in it.
mapIdent :: (a -> GenDoc b) -> DocMarkup a (GenDoc b)
mapIdent f = idMarkup{ markupIdentifier = f }
-- -----------------------------------------------------------------------------
-- ** Smart constructors
-- used to make parsing easier; we group the list items later
docAppend :: Doc -> Doc -> Doc
docAppend (DocUnorderedList ds1) (DocUnorderedList ds2)
= DocUnorderedList (ds1++ds2)
docAppend (DocUnorderedList ds1) (DocAppend (DocUnorderedList ds2) d)
= DocAppend (DocUnorderedList (ds1++ds2)) d
docAppend (DocOrderedList ds1) (DocOrderedList ds2)
= DocOrderedList (ds1++ds2)
docAppend (DocOrderedList ds1) (DocAppend (DocOrderedList ds2) d)
= DocAppend (DocOrderedList (ds1++ds2)) d
docAppend (DocDefList ds1) (DocDefList ds2)
= DocDefList (ds1++ds2)
docAppend (DocDefList ds1) (DocAppend (DocDefList ds2) d)
= DocAppend (DocDefList (ds1++ds2)) d
docAppend DocEmpty d = d
docAppend d DocEmpty = d
docAppend d1 d2
= DocAppend d1 d2
-- again to make parsing easier - we spot a paragraph whose only item
-- is a DocMonospaced and make it into a DocCodeBlock
docParagraph :: Doc -> Doc
docParagraph (DocMonospaced p)
= DocCodeBlock p
docParagraph (DocAppend (DocString s1) (DocMonospaced p))
| all isSpace s1
= DocCodeBlock p
docParagraph (DocAppend (DocString s1)
(DocAppend (DocMonospaced p) (DocString s2)))
| all isSpace s1 && all isSpace s2
= DocCodeBlock p
docParagraph (DocAppend (DocMonospaced p) (DocString s2))
| all isSpace s2
= DocCodeBlock p
docParagraph p
= DocParagraph p
\end{code}
