aboutsummaryrefslogtreecommitdiff
path: root/src/HsSyn.lhs
diff options
context:
space:
mode:
Diffstat (limited to 'src/HsSyn.lhs')
-rw-r--r--src/HsSyn.lhs542
1 files changed, 0 insertions, 542 deletions
diff --git a/src/HsSyn.lhs b/src/HsSyn.lhs
deleted file mode 100644
index cb5ec11e..00000000
--- a/src/HsSyn.lhs
+++ /dev/null
@@ -1,542 +0,0 @@
-% -----------------------------------------------------------------------------
-% $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 FilePath -- (Line, Indentation, FileName)
- 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 SrcLoc 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}
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-11 07:07:03 +0000