haskell-src-exts 1.7.0 → 1.7.1
raw patch · 9 files changed
+405/−912 lines, 9 filesPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
API changes (from Hackage documentation)
- Language.Haskell.Exts.Annotated.Simplify: pageFun :: SrcLoc -> Exp -> Decl
Files
- haskell-src-exts.cabal +1/−1
- src/Language/Haskell/Exts/Annotated/Simplify.hs +90/−93
- src/Language/Haskell/Exts/Annotated/Syntax.hs +128/−146
- src/Language/Haskell/Exts/Lexer.hs +4/−1
- src/Language/Haskell/Exts/ParseSyntax.hs +61/−59
- src/Language/Haskell/Exts/ParseUtils.hs +6/−475
- src/Language/Haskell/Exts/Pretty.hs +1/−1
- src/Language/Haskell/Exts/SrcLoc.hs +22/−6
- src/Language/Haskell/Exts/Syntax.hs +92/−130
haskell-src-exts.cabal view
@@ -1,5 +1,5 @@ Name: haskell-src-exts-Version: 1.7.0+Version: 1.7.1 License: BSD3 License-File: LICENSE Author: Niklas Broberg
src/Language/Haskell/Exts/Annotated/Simplify.hs view
@@ -11,7 +11,12 @@ -- This module contains code for translating from the annotated -- complex AST in Language.Haskell.Exts.Annotated.Syntax -- to the simpler, sparsely annotated AST in Language.Haskell.Exts.Syntax. --- +-- +-- A function @sXYZ@ translates an annotated AST node of type @XYZ l@ into +-- a simple AST node of type @XYZ@. I would have prefered to use a MPTC +-- with an fd/type family to get a single exported function name, but +-- I wish to stay Haskell 2010 compliant. Let's hope for Haskell 2011. +-- ----------------------------------------------------------------------------- module Language.Haskell.Exts.Annotated.Simplify where @@ -20,6 +25,90 @@ import Language.Haskell.Exts.SrcLoc +-- | Translate an annotated AST node representing a Haskell module, into +-- a simpler version that retains (almost) only abstract information. +-- In particular, XML and hybrid XML pages enabled by the XmlSyntax extension +-- are translated into standard Haskell modules with a @page@ function. +sModule :: SrcInfo loc => Module loc -> S.Module +sModule md = case md of + Module l mmh oss ids ds -> + let (mn, mwt, mes) = sModuleHead mmh + in S.Module (getPointLoc l) mn (map sOptionPragma oss) mwt mes (map sImportDecl ids) (map sDecl ds) + XmlPage l mn oss xn attrs mat es -> + let loc = getPointLoc l + in S.Module loc (sModuleName mn) (map sOptionPragma oss) + Nothing + (Just [S.EVar $ S.UnQual $ S.Ident "page"]) + [] + [pageFun loc $ S.XTag loc (sXName xn) (map sXAttr attrs) (fmap sExp mat) (map sExp es)] + XmlHybrid l mmh oss ids ds xn attrs mat es -> + let loc1 = getPointLoc l + loc2 = getPointLoc (ann xn) + (mn, mwt, mes) = sModuleHead mmh + in S.Module loc1 mn (map sOptionPragma oss) mwt mes (map sImportDecl ids) + (map sDecl ds ++ [pageFun loc2 $ S.XTag loc2 (sXName xn) (map sXAttr attrs) (fmap sExp mat) (map sExp es)]) + where pageFun :: SrcLoc -> S.Exp -> S.Decl + pageFun loc e = S.PatBind loc namePat Nothing rhs (S.BDecls []) + where namePat = S.PVar $ S.Ident "page" + rhs = S.UnGuardedRhs e + + +-- | Translate an annotated AST node representing a Haskell declaration +-- into a simpler version. Note that in the simpler version, all declaration +-- nodes are still annotated by 'SrcLoc's. +sDecl :: SrcInfo loc => Decl loc -> S.Decl +sDecl decl = case decl of + TypeDecl l dh t -> + let (n, tvs) = sDeclHead dh + in S.TypeDecl (getPointLoc l) n tvs (sType t) + TypeFamDecl l dh mk -> + let (n, tvs) = sDeclHead dh + in S.TypeFamDecl (getPointLoc l) n tvs (fmap sKind mk) + DataDecl l dn mctxt dh constrs mder -> + let (n, tvs) = sDeclHead dh + in S.DataDecl (getPointLoc l) (sDataOrNew dn) (maybe [] sContext mctxt) n tvs (map sQualConDecl constrs) (maybe [] sDeriving mder) + GDataDecl l dn mctxt dh mk gds mder -> + let (n, tvs) = sDeclHead dh + in S.GDataDecl (getPointLoc l) (sDataOrNew dn) (maybe [] sContext mctxt) n tvs (fmap sKind mk) (map sGadtDecl gds) (maybe [] sDeriving mder) + DataFamDecl l mctxt dh mk -> + let (n, tvs) = sDeclHead dh + in S.DataFamDecl (getPointLoc l) (maybe [] sContext mctxt) n tvs (fmap sKind mk) + TypeInsDecl l t1 t2 -> S.TypeInsDecl (getPointLoc l) (sType t1) (sType t2) + DataInsDecl l dn t constrs mder -> + S.DataInsDecl (getPointLoc l) (sDataOrNew dn) (sType t) (map sQualConDecl constrs) (maybe [] sDeriving mder) + GDataInsDecl l dn t mk gds mder -> + S.GDataInsDecl (getPointLoc l) (sDataOrNew dn) (sType t) (fmap sKind mk) (map sGadtDecl gds) (maybe [] sDeriving mder) + ClassDecl l mctxt dh fds mcds -> + let (n, tvs) = sDeclHead dh + in S.ClassDecl (getPointLoc l) (maybe [] sContext mctxt) n tvs (map sFunDep fds) (maybe [] (map sClassDecl) mcds) + InstDecl l mctxt ih mids -> + let (qn, ts) = sInstHead ih + in S.InstDecl (getPointLoc l) (maybe [] sContext mctxt) qn ts (maybe [] (map sInstDecl) mids) + DerivDecl l mctxt ih -> + let (qn, ts) = sInstHead ih + in S.DerivDecl (getPointLoc l) (maybe [] sContext mctxt) qn ts + InfixDecl l ass prec ops -> S.InfixDecl (getPointLoc l) (sAssoc ass) (maybe 9 id prec) (map sOp ops) + DefaultDecl l ts -> S.DefaultDecl (getPointLoc l) (map sType ts) + SpliceDecl l sp -> S.SpliceDecl (getPointLoc l) (sExp sp) + TypeSig l ns t -> S.TypeSig (getPointLoc l) (map sName ns) (sType t) + FunBind _ ms -> S.FunBind (map sMatch ms) + PatBind l p mt rhs mbs -> + S.PatBind (getPointLoc l) (sPat p) (fmap sType mt) (sRhs rhs) (maybe (S.BDecls []) sBinds mbs) + ForImp l cc msaf mstr n t -> + S.ForImp (getPointLoc l) (sCallConv cc) (maybe (S.PlaySafe False) sSafety msaf) (maybe "" id mstr) (sName n) (sType t) + ForExp l cc mstr n t -> + S.ForExp (getPointLoc l) (sCallConv cc) (maybe "" id mstr) (sName n) (sType t) + RulePragmaDecl l rs -> S.RulePragmaDecl (getPointLoc l) (map sRule rs) + DeprPragmaDecl l nsstrs -> S.DeprPragmaDecl (getPointLoc l) (map (\(ns, str) -> (map sName ns, str)) nsstrs) + WarnPragmaDecl l nsstrs -> S.WarnPragmaDecl (getPointLoc l) (map (\(ns, str) -> (map sName ns, str)) nsstrs) + InlineSig l b mact qn -> S.InlineSig (getPointLoc l) b (maybe S.AlwaysActive sActivation mact) (sQName qn) + SpecSig l qn ts -> S.SpecSig (getPointLoc l) (sQName qn) (map sType ts) + SpecInlineSig l b mact qn ts -> + S.SpecInlineSig (getPointLoc l) b (maybe S.AlwaysActive sActivation mact) (sQName qn) (map sType ts) + InstSig l mctxt ih -> + let (qn, ts) = sInstHead ih + in S.InstSig (getPointLoc l) (maybe [] sContext mctxt) qn ts + sModuleName :: ModuleName l -> S.ModuleName sModuleName (ModuleName _ str) = S.ModuleName str @@ -63,34 +152,6 @@ Nothing -> (S.main_mod, Nothing, Just [S.EVar (S.UnQual S.main_name)]) Just (ModuleHead _ mn mwt mel) -> (sModuleName mn, fmap sWarningText mwt, fmap sExportSpecList mel) --- | Translate an annotated AST node representing a Haskell module, into --- a simpler version that retains (almost) only abstract information. --- In particular, XML and hybrid XML pages enabled by the XmlSyntax extension --- are translated into standard Haskell modules with a @page@ function. -sModule :: SrcInfo loc => Module loc -> S.Module -sModule md = case md of - Module l mmh oss ids ds -> - let (mn, mwt, mes) = sModuleHead mmh - in S.Module (getPointLoc l) mn (map sOptionPragma oss) mwt mes (map sImportDecl ids) (map sDecl ds) - XmlPage l mn oss xn attrs mat es -> - let loc = getPointLoc l - in S.Module loc (sModuleName mn) (map sOptionPragma oss) - Nothing - (Just [S.EVar $ S.UnQual $ S.Ident "page"]) - [] - [pageFun loc $ S.XTag loc (sXName xn) (map sXAttr attrs) (fmap sExp mat) (map sExp es)] - XmlHybrid l mmh oss ids ds xn attrs mat es -> - let loc1 = getPointLoc l - loc2 = getPointLoc (ann xn) - (mn, mwt, mes) = sModuleHead mmh - in S.Module loc1 mn (map sOptionPragma oss) mwt mes (map sImportDecl ids) - (map sDecl ds ++ [pageFun loc2 $ S.XTag loc2 (sXName xn) (map sXAttr attrs) (fmap sExp mat) (map sExp es)]) - -pageFun :: SrcLoc -> S.Exp -> S.Decl -pageFun loc e = S.PatBind loc namePat Nothing rhs (S.BDecls []) - where namePat = S.PVar $ S.Ident "page" - rhs = S.UnGuardedRhs e - sExportSpecList :: ExportSpecList l -> [S.ExportSpec] sExportSpecList (ExportSpecList _ ess) = map sExportSpec ess @@ -134,62 +195,6 @@ IHInfix _ ta qn tb -> (sQName qn, map sType [ta,tb]) IHParen _ ih -> sInstHead ih --- | Translate an annotated AST node representing a Haskell declaration --- into a simpler version. Note that in the simpler version, all declaration --- nodes are still annotated by 'SrcLoc's. -sDecl :: SrcInfo loc => Decl loc -> S.Decl -sDecl decl = case decl of - TypeDecl l dh t -> - let (n, tvs) = sDeclHead dh - in S.TypeDecl (getPointLoc l) n tvs (sType t) - TypeFamDecl l dh mk -> - let (n, tvs) = sDeclHead dh - in S.TypeFamDecl (getPointLoc l) n tvs (fmap sKind mk) - DataDecl l dn mctxt dh constrs mder -> - let (n, tvs) = sDeclHead dh - in S.DataDecl (getPointLoc l) (sDataOrNew dn) (maybe [] sContext mctxt) n tvs (map sQualConDecl constrs) (maybe [] sDeriving mder) - GDataDecl l dn mctxt dh mk gds mder -> - let (n, tvs) = sDeclHead dh - in S.GDataDecl (getPointLoc l) (sDataOrNew dn) (maybe [] sContext mctxt) n tvs (fmap sKind mk) (map sGadtDecl gds) (maybe [] sDeriving mder) - DataFamDecl l mctxt dh mk -> - let (n, tvs) = sDeclHead dh - in S.DataFamDecl (getPointLoc l) (maybe [] sContext mctxt) n tvs (fmap sKind mk) - TypeInsDecl l t1 t2 -> S.TypeInsDecl (getPointLoc l) (sType t1) (sType t2) - DataInsDecl l dn t constrs mder -> - S.DataInsDecl (getPointLoc l) (sDataOrNew dn) (sType t) (map sQualConDecl constrs) (maybe [] sDeriving mder) - GDataInsDecl l dn t mk gds mder -> - S.GDataInsDecl (getPointLoc l) (sDataOrNew dn) (sType t) (fmap sKind mk) (map sGadtDecl gds) (maybe [] sDeriving mder) - ClassDecl l mctxt dh fds mcds -> - let (n, tvs) = sDeclHead dh - in S.ClassDecl (getPointLoc l) (maybe [] sContext mctxt) n tvs (map sFunDep fds) (maybe [] (map sClassDecl) mcds) - InstDecl l mctxt ih mids -> - let (qn, ts) = sInstHead ih - in S.InstDecl (getPointLoc l) (maybe [] sContext mctxt) qn ts (maybe [] (map sInstDecl) mids) - DerivDecl l mctxt ih -> - let (qn, ts) = sInstHead ih - in S.DerivDecl (getPointLoc l) (maybe [] sContext mctxt) qn ts - InfixDecl l ass prec ops -> S.InfixDecl (getPointLoc l) (sAssoc ass) (maybe 9 id prec) (map sOp ops) - DefaultDecl l ts -> S.DefaultDecl (getPointLoc l) (map sType ts) - SpliceDecl l sp -> S.SpliceDecl (getPointLoc l) (sExp sp) - TypeSig l ns t -> S.TypeSig (getPointLoc l) (map sName ns) (sType t) - FunBind _ ms -> S.FunBind (map sMatch ms) - PatBind l p mt rhs mbs -> - S.PatBind (getPointLoc l) (sPat p) (fmap sType mt) (sRhs rhs) (maybe (S.BDecls []) sBinds mbs) - ForImp l cc msaf mstr n t -> - S.ForImp (getPointLoc l) (sCallConv cc) (maybe (S.PlaySafe False) sSafety msaf) (maybe "" id mstr) (sName n) (sType t) - ForExp l cc mstr n t -> - S.ForExp (getPointLoc l) (sCallConv cc) (maybe "" id mstr) (sName n) (sType t) - RulePragmaDecl l rs -> S.RulePragmaDecl (getPointLoc l) (map sRule rs) - DeprPragmaDecl l nsstrs -> S.DeprPragmaDecl (getPointLoc l) (map (\(ns, str) -> (map sName ns, str)) nsstrs) - WarnPragmaDecl l nsstrs -> S.WarnPragmaDecl (getPointLoc l) (map (\(ns, str) -> (map sName ns, str)) nsstrs) - InlineSig l b mact qn -> S.InlineSig (getPointLoc l) b (maybe S.AlwaysActive sActivation mact) (sQName qn) - SpecSig l qn ts -> S.SpecSig (getPointLoc l) (sQName qn) (map sType ts) - SpecInlineSig l b mact qn ts -> - S.SpecInlineSig (getPointLoc l) b (maybe S.AlwaysActive sActivation mact) (sQName qn) (map sType ts) - InstSig l mctxt ih -> - let (qn, ts) = sInstHead ih - in S.InstSig (getPointLoc l) (maybe [] sContext mctxt) qn ts - sDataOrNew :: DataOrNew l -> S.DataOrNew sDataOrNew (DataType _) = S.DataType sDataOrNew (NewType _) = S.NewType @@ -262,8 +267,6 @@ sGuardedRhs :: SrcInfo loc => GuardedRhs loc -> S.GuardedRhs sGuardedRhs (GuardedRhs l ss e) = S.GuardedRhs (getPointLoc l) (map sStmt ss) (sExp e) --- | Translate an annotated AST node representing a Haskell type into a simpler --- unannotated form. sType :: Type l -> S.Type sType t = case t of TyForall _ mtvs mctxt t -> S.TyForall (fmap (map sTyVarBind) mtvs) (maybe [] sContext mctxt) (sType t) @@ -319,8 +322,6 @@ PrimChar _ c _ -> S.PrimChar c PrimString _ s _ -> S.PrimString s --- | Translate an annotated AST node representing a Haskell expression --- into a simpler unannotated form. sExp :: SrcInfo loc => Exp loc -> S.Exp sExp e = case e of Var _ qn -> S.Var (sQName qn) @@ -396,8 +397,6 @@ sCallConv (StdCall _) = S.StdCall sCallConv (CCall _) = S.CCall --- | Translate an annotated AST node representing a top-level Options pragma --- into a simpler unannotated form. sOptionPragma :: SrcInfo loc => OptionPragma loc -> S.OptionPragma sOptionPragma pr = case pr of LanguagePragma l ns -> S.LanguagePragma (getPointLoc l) (map sName ns) @@ -422,8 +421,6 @@ sWarningText (DeprText _ str) = S.DeprText str sWarningText (WarnText _ str) = S.WarnText str --- | Translate an annotated AST node representing a Haskell pattern --- into a simpler unannotated form. sPat :: SrcInfo loc => Pat loc -> S.Pat sPat pat = case pat of PVar _ n -> S.PVar (sName n)
src/Language/Haskell/Exts/Annotated/Syntax.hs view
@@ -110,22 +110,7 @@ #endif #endif --- import Language.Haskell.Exts.SrcLoc--- import Control.Monad.Instances -- just for Functor (,) a -{-- | A position in the source.-data SrcLoc = SrcLoc {- srcFilename :: String,- srcLine :: Int,- srcColumn :: Int- }-#ifdef __GLASGOW_HASKELL__- deriving (Eq,Ord,Show,Typeable,Data)-#else- deriving (Eq,Ord,Show)-#endif--}- -- | The name of a Haskell module. data ModuleName l = ModuleName l String #ifdef __GLASGOW_HASKELL__@@ -137,15 +122,14 @@ -- | Constructors with special syntax. -- These names are never qualified, and always refer to builtin type or -- data constructors.- data SpecialCon l- = UnitCon l -- ^ unit type and data constructor @()@- | ListCon l -- ^ list type constructor @[]@- | FunCon l -- ^ function type constructor @->@- | TupleCon l Boxed Int -- ^ /n/-ary tuple type and data- -- constructors @(,)@ etc, possibly boxed @(\#,\#)@- | Cons l -- ^ list data constructor @(:)@- | UnboxedSingleCon l -- ^ unboxed singleton tuple constructor @(\# \#)@+ = UnitCon l -- ^ unit type and data constructor @()@+ | ListCon l -- ^ list type constructor @[]@+ | FunCon l -- ^ function type constructor @->@+ | TupleCon l Boxed Int -- ^ /n/-ary tuple type and data+ -- constructors @(,)@ etc, possibly boxed @(\#,\#)@+ | Cons l -- ^ list data constructor @(:)@+ | UnboxedSingleCon l -- ^ unboxed singleton tuple constructor @(\# \#)@ #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data) #else@@ -250,18 +234,18 @@ -- | An item in a module's export specification. data ExportSpec l- = EVar l (QName l) -- ^ variable- | EAbs l (QName l) -- ^ @T@:- -- a class or datatype exported abstractly,- -- or a type synonym.- | EThingAll l (QName l) -- ^ @T(..)@:- -- a class exported with all of its methods, or- -- a datatype exported with all of its constructors.- | EThingWith l (QName l) [CName l] -- ^ @T(C_1,...,C_n)@:- -- a class exported with some of its methods, or- -- a datatype exported with some of its constructors.- | EModuleContents l (ModuleName l) -- ^ @module M@:- -- re-export a module.+ = EVar l (QName l) -- ^ variable+ | EAbs l (QName l) -- ^ @T@:+ -- a class or datatype exported abstractly,+ -- or a type synonym.+ | EThingAll l (QName l) -- ^ @T(..)@:+ -- a class exported with all of its methods, or+ -- a datatype exported with all of its constructors.+ | EThingWith l (QName l) [CName l] -- ^ @T(C_1,...,C_n)@:+ -- a class exported with some of its methods, or+ -- a datatype exported with some of its constructors.+ | EModuleContents l (ModuleName l) -- ^ @module M@:+ -- re-export a module. #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data) #else@@ -300,15 +284,15 @@ -- | An import specification, representing a single explicit item imported -- (or hidden) from a module. data ImportSpec l- = IVar l (Name l) -- ^ variable- | IAbs l (Name l) -- ^ @T@:- -- the name of a class, datatype or type synonym.- | IThingAll l (Name l) -- ^ @T(..)@:- -- a class imported with all of its methods, or- -- a datatype imported with all of its constructors.+ = IVar l (Name l) -- ^ variable+ | IAbs l (Name l) -- ^ @T@:+ -- the name of a class, datatype or type synonym.+ | IThingAll l (Name l) -- ^ @T(..)@:+ -- a class imported with all of its methods, or+ -- a datatype imported with all of its constructors. | IThingWith l (Name l) [CName l] -- ^ @T(C_1,...,C_n)@:- -- a class imported with some of its methods, or- -- a datatype imported with some of its constructors.+ -- a class imported with some of its methods, or+ -- a datatype imported with some of its constructors. #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data) #else@@ -366,7 +350,6 @@ -- ^ A foreign import declaration | ForExp l (CallConv l) (Maybe String) (Name l) (Type l) -- ^ A foreign export declaration- | RulePragmaDecl l [Rule l] -- ^ A RULES pragma | DeprPragmaDecl l [([Name l], String)]@@ -446,7 +429,15 @@ -- | Clauses of a function binding. data Match l = Match l (Name l) [Pat l] (Rhs l) {-where-} (Maybe (Binds l))+ -- ^ A clause defined with prefix notation, i.e. the function name + -- followed by its argument patterns, the right-hand side and an+ -- optional where clause. | InfixMatch l (Pat l) (Name l) [Pat l] (Rhs l) {-where-} (Maybe (Binds l))+ -- ^ A clause defined with infix notation, i.e. first its first argument+ -- pattern, then the function name, then its following argument(s),+ -- the right-hand side and an optional where clause.+ -- Note that there can be more than two arguments to a function declared+ -- infix, hence the list of pattern arguments. #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data) #else@@ -573,7 +564,7 @@ (Maybe (Context l)) (Type l) -- ^ qualified type | TyFun l (Type l) (Type l) -- ^ function type- | TyTuple l Boxed [Type l] -- ^ tuple type, possibly boxed+ | TyTuple l Boxed [Type l] -- ^ tuple type, possibly boxed | TyList l (Type l) -- ^ list syntax, e.g. [a], as opposed to [] a | TyApp l (Type l) (Type l) -- ^ application of a type constructor | TyVar l (Name l) -- ^ type variable@@ -679,71 +670,68 @@ -- | Haskell expressions. data Exp l- = Var l (QName l) -- ^ variable- | IPVar l (IPName l) -- ^ implicit parameter variable- | Con l (QName l) -- ^ data constructor- | Lit l (Literal l) -- ^ literal constant- | InfixApp l (Exp l) (QOp l) (Exp l) -- ^ infix application- | App l (Exp l) (Exp l) -- ^ ordinary application- | NegApp l (Exp l) -- ^ negation expression @-/exp/@ (unary minus)- | Lambda l [Pat l] (Exp l) -- ^ lambda expression- | Let l (Binds l) (Exp l) -- ^ local declarations with @let@ ... @in@ ...- | If l (Exp l) (Exp l) (Exp l) -- ^ @if@ /exp/ @then@ /exp/ @else@ /exp/- | Case l (Exp l) [Alt l] -- ^ @case@ /exp/ @of@ /alts/- | Do l [Stmt l] -- ^ @do@-expression:- -- the last statement in the list- -- should be an expression.- | MDo l [Stmt l] -- ^ @mdo@-expression- | Tuple l [Exp l] -- ^ tuple expression- | TupleSection l [Maybe (Exp l)] -- ^ tuple section expression, e.g. @(,,3)@- | List l [Exp l] -- ^ list expression- | Paren l (Exp l) -- ^ parenthesised expression- | LeftSection l (Exp l) (QOp l) -- ^ left section @(@/exp/ /qop/@)@- | RightSection l (QOp l) (Exp l) -- ^ right section @(@/qop/ /exp/@)@- | RecConstr l (QName l) [FieldUpdate l]- -- ^ record construction expression- | RecUpdate l (Exp l) [FieldUpdate l]- -- ^ record update expression- | EnumFrom l (Exp l) -- ^ unbounded arithmetic sequence,- -- incrementing by 1: @[from ..]@- | EnumFromTo l (Exp l) (Exp l) -- ^ bounded arithmetic sequence,- -- incrementing by 1 @[from .. to]@- | EnumFromThen l (Exp l) (Exp l) -- ^ unbounded arithmetic sequence,- -- with first two elements given @[from, then ..]@+ = Var l (QName l) -- ^ variable+ | IPVar l (IPName l) -- ^ implicit parameter variable+ | Con l (QName l) -- ^ data constructor+ | Lit l (Literal l) -- ^ literal constant+ | InfixApp l (Exp l) (QOp l) (Exp l) -- ^ infix application+ | App l (Exp l) (Exp l) -- ^ ordinary application+ | NegApp l (Exp l) -- ^ negation expression @-/exp/@ (unary minus)+ | Lambda l [Pat l] (Exp l) -- ^ lambda expression+ | Let l (Binds l) (Exp l) -- ^ local declarations with @let@ ... @in@ ...+ | If l (Exp l) (Exp l) (Exp l) -- ^ @if@ /exp/ @then@ /exp/ @else@ /exp/+ | Case l (Exp l) [Alt l] -- ^ @case@ /exp/ @of@ /alts/+ | Do l [Stmt l] -- ^ @do@-expression:+ -- the last statement in the list+ -- should be an expression.+ | MDo l [Stmt l] -- ^ @mdo@-expression+ | Tuple l [Exp l] -- ^ tuple expression+ | TupleSection l [Maybe (Exp l)] -- ^ tuple section expression, e.g. @(,,3)@+ | List l [Exp l] -- ^ list expression+ | Paren l (Exp l) -- ^ parenthesised expression+ | LeftSection l (Exp l) (QOp l) -- ^ left section @(@/exp/ /qop/@)@+ | RightSection l (QOp l) (Exp l) -- ^ right section @(@/qop/ /exp/@)@+ | RecConstr l (QName l) [FieldUpdate l] -- ^ record construction expression+ | RecUpdate l (Exp l) [FieldUpdate l] -- ^ record update expression+ | EnumFrom l (Exp l) -- ^ unbounded arithmetic sequence,+ -- incrementing by 1: @[from ..]@+ | EnumFromTo l (Exp l) (Exp l) -- ^ bounded arithmetic sequence,+ -- incrementing by 1 @[from .. to]@+ | EnumFromThen l (Exp l) (Exp l) -- ^ unbounded arithmetic sequence,+ -- with first two elements given @[from, then ..]@ | EnumFromThenTo l (Exp l) (Exp l) (Exp l)- -- ^ bounded arithmetic sequence,- -- with first two elements given @[from, then .. to]@- | ListComp l (Exp l) [QualStmt l] -- ^ ordinary list comprehension- | ParComp l (Exp l) [[QualStmt l]] -- ^ parallel list comprehension- | ExpTypeSig l (Exp l) (Type l)- -- ^ expression with explicit type signature+ -- ^ bounded arithmetic sequence,+ -- with first two elements given @[from, then .. to]@+ | ListComp l (Exp l) [QualStmt l] -- ^ ordinary list comprehension+ | ParComp l (Exp l) [[QualStmt l]] -- ^ parallel list comprehension+ | ExpTypeSig l (Exp l) (Type l) -- ^ expression with explicit type signature - | VarQuote l (QName l) -- ^ @'x@ for template haskell reifying of expressions- | TypQuote l (QName l) -- ^ @''T@ for template haskell reifying of types- | BracketExp l (Bracket l) -- ^ template haskell bracket expression- | SpliceExp l (Splice l) -- ^ template haskell splice expression- | QuasiQuote l String String -- ^ quasi-quotaion: @[$/name/| /string/ |]@+ | VarQuote l (QName l) -- ^ @'x@ for template haskell reifying of expressions+ | TypQuote l (QName l) -- ^ @''T@ for template haskell reifying of types+ | BracketExp l (Bracket l) -- ^ template haskell bracket expression+ | SpliceExp l (Splice l) -- ^ template haskell splice expression+ | QuasiQuote l String String -- ^ quasi-quotaion: @[$/name/| /string/ |]@ -- Hsx | XTag l (XName l) [XAttr l] (Maybe (Exp l)) [Exp l]- -- ^ xml element, with attributes and children+ -- ^ xml element, with attributes and children | XETag l (XName l) [XAttr l] (Maybe (Exp l))- -- ^ empty xml element, with attributes- | XPcdata l String -- ^ PCDATA child element- | XExpTag l (Exp l) -- ^ escaped haskell expression inside xml+ -- ^ empty xml element, with attributes+ | XPcdata l String -- ^ PCDATA child element+ | XExpTag l (Exp l) -- ^ escaped haskell expression inside xml -- Pragmas- | CorePragma l String (Exp l) -- ^ CORE pragma- | SCCPragma l String (Exp l) -- ^ SCC pragma+ | CorePragma l String (Exp l) -- ^ CORE pragma+ | SCCPragma l String (Exp l) -- ^ SCC pragma | GenPragma l String (Int, Int) (Int, Int) (Exp l)- -- ^ GENERATED pragma+ -- ^ GENERATED pragma -- Arrows- | Proc l (Pat l) (Exp l) -- ^ arrows proc: @proc@ /pat/ @->@ /exp/- | LeftArrApp l (Exp l) (Exp l) -- ^ arrow application (from left): /exp/ @-<@ /exp/- | RightArrApp l (Exp l) (Exp l) -- ^ arrow application (from right): /exp/ @>-@ /exp/- | LeftArrHighApp l (Exp l) (Exp l) -- ^ higher-order arrow application (from left): /exp/ @-<<@ /exp/- | RightArrHighApp l (Exp l) (Exp l) -- ^ higher-order arrow application (from right): /exp/ @>>-@ /exp/+ | Proc l (Pat l) (Exp l) -- ^ arrows proc: @proc@ /pat/ @->@ /exp/+ | LeftArrApp l (Exp l) (Exp l) -- ^ arrow application (from left): /exp/ @-<@ /exp/+ | RightArrApp l (Exp l) (Exp l) -- ^ arrow application (from right): /exp/ @>-@ /exp/+ | LeftArrHighApp l (Exp l) (Exp l) -- ^ higher-order arrow application (from left): /exp/ @-<<@ /exp/+ | RightArrHighApp l (Exp l) (Exp l) -- ^ higher-order arrow application (from right): /exp/ @>>-@ /exp/ #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data) #else@@ -813,7 +801,7 @@ -- | A top level options pragma, preceding the module header. data OptionPragma l- = LanguagePragma l [Name l] -- ^ LANGUAGE pragma+ = LanguagePragma l [Name l] -- ^ LANGUAGE pragma | IncludePragma l String -- ^ INCLUDE pragma | CFilesPragma l String -- ^ CFILES pragma | OptionsPragma l (Maybe Tool) String@@ -879,8 +867,7 @@ | PLit l (Literal l) -- ^ literal constant | PNeg l (Pat l) -- ^ negated pattern | PNPlusK l (Name l) Integer -- ^ n+k pattern- | PInfixApp l (Pat l) (QName l) (Pat l)- -- ^ pattern with an infix data constructor+ | PInfixApp l (Pat l) (QName l) (Pat l) -- ^ pattern with an infix data constructor | PApp l (QName l) [Pat l] -- ^ data constructor and argument patterns | PTuple l [Pat l] -- ^ tuple pattern | PList l [Pat l] -- ^ list pattern@@ -890,10 +877,8 @@ | PWildCard l -- ^ wildcard pattern: @_@ | PIrrPat l (Pat l) -- ^ irrefutable pattern: @~/pat/@ | PatTypeSig l (Pat l) (Type l) -- ^ pattern with type signature- | PViewPat l (Exp l) (Pat l) -- ^ view patterns of the form @(/exp/ -> /pat/)@-+ | PViewPat l (Exp l) (Pat l) -- ^ view patterns of the form @(/exp/ -> /pat/)@ | PRPat l [RPat l] -- ^ regular list pattern- | PXTag l (XName l) [PXAttr l] (Maybe (Pat l)) [Pat l] -- ^ XML element pattern | PXETag l (XName l) [PXAttr l] (Maybe (Pat l))@@ -902,11 +887,8 @@ | PXPatTag l (Pat l) -- ^ XML embedded pattern | PXRPats l [RPat l] -- ^ XML regular list pattern | PExplTypeArg l (QName l) (Type l) -- ^ Explicit generics style type argument e.g. @f {| Int |} x = ...@- | PQuasiQuote l String String -- ^ quasi quote pattern: @[$/name/| /string/ |]@- | PBangPat l (Pat l) -- ^ strict (bang) pattern: @f !x = ...@- #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data) #else@@ -937,14 +919,14 @@ -- | An entity in a regular pattern. data RPat l- = RPOp l (RPat l) (RPatOp l)- | RPEither l (RPat l) (RPat l)- | RPSeq l [RPat l]- | RPGuard l (Pat l) [Stmt l]- | RPCAs l (Name l) (RPat l)- | RPAs l (Name l) (RPat l)- | RPParen l (RPat l)- | RPPat l (Pat l)+ = RPOp l (RPat l) (RPatOp l) -- ^ operator pattern, e.g. pat*+ | RPEither l (RPat l) (RPat l) -- ^ choice pattern, e.g. (1 | 2)+ | RPSeq l [RPat l] -- ^ sequence pattern, e.g. (| 1, 2, 3 |)+ | RPGuard l (Pat l) [Stmt l] -- ^ guarded pattern, e.g. (| p | p < 3 |)+ | RPCAs l (Name l) (RPat l) -- ^ non-linear variable binding, e.g. (foo@:(1 | 2))*+ | RPAs l (Name l) (RPat l) -- ^ linear variable binding, e.g. foo@(1 | 2)+ | RPParen l (RPat l) -- ^ parenthesised pattern, e.g. (2*)+ | RPPat l (Pat l) -- ^ an ordinary pattern #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data) #else@@ -969,9 +951,9 @@ = Generator l (Pat l) (Exp l) -- ^ a generator: /pat/ @<-@ /exp/ | Qualifier l (Exp l) -- ^ an /exp/ by itself: in a @do@-expression,- -- an action whose result is discarded;- -- in a list comprehension and pattern guard,- -- a guard expression+ -- an action whose result is discarded;+ -- in a list comprehension and pattern guard,+ -- a guard expression | LetStmt l (Binds l) -- ^ local bindings | RecStmt l [Stmt l] -- ^ a recursive binding group for arrows #ifdef __GLASGOW_HASKELL__@@ -1041,41 +1023,41 @@ -- Builtin names. prelude_mod, main_mod :: l -> ModuleName l-prelude_mod l = ModuleName l "Prelude"-main_mod l = ModuleName l "Main"+prelude_mod l = ModuleName l "Prelude"+main_mod l = ModuleName l "Main" main_name :: l -> Name l-main_name l = Ident l "main"+main_name l = Ident l "main" unit_con_name :: l -> QName l-unit_con_name l = Special l (UnitCon l)+unit_con_name l = Special l (UnitCon l) tuple_con_name :: l -> Boxed -> Int -> QName l-tuple_con_name l b i = Special l (TupleCon l b (i+1))+tuple_con_name l b i = Special l (TupleCon l b (i+1)) list_cons_name :: l -> QName l-list_cons_name l = Special l (Cons l)+list_cons_name l = Special l (Cons l) unboxed_singleton_con_name :: l -> QName l unboxed_singleton_con_name l = Special l (UnboxedSingleCon l) unit_con :: l -> Exp l-unit_con l = Con l $ unit_con_name l+unit_con l = Con l $ unit_con_name l tuple_con :: l -> Boxed -> Int -> Exp l-tuple_con l b i = Con l (tuple_con_name l b i)+tuple_con l b i = Con l (tuple_con_name l b i) unboxed_singleton_con :: l -> Exp l unboxed_singleton_con l = Con l (unboxed_singleton_con_name l) as_name, qualified_name, hiding_name, minus_name, bang_name, dot_name, star_name :: l -> Name l-as_name l = Ident l "as"-qualified_name l = Ident l "qualified"-hiding_name l = Ident l "hiding"-minus_name l = Symbol l "-"-bang_name l = Symbol l "!"-dot_name l = Symbol l "."-star_name l = Symbol l "*"+as_name l = Ident l "as"+qualified_name l = Ident l "qualified"+hiding_name l = Ident l "hiding"+minus_name l = Symbol l "-"+bang_name l = Symbol l "!"+dot_name l = Symbol l "."+star_name l = Symbol l "*" export_name, safe_name, unsafe_name, threadsafe_name, stdcall_name, ccall_name :: l -> Name l export_name l = Ident l "export"@@ -1086,22 +1068,22 @@ ccall_name l = Ident l "ccall" unit_tycon_name, fun_tycon_name, list_tycon_name, unboxed_singleton_tycon_name :: l -> QName l-unit_tycon_name l = unit_con_name l-fun_tycon_name l = Special l (FunCon l)-list_tycon_name l = Special l (ListCon l)+unit_tycon_name l = unit_con_name l+fun_tycon_name l = Special l (FunCon l)+list_tycon_name l = Special l (ListCon l) unboxed_singleton_tycon_name l = Special l (UnboxedSingleCon l) tuple_tycon_name :: l -> Boxed -> Int -> QName l-tuple_tycon_name l b i = tuple_con_name l b i+tuple_tycon_name l b i = tuple_con_name l b i unit_tycon, fun_tycon, list_tycon, unboxed_singleton_tycon :: l -> Type l-unit_tycon l = TyCon l $ unit_tycon_name l-fun_tycon l = TyCon l $ fun_tycon_name l-list_tycon l = TyCon l $ list_tycon_name l+unit_tycon l = TyCon l $ unit_tycon_name l+fun_tycon l = TyCon l $ fun_tycon_name l+list_tycon l = TyCon l $ list_tycon_name l unboxed_singleton_tycon l = TyCon l $ unboxed_singleton_tycon_name l tuple_tycon :: l -> Boxed -> Int -> Type l-tuple_tycon l b i = TyCon l (tuple_tycon_name l b i)+tuple_tycon l b i = TyCon l (tuple_tycon_name l b i) ----------------------------------------------------------------------------- -- AST traversal, boiler-plate style@@ -1115,11 +1097,11 @@ instance Functor SpecialCon where fmap f sc = case sc of- UnitCon l -> UnitCon (f l)- ListCon l -> ListCon (f l)- FunCon l -> FunCon (f l)+ UnitCon l -> UnitCon (f l)+ ListCon l -> ListCon (f l)+ FunCon l -> FunCon (f l) TupleCon l b n -> TupleCon (f l) b n- Cons l -> Cons (f l)+ Cons l -> Cons (f l) UnboxedSingleCon l -> UnboxedSingleCon (f l) instance Functor QName where
src/Language/Haskell/Exts/Lexer.hs view
@@ -266,7 +266,10 @@ ( "where", (KW_Where, Nothing) ), -- FFI- ( "foreign", (KW_Foreign, Just (Any [ForeignFunctionInterface])) )+ ( "foreign", (KW_Foreign, Just (Any [ForeignFunctionInterface])) ),++-- Unicode+ ( "\x2200", (KW_Forall, Just (All [UnicodeSyntax, ExplicitForall])) ) ]
src/Language/Haskell/Exts/ParseSyntax.hs view
@@ -1,3 +1,4 @@+{-# OPTIONS_HADDOCK hide #-} module Language.Haskell.Exts.ParseSyntax where import Language.Haskell.Exts.Annotated.Syntax hiding ( Type(..), Asst(..), Exp(..), FieldUpdate(..), XAttr(..), Context(..) ) @@ -7,91 +8,92 @@ -- Expressions as we parse them (and patters, and regular patterns) data PExp l - = Var l (QName l) -- ^ variable - | IPVar l (IPName l) -- ^ implicit parameter variable - | Con l (QName l) -- ^ data constructor - | Lit l (Literal l) -- ^ literal constant - | InfixApp l (PExp l) (QOp l) (PExp l) -- ^ infix application - | App l (PExp l) (PExp l) -- ^ ordinary application - | NegApp l (PExp l) -- ^ negation expression @-@ /exp/ - | Lambda l [Pat l] (PExp l) -- ^ lambda expression - | Let l (Binds l) (PExp l) -- ^ local declarations with @let@ - | If l (PExp l) (PExp l) (PExp l) -- ^ @if@ /exp/ @then@ /exp/ @else@ /exp/ - | Case l (PExp l) [Alt l] -- ^ @case@ /exp/ @of@ /alts/ - | Do l [Stmt l] -- ^ @do@-expression: - -- the last statement in the list - -- should be an expression. - | MDo l [Stmt l] -- ^ @mdo@-expression --- | Tuple [PExp] -- ^ tuple expression - | TupleSection l [Maybe (PExp l)] -- ^ tuple section expression, e.g. @(,,3)@ - | List l [PExp l] -- ^ list expression - | Paren l (PExp l) -- ^ parenthesized expression --- RightSection QOp PExp -- ^ right section @(@/qop/ /exp/@)@ + = Var l (QName l) -- ^ variable + | IPVar l (IPName l) -- ^ implicit parameter variable + | Con l (QName l) -- ^ data constructor + | Lit l (Literal l) -- ^ literal constant + | InfixApp l (PExp l) (QOp l) (PExp l) -- ^ infix application + | App l (PExp l) (PExp l) -- ^ ordinary application + | NegApp l (PExp l) -- ^ negation expression @-@ /exp/ + | Lambda l [Pat l] (PExp l) -- ^ lambda expression + | Let l (Binds l) (PExp l) -- ^ local declarations with @let@ + | If l (PExp l) (PExp l) (PExp l) -- ^ @if@ /exp/ @then@ /exp/ @else@ /exp/ + | Case l (PExp l) [Alt l] -- ^ @case@ /exp/ @of@ /alts/ + | Do l [Stmt l] -- ^ @do@-expression: + -- the last statement in the list + -- should be an expression. + | MDo l [Stmt l] -- ^ @mdo@-expression +-- | Tuple [PExp] -- ^ tuple expression + | TupleSection l [Maybe (PExp l)] -- ^ tuple section expression, e.g. @(,,3)@ + | List l [PExp l] -- ^ list expression + | Paren l (PExp l) -- ^ parenthesized expression +-- RightSection QOp PExp -- ^ right section @(@/qop/ /exp/@)@ | RecConstr l (QName l) [PFieldUpdate l] - -- ^ record construction expression + -- ^ record construction expression | RecUpdate l (PExp l) [PFieldUpdate l] - -- ^ record update expression - | EnumFrom l (PExp l) -- ^ unbounded arithmetic sequence, - -- incrementing by 1 - | EnumFromTo l (PExp l) (PExp l) -- ^ bounded arithmetic sequence, - -- incrementing by 1 - | EnumFromThen l (PExp l) (PExp l) -- ^ unbounded arithmetic sequence, - -- with first two elements given + -- ^ record update expression + | EnumFrom l (PExp l) -- ^ unbounded arithmetic sequence, + -- incrementing by 1 + | EnumFromTo l (PExp l) (PExp l) -- ^ bounded arithmetic sequence, + -- incrementing by 1 + | EnumFromThen l (PExp l) (PExp l) -- ^ unbounded arithmetic sequence, + -- with first two elements given | EnumFromThenTo l (PExp l) (PExp l) (PExp l) - -- ^ bounded arithmetic sequence, - -- with first two elements given - | ParComp l (PExp l) [[QualStmt l]] -- ^ parallel list comprehension - | ExpTypeSig l (PExp l) (S.Type l) - -- ^ expression type signature - | AsPat l (Name l) (PExp l) -- ^ patterns only - | WildCard l -- ^ patterns only - | IrrPat l (PExp l) -- ^ patterns only + -- ^ bounded arithmetic sequence, + -- with first two elements given + | ParComp l (PExp l) [[QualStmt l]] -- ^ parallel list comprehension + | ExpTypeSig l (PExp l) (S.Type l) -- ^ expression type signature + | AsPat l (Name l) (PExp l) -- ^ patterns only + | WildCard l -- ^ patterns only + | IrrPat l (PExp l) -- ^ patterns only -- Post-ops for parsing left sections and regular patterns. Not to be left in the final tree. - | PostOp l (PExp l) (QOp l) -- ^ post-ops - | PreOp l (QOp l) (PExp l) -- ^ pre-ops + | PostOp l (PExp l) (QOp l) -- ^ post-ops + | PreOp l (QOp l) (PExp l) -- ^ pre-ops -- View patterns - | ViewPat l (PExp l) (PExp l) -- ^ patterns only + | ViewPat l (PExp l) (PExp l) -- ^ patterns only -- HaRP - | SeqRP l [PExp l] -- ^ regular patterns only - | GuardRP l (PExp l) [Stmt l] -- ^ regular patterns only - | EitherRP l (PExp l) (PExp l) -- ^ regular patterns only - | CAsRP l (Name l) (PExp l) -- ^ regular patterns only + | SeqRP l [PExp l] -- ^ regular patterns only + | GuardRP l (PExp l) [Stmt l] -- ^ regular patterns only + | EitherRP l (PExp l) (PExp l) -- ^ regular patterns only + | CAsRP l (Name l) (PExp l) -- ^ regular patterns only -- Template Haskell - | VarQuote l (QName l) -- ^ 'x - | TypQuote l (QName l) -- ^ ''T + | VarQuote l (QName l) -- ^ 'x + | TypQuote l (QName l) -- ^ ''T | BracketExp l (Bracket l) | SpliceExp l (Splice l) - | QuasiQuote l String String -- ^ [$...|...] + | QuasiQuote l String String -- ^ [$...|...] -- Hsx | XTag l (XName l) [ParseXAttr l] (Maybe (PExp l)) [PExp l] + -- ^ <Name>...</Name> | XETag l (XName l) [ParseXAttr l] (Maybe (PExp l)) - | XPcdata l String - | XExpTag l (PExp l) - | XRPats l [PExp l] + -- ^ <Name /> + | XPcdata l String -- ^ PCDATA + | XExpTag l (PExp l) -- ^ <% ... %> + | XRPats l [PExp l] -- ^ <[ ... ]> -- Pragmas - | CorePragma l String (PExp l) - | SCCPragma l String (PExp l) + | CorePragma l String (PExp l) -- ^ {-# CORE #-} pragma + | SCCPragma l String (PExp l) -- ^ {-# SCC #-} pragma | GenPragma l String (Int, Int) (Int, Int) (PExp l) --- | UnknownExpPragma String String + -- ^ {-# GENERATED ... #-} pragma -- Generics - | ExplTypeArg l (QName l) (S.Type l) -- ^ f {| Int |} x = ... + | ExplTypeArg l (QName l) (S.Type l) -- ^ f {| Int |} x = ... -- Bang Patterns - | BangPat l (PExp l) -- ^ f !a = ... + | BangPat l (PExp l) -- ^ f !a = ... -- Arrows - | Proc l (Pat l) (PExp l) - | LeftArrApp l (PExp l) (PExp l) - | RightArrApp l (PExp l) (PExp l) - | LeftArrHighApp l (PExp l) (PExp l) - | RightArrHighApp l (PExp l) (PExp l) + | Proc l (Pat l) (PExp l) -- ^ proc p -> do + | LeftArrApp l (PExp l) (PExp l) -- ^ e -< e + | RightArrApp l (PExp l) (PExp l) -- ^ e >- e + | LeftArrHighApp l (PExp l) (PExp l) -- ^ e -<< e + | RightArrHighApp l (PExp l) (PExp l) -- ^ e >>- e deriving (Eq,Show) data PFieldUpdate l
src/Language/Haskell/Exts/ParseUtils.hs view
@@ -788,12 +788,12 @@ else mergeMatches (ms++ms') ds (loc <++> l) mergeMatches ms' ds l = mergeFunBinds (FunBind l ms':revDs) ds mergeFunBinds revDs (FunBind l ims1@(InfixMatch _ _ name _ _ _:_):ds1) =- mergeInfix ims1 ds1 l- where- mergeInfix ims' (FunBind _ ims@(InfixMatch loc _ name' _ _ _:_):ds) l- | name' =~= name =- mergeInfix (ims++ims') ds (loc <++> l)- mergeInfix ms' ds l = mergeFunBinds (FunBind l ms':revDs) ds+ mergeInfix ims1 ds1 l+ where+ mergeInfix ims' (FunBind _ ims@(InfixMatch loc _ name' _ _ _:_):ds) l+ | name' =~= name =+ mergeInfix (ims++ims') ds (loc <++> l)+ mergeInfix ms' ds l = mergeFunBinds (FunBind l ms':revDs) ds mergeFunBinds revDs (d:ds) = mergeFunBinds (d:revDs) ds checkRevClsDecls :: [ClassDecl L] -> P [ClassDecl L]@@ -919,485 +919,16 @@ S.XETag l xn ats mattr -> return $ XmlHybrid (inf<++>l<**(s1 : srcInfoPoints inf ++ s2 : srcInfoPoints l)) mh os is ds xn ats mattr [] -{--pageFun :: L -> S.Exp L -> Decl L-pageFun loc e = PatBind loc namePat Nothing rhs Nothing- where namePat = PVar loc $ Ident loc "page"- rhs = UnGuardedRhs (ann e) e--mkPage :: Module L -> L -> S.Exp L -> P (Module L)-mkPage (Module src mmh os imps decls) loc xml = do- let page = pageFun loc xml- return $ Module src mmh os imps (decls ++ [page])--mkPageModule :: [OptionPragma L] -> S.Exp L -> P (Module L)-mkPageModule os xml = do- do loc <- case xml of- S.XTag l _ _ _ _ -> return l- S.XETag l _ _ _ -> return l- _ -> fail "Will not happen since mkPageModule is only called on XML expressions"- mod <- getModuleName- return $ (Module- loc- (ModuleName loc mod)- os- Nothing- (Just (ExportSpecList loc [EVar loc $ UnQual loc $ Ident loc "page"]))- []- [pageFun loc xml])--} --------------------------------------- -- Handle dash-identifiers mkDVar :: [String] -> String mkDVar = concat . intersperse "-" ---mkDVarExpr :: L -> [String] -> PExp L---mkDVarExpr l = foldl1 (\x y -> InfixApp l x (op $ sym "-") y) . map (Var l . UnQual l . name)- --------------------------------------- -- Combine adjacent for-alls. NO! -- -- A valid type must have one for-all at the top of the type, or of the fn arg types mkTyForall :: L -> Maybe [TyVarBind L] -> Maybe (PContext L) -> PType L -> PType L---mkTyForall l mtvs (PContext _ []) ty = mk_forall_ty l mtvs ty mkTyForall l mtvs ctxt ty = TyForall l mtvs ctxt ty--{-- mk_forall_ty makes a pure for-all type (no context)-mk_forall_ty l (Just []) ty = ty -- Explicit for-all with no tyvars-mk_forall_ty l mtvs1 (TyForall _ mtvs2 ctxt ty) = mkTyForall l (mtvs1 `plus` mtvs2) ctxt ty-mk_forall_ty l mtvs1 ty = TyForall l mtvs1 (PContext l []) ty--mtvs1 `plus` Nothing = mtvs1-Nothing `plus` mtvs2 = mtvs2-(Just tvs1) `plus` (Just tvs2) = Just (tvs1 ++ tvs2)--}-----------------------------------------{-- Expressions as we parse them (and patters, and regular patterns)--data PExp l- = Var l (QName l) -- ^ variable- | IPVar l (IPName l) -- ^ implicit parameter variable- | Con l (QName l) -- ^ data constructor- | Lit l (Literal l) -- ^ literal constant- | InfixApp l (PExp l) (QOp l) (PExp l) -- ^ infix application- | App l (PExp l) (PExp l) -- ^ ordinary application- | NegApp l (PExp l) -- ^ negation expression @-@ /exp/- | Lambda l [Pat l] (PExp l) -- ^ lambda expression- | Let l (Binds l) (PExp l) -- ^ local declarations with @let@- | If l (PExp l) (PExp l) (PExp l) -- ^ @if@ /exp/ @then@ /exp/ @else@ /exp/- | Case l (PExp l) [Alt l] -- ^ @case@ /exp/ @of@ /alts/- | Do l [Stmt l] -- ^ @do@-expression:- -- the last statement in the list- -- should be an expression.- | MDo l [Stmt l] -- ^ @mdo@-expression--- | Tuple [PExp] -- ^ tuple expression- | TupleSection l [Maybe (PExp l)] -- ^ tuple section expression, e.g. @(,,3)@- | List l [PExp l] -- ^ list expression- | Paren l (PExp l) -- ^ parenthesized expression--- RightSection QOp PExp -- ^ right section @(@/qop/ /exp/@)@- | RecConstr l (QName l) [PFieldUpdate l]- -- ^ record construction expression- | RecUpdate l (PExp l) [PFieldUpdate l]- -- ^ record update expression- | EnumFrom l (PExp l) -- ^ unbounded arithmetic sequence,- -- incrementing by 1- | EnumFromTo l (PExp l) (PExp l) -- ^ bounded arithmetic sequence,- -- incrementing by 1- | EnumFromThen l (PExp l) (PExp l) -- ^ unbounded arithmetic sequence,- -- with first two elements given- | EnumFromThenTo l (PExp l) (PExp l) (PExp l)- -- ^ bounded arithmetic sequence,- -- with first two elements given- | ParComp l (PExp l) [[QualStmt l]] -- ^ parallel list comprehension- | ExpTypeSig l (PExp l) (S.Type l)- -- ^ expression type signature- | AsPat l (Name l) (PExp l) -- ^ patterns only- | WildCard l -- ^ patterns only- | IrrPat l (PExp l) -- ^ patterns only---- Post-ops for parsing left sections and regular patterns. Not to be left in the final tree.- | PostOp l (PExp l) (QOp l) -- ^ post-ops- | PreOp l (QOp l) (PExp l) -- ^ pre-ops---- View patterns- | ViewPat l (PExp l) (PExp l) -- ^ patterns only---- HaRP- | SeqRP l [PExp l] -- ^ regular patterns only- | GuardRP l (PExp l) [Stmt l] -- ^ regular patterns only- | EitherRP l (PExp l) (PExp l) -- ^ regular patterns only- | CAsRP l (Name l) (PExp l) -- ^ regular patterns only---- Template Haskell- | VarQuote l (QName l) -- ^ 'x- | TypQuote l (QName l) -- ^ ''T- | BracketExp l (Bracket l)- | SpliceExp l (Splice l)- | QuasiQuote l String String -- ^ [$...|...]---- Hsx- | XTag l (XName l) [ParseXAttr l] (Maybe (PExp l)) [PExp l]- | XETag l (XName l) [ParseXAttr l] (Maybe (PExp l))- | XPcdata l String- | XExpTag l (PExp l)- | XRPats l [PExp l]---- Pragmas- | CorePragma l String (PExp l)- | SCCPragma l String (PExp l)- | GenPragma l String (Int, Int) (Int, Int) (PExp l)--- | UnknownExpPragma String String---- Generics- | ExplTypeArg l (QName l) (S.Type l) -- ^ f {| Int |} x = ...---- Bang Patterns- | BangPat l (PExp l) -- ^ f !a = ...---- Arrows- | Proc l (Pat l) (PExp l)- | LeftArrApp l (PExp l) (PExp l)- | RightArrApp l (PExp l) (PExp l)- | LeftArrHighApp l (PExp l) (PExp l)- | RightArrHighApp l (PExp l) (PExp l)- deriving (Eq,Show)--data PFieldUpdate l- = FieldUpdate l (QName l) (PExp l)- | FieldPun l (Name l)- | FieldWildcard l- deriving (Eq,Show)--data ParseXAttr l = XAttr l (XName l) (PExp l)- deriving (Eq,Show)--instance Annotated PExp where- ann e = case e of- Var l qn -> l- IPVar l ipn -> l- Con l qn -> l- Lit l lit -> l- InfixApp l e1 qop e2 -> l- App l e1 e2 -> l- NegApp l e -> l- Lambda l ps e -> l- Let l bs e -> l- If l ec et ee -> l- Case l e alts -> l- Do l ss -> l- MDo l ss -> l- TupleSection l mes -> l- List l es -> l- Paren l e -> l- RecConstr l qn fups -> l- RecUpdate l e fups -> l- EnumFrom l e -> l- EnumFromTo l ef et -> l- EnumFromThen l ef et -> l- EnumFromThenTo l ef eth eto -> l- ParComp l e qsss -> l- ExpTypeSig l e t -> l- AsPat l n e -> l- WildCard l -> l- IrrPat l e -> l- PostOp l e op -> l- PreOp l op e -> l- ViewPat l e1 e2 -> l- SeqRP l es -> l- GuardRP l e ss -> l- EitherRP l e1 e2 -> l- CAsRP l n e -> l-- VarQuote l qn -> l- TypQuote l qn -> l- BracketExp l br -> l- SpliceExp l sp -> l- QuasiQuote l sn se -> l-- XTag l xn xas me es -> l- XETag l xn xas me -> l- XPcdata l s -> l- XExpTag l e -> l- XRPats l es -> l-- CorePragma l s e -> l- SCCPragma l s e -> l- GenPragma l s n12 n34 e -> l-- ExplTypeArg l qn t -> l- BangPat l e -> l-- Proc l p e -> l- LeftArrApp l e1 e2 -> l- RightArrApp l e1 e2 -> l- LeftArrHighApp l e1 e2 -> l- RightArrHighApp l e1 e2 -> l-- amap f e = case e of- Var l qn -> Var (f l) qn- IPVar l ipn -> IPVar (f l) ipn- Con l qn -> Con (f l) qn- Lit l lit -> Lit (f l) lit- InfixApp l e1 qop e2 -> InfixApp (f l) e1 qop e2- App l e1 e2 -> App (f l) e1 e2- NegApp l e -> NegApp (f l) e- Lambda l ps e -> Lambda (f l) ps e- Let l bs e -> Let (f l) bs e- If l ec et ee -> If (f l) ec et ee- Case l e alts -> Case (f l) e alts- Do l ss -> Do (f l) ss- MDo l ss -> MDo (f l) ss- TupleSection l mes -> TupleSection (f l) mes- List l es -> List (f l) es- Paren l e -> Paren (f l) e- RecConstr l qn fups -> RecConstr (f l) qn fups- RecUpdate l e fups -> RecUpdate (f l) e fups- EnumFrom l e -> EnumFrom (f l) e- EnumFromTo l ef et -> EnumFromTo (f l) ef et- EnumFromThen l ef et -> EnumFromThen (f l) ef et- EnumFromThenTo l ef eth eto -> EnumFromThenTo (f l) ef eth eto- ParComp l e qsss -> ParComp (f l) e qsss- ExpTypeSig l e t -> ExpTypeSig (f l) e t-- AsPat l n e -> AsPat (f l) n e- WildCard l -> WildCard (f l)- IrrPat l e -> IrrPat (f l) e- PostOp l e op -> PostOp (f l) e op- PreOp l op e -> PreOp (f l) op e- ViewPat l e1 e2 -> ViewPat (f l) e1 e2- SeqRP l es -> SeqRP (f l) es- GuardRP l e ss -> GuardRP (f l) e ss- EitherRP l e1 e2 -> EitherRP (f l) e1 e2- CAsRP l n e -> CAsRP (f l) n e- ExplTypeArg l n t -> ExplTypeArg (f l) n t- BangPat l e -> BangPat (f l) e-- VarQuote l qn -> VarQuote (f l) qn- TypQuote l qn -> TypQuote (f l) qn- BracketExp l br -> BracketExp (f l) br- SpliceExp l sp -> SpliceExp (f l) sp- QuasiQuote l sn se -> QuasiQuote (f l) sn se-- XTag l xn xas me es -> XTag (f l) xn xas me es- XETag l xn xas me -> XETag (f l) xn xas me- XPcdata l s -> XPcdata (f l) s- XExpTag l e -> XExpTag (f l) e-- CorePragma l s e -> CorePragma (f l) s e- SCCPragma l s e -> SCCPragma (f l) s e- GenPragma l s n12 n34 e -> GenPragma (f l) s n12 n34 e-- Proc l p e -> Proc (f l) p e- LeftArrApp l e1 e2 -> LeftArrApp (f l) e1 e2- RightArrApp l e1 e2 -> RightArrApp (f l) e1 e2- LeftArrHighApp l e1 e2 -> LeftArrHighApp (f l) e1 e2- RightArrHighApp l e1 e2 -> RightArrHighApp (f l) e1 e2--instance Functor PExp where- fmap f e = case e of- Var l qn -> Var (f l) (fmap f qn)- IPVar l ipn -> IPVar (f l) (fmap f ipn)- Con l qn -> Con (f l) (fmap f qn)- Lit l lit -> Lit (f l) (fmap f lit)- InfixApp l e1 qop e2 -> InfixApp (f l) (fmap f e1) (fmap f qop) (fmap f e2)- App l e1 e2 -> App (f l) (fmap f e1) (fmap f e2)- NegApp l e -> NegApp (f l) (fmap f e)- Lambda l ps e -> Lambda (f l) (map (fmap f) ps) (fmap f e)- Let l bs e -> Let (f l) (fmap f bs) (fmap f e)- If l ec et ee -> If (f l) (fmap f ec) (fmap f et) (fmap f ee)- Case l e alts -> Case (f l) (fmap f e) (map (fmap f) alts)- Do l ss -> Do (f l) (map (fmap f) ss)- MDo l ss -> MDo (f l) (map (fmap f) ss)- TupleSection l mes -> TupleSection (f l) (map (fmap (fmap f)) mes)- List l es -> List (f l) (map (fmap f) es)- Paren l e -> Paren (f l) (fmap f e)- RecConstr l qn fups -> RecConstr (f l) (fmap f qn) (map (fmap f) fups)- RecUpdate l e fups -> RecUpdate (f l) (fmap f e) (map (fmap f) fups)- EnumFrom l e -> EnumFrom (f l) (fmap f e)- EnumFromTo l ef et -> EnumFromTo (f l) (fmap f ef) (fmap f et)- EnumFromThen l ef et -> EnumFromThen (f l) (fmap f ef) (fmap f et)- EnumFromThenTo l ef eth eto -> EnumFromThenTo (f l) (fmap f ef) (fmap f eth) (fmap f eto)- ParComp l e qsss -> ParComp (f l) (fmap f e) (map (map (fmap f)) qsss)- ExpTypeSig l e t -> ExpTypeSig (f l) (fmap f e) (fmap f t)-- AsPat l n e -> AsPat (f l) (fmap f n) (fmap f e)- WildCard l -> WildCard (f l)- IrrPat l e -> IrrPat (f l) (fmap f e)- PostOp l e op -> PostOp (f l) (fmap f e) (fmap f op)- PreOp l op e -> PreOp (f l) (fmap f op) (fmap f e)- ViewPat l e1 e2 -> ViewPat (f l) (fmap f e1) (fmap f e2)- SeqRP l es -> SeqRP (f l) (map (fmap f) es)- GuardRP l e ss -> GuardRP (f l) (fmap f e) (map (fmap f) ss)- EitherRP l e1 e2 -> EitherRP (f l) (fmap f e1) (fmap f e2)- CAsRP l n e -> CAsRP (f l) (fmap f n) (fmap f e)- ExplTypeArg l n t -> ExplTypeArg (f l) (fmap f n) (fmap f t)- BangPat l e -> BangPat (f l) (fmap f e)-- VarQuote l qn -> VarQuote (f l) (fmap f qn)- TypQuote l qn -> TypQuote (f l) (fmap f qn)- BracketExp l br -> BracketExp (f l) (fmap f br)- SpliceExp l sp -> SpliceExp (f l) (fmap f sp)- QuasiQuote l sn se -> QuasiQuote (f l) sn se-- XTag l xn xas me es -> XTag (f l) (fmap f xn) (map (fmap f) xas) (fmap (fmap f) me) (map (fmap f) es)- XETag l xn xas me -> XETag (f l) (fmap f xn) (map (fmap f) xas) (fmap (fmap f) me)- XPcdata l s -> XPcdata (f l) s- XExpTag l e -> XExpTag (f l) (fmap f e)-- CorePragma l s e -> CorePragma (f l) s (fmap f e)- SCCPragma l s e -> SCCPragma (f l) s (fmap f e)- GenPragma l s n12 n34 e -> GenPragma (f l) s n12 n34 (fmap f e)-- Proc l p e -> Proc (f l) (fmap f p) (fmap f e)- LeftArrApp l e1 e2 -> LeftArrApp (f l) (fmap f e1) (fmap f e2)- RightArrApp l e1 e2 -> RightArrApp (f l) (fmap f e1) (fmap f e2)- LeftArrHighApp l e1 e2 -> LeftArrHighApp (f l) (fmap f e1) (fmap f e2)- RightArrHighApp l e1 e2 -> RightArrHighApp (f l) (fmap f e1) (fmap f e2)----instance Functor PFieldUpdate where- fmap f (FieldUpdate l qn e) = FieldUpdate (f l) (fmap f qn) (fmap f e)- fmap f (FieldPun l n) = FieldPun (f l) (fmap f n)- fmap f (FieldWildcard l) = FieldWildcard (f l)--instance Annotated PFieldUpdate where- ann (FieldUpdate l qn e) = l- ann (FieldPun l n) = l- ann (FieldWildcard l) = l- amap f (FieldUpdate l qn e) = FieldUpdate (f l) qn e- amap f (FieldPun l n) = FieldPun (f l) n- amap f (FieldWildcard l) = FieldWildcard (f l)--instance Functor ParseXAttr where- fmap f (XAttr l xn e) = XAttr (f l) (fmap f xn) (fmap f e)--instance Annotated ParseXAttr where- ann (XAttr l _ _) = l- amap f (XAttr l xn e) = XAttr (f l) xn e--p_unit_con :: l -> PExp l-p_unit_con l = Con l (unit_con_name l)--p_tuple_con :: l -> Boxed -> Int -> PExp l-p_tuple_con l b i = Con l (tuple_con_name l b i)--p_unboxed_singleton_con :: l -> PExp l-p_unboxed_singleton_con l = Con l (unboxed_singleton_con_name l)--data PContext l- = CxSingle l (PAsst l)- | CxTuple l [PAsst l]- | CxParen l (PContext l)- | CxEmpty l- deriving (Eq, Show)--instance Functor PContext where- fmap f (CxSingle l asst) = CxSingle (f l) (fmap f asst)- fmap f (CxTuple l assts) = CxTuple (f l) (map (fmap f) assts)- fmap f (CxParen l ctxt) = CxParen (f l) (fmap f ctxt)- fmap f (CxEmpty l) = CxEmpty (f l)--instance Annotated PContext where- ann (CxSingle l asst ) = l- ann (CxTuple l assts) = l- ann (CxParen l ctxt ) = l- ann (CxEmpty l) = l- amap f (CxSingle l asst ) = CxSingle (f l) asst- amap f (CxTuple l assts) = CxTuple (f l) assts- amap f (CxParen l ctxt ) = CxParen (f l) ctxt- amap f (CxEmpty l) = CxEmpty (f l)--data PType l- = TyForall l- (Maybe [TyVarBind l])- (Maybe (PContext l))- (PType l)- | TyFun l (PType l) (PType l) -- ^ function type- | TyTuple l Boxed [PType l] -- ^ tuple type, possibly boxed- | TyList l (PType l) -- ^ list syntax, e.g. [a], as opposed to [] a- | TyApp l (PType l) (PType l) -- ^ application of a type constructor- | TyVar l (Name l) -- ^ type variable- | TyCon l (QName l) -- ^ named type or type constructor- | TyParen l (PType l) -- ^ type surrounded by parentheses- | TyPred l (PAsst l) -- ^ assertion of an implicit parameter- | TyInfix l (PType l) (QName l) (PType l) -- ^ infix type constructor- | TyKind l (PType l) (Kind l) -- ^ type with explicit kind signature- deriving (Eq, Show)--instance Functor PType where- fmap f t = case t of- TyForall l mtvs mcx t -> TyForall (f l) (fmap (map (fmap f)) mtvs) (fmap (fmap f) mcx) (fmap f t)- TyFun l t1 t2 -> TyFun (f l) (fmap f t1) (fmap f t2)- TyTuple l b ts -> TyTuple (f l) b (map (fmap f) ts)- TyList l t -> TyList (f l) (fmap f t)- TyApp l t1 t2 -> TyApp (f l) (fmap f t1) (fmap f t2)- TyVar l n -> TyVar (f l) (fmap f n)- TyCon l qn -> TyCon (f l) (fmap f qn)- TyParen l t -> TyParen (f l) (fmap f t)- TyPred l asst -> TyPred (f l) (fmap f asst)- TyInfix l ta qn tb -> TyInfix (f l) (fmap f ta) (fmap f qn) (fmap f tb)- TyKind l t k -> TyKind (f l) (fmap f t) (fmap f k)--instance Annotated PType where- ann t = case t of- TyForall l mtvs cx t -> l- TyFun l t1 t2 -> l- TyTuple l b ts -> l- TyList l t -> l- TyApp l t1 t2 -> l- TyVar l n -> l- TyCon l qn -> l- TyParen l t -> l- TyInfix l ta qn tb -> l- TyKind l t k -> l- amap f t = case t of- TyForall l mtvs mcx t -> TyForall (f l) mtvs mcx t- TyFun l t1 t2 -> TyFun (f l) t1 t2- TyTuple l b ts -> TyTuple (f l) b ts- TyList l t -> TyList (f l) t- TyApp l t1 t2 -> TyApp (f l) t1 t2- TyVar l n -> TyVar (f l) n- TyCon l qn -> TyCon (f l) qn- TyParen l t -> TyParen (f l) t- TyInfix l ta qn tb -> TyInfix (f l) ta qn tb- TyKind l t k -> TyKind (f l) t k--data PAsst l- = ClassA l (QName l) [PType l]- | InfixA l (PType l) (QName l) (PType l)- | IParam l (IPName l) (PType l)- | EqualP l (PType l) (PType l)- deriving (Eq, Show)--instance Functor PAsst where- fmap f asst = case asst of- ClassA l qn ts -> ClassA (f l) (fmap f qn) (map (fmap f) ts)- InfixA l ta qn tb -> InfixA (f l) (fmap f ta) (fmap f qn) (fmap f tb)- IParam l ipn t -> IParam (f l) (fmap f ipn) (fmap f t)- EqualP l t1 t2 -> EqualP (f l) (fmap f t1) (fmap f t2)--instance Annotated PAsst where- ann asst = case asst of- ClassA l qn ts -> l- InfixA l ta qn tb -> l- IParam l ipn t -> l- EqualP l t1 t2 -> l- amap f asst = case asst of- ClassA l qn ts -> ClassA (f l) qn ts- InfixA l ta qn tb -> InfixA (f l) ta qn tb- IParam l ipn t -> IParam (f l) ipn t- EqualP l t1 t2 -> EqualP (f l) t1 t2---unit_tycon, fun_tycon, list_tycon, unboxed_singleton_tycon :: l -> PType l-unit_tycon l = TyCon l (unit_tycon_name l)-fun_tycon l = TyCon l (fun_tycon_name l)-list_tycon l = TyCon l (list_tycon_name l)-unboxed_singleton_tycon l = TyCon l (unboxed_singleton_tycon_name l)--tuple_tycon :: l -> Boxed -> Int -> PType l-tuple_tycon l b i = TyCon l (tuple_tycon_name l b i)--}
src/Language/Haskell/Exts/Pretty.hs view
@@ -129,7 +129,7 @@ type Doc = DocM PPHsMode P.Doc -- | Things that can be pretty-printed, including all the syntactic objects--- in "Language.Haskell.Exts.Syntax".+-- in "Language.Haskell.Exts.Syntax" and "Language.Haskell.Exts.Annotated.Syntax". class Pretty a where -- | Pretty-print something in isolation. pretty :: a -> Doc
src/Language/Haskell/Exts/SrcLoc.hs view
@@ -65,10 +65,13 @@ mkSrcSpan (SrcLoc fn sl sc) (SrcLoc _ el ec) = SrcSpan fn sl sc el ec -- | Merge two source spans into a single span from the start of the first --- to the end of the second. Assumes that the two spans are given in the --- order they appear in the source. +-- to the end of the second. Assumes that the two spans relate to the +-- same source file. mergeSrcSpan :: SrcSpan -> SrcSpan -> SrcSpan -mergeSrcSpan (SrcSpan fn sl sc _ _) (SrcSpan _ _ _ el ec) = SrcSpan fn sl sc el ec +mergeSrcSpan (SrcSpan fn sl1 sc1 el1 ec1) (SrcSpan _ sl2 sc2 el2 ec2) = + let (sl,sc) = min (sl1,sc1) (sl2,sc2) + (el,ec) = max (el1,ec1) (el2,ec2) + in SrcSpan fn sl sc el ec -- | Test if a given span starts and ends at the same location. isNullSpan :: SrcSpan -> Bool @@ -95,29 +98,41 @@ deriving (Eq,Ord,Show) #endif - +-- | Generate a 'SrcSpanInfo' with no positional information for entities. noInfoSpan :: SrcSpan -> SrcSpanInfo noInfoSpan ss = SrcSpanInfo ss [] +-- | Generate a 'SrcSpanInfo' with the supplied positional information for entities. infoSpan :: SrcSpan -> [SrcSpan] -> SrcSpanInfo -infoSpan x y = SrcSpanInfo x y +infoSpan = SrcSpanInfo -(<++>), combSpanInfo :: SrcSpanInfo -> SrcSpanInfo -> SrcSpanInfo +-- | Combine two 'SrcSpanInfo's into one that spans the combined source area of +-- the two arguments, leaving positional information blank. +combSpanInfo :: SrcSpanInfo -> SrcSpanInfo -> SrcSpanInfo combSpanInfo s1 s2 = SrcSpanInfo (mergeSrcSpan (srcInfoSpan s1) (srcInfoSpan s2)) [] +-- | Short name for 'combSpanInfo' +(<++>) :: SrcSpanInfo -> SrcSpanInfo -> SrcSpanInfo (<++>) = combSpanInfo +-- | Optionally combine the first argument with the second, +-- or return it unchanged if the second argument is 'Nothing'. (<+?>) :: SrcSpanInfo -> Maybe SrcSpanInfo -> SrcSpanInfo a <+?> b = case b of {Nothing -> a; Just b -> a <++> b} +-- | Optionally combine the second argument with the first, +-- or return it unchanged if the first argument is 'Nothing'. (<?+>) :: Maybe SrcSpanInfo -> SrcSpanInfo -> SrcSpanInfo a <?+> b = case a of {Nothing -> b; Just a -> a <++> b} +-- | Add more positional information for entities of a span. (<**) :: SrcSpanInfo -> [SrcSpan] -> SrcSpanInfo ss@(SrcSpanInfo {srcInfoPoints = ps}) <** xs = ss {srcInfoPoints = ps ++ xs} +-- | Merge two 'SrcSpan's and lift them to a 'SrcInfoSpan' with +-- no positional information for entities. (<^^>) :: SrcSpan -> SrcSpan -> SrcSpanInfo a <^^> b = noInfoSpan (mergeSrcSpan a b) @@ -125,6 +140,7 @@ infixl 5 <++> infixl 4 <**, <+?>, <?+> +-- | A class to work over all kinds of source location information. class SrcInfo si where toSrcInfo :: SrcLoc -> [SrcSpan] -> SrcLoc -> si fromSrcInfo :: SrcSpanInfo -> si
src/Language/Haskell/Exts/Syntax.hs view
@@ -107,18 +107,6 @@ import Language.Haskell.Exts.Annotated.Syntax (Boxed(..), Tool(..)) -{-- | A position in the source.-data SrcLoc = SrcLoc {- srcFilename :: String,- srcLine :: Int,- srcColumn :: Int- }-#ifdef __GLASGOW_HASKELL__- deriving (Eq,Ord,Show,Typeable,Data)-#else- deriving (Eq,Ord,Show)-#endif--} -- | The name of a Haskell module. newtype ModuleName = ModuleName String@@ -131,15 +119,14 @@ -- | Constructors with special syntax. -- These names are never qualified, and always refer to builtin type or -- data constructors.- data SpecialCon- = UnitCon -- ^ unit type and data constructor @()@- | ListCon -- ^ list type constructor @[]@- | FunCon -- ^ function type constructor @->@+ = UnitCon -- ^ unit type and data constructor @()@+ | ListCon -- ^ list type constructor @[]@+ | FunCon -- ^ function type constructor @->@ | TupleCon Boxed Int -- ^ /n/-ary tuple type and data -- constructors @(,)@ etc, possibly boxed @(\#,\#)@- | Cons -- ^ list data constructor @(:)@- | UnboxedSingleCon -- ^ unboxed singleton tuple constructor @(\# \#)@+ | Cons -- ^ list data constructor @(:)@+ | UnboxedSingleCon -- ^ unboxed singleton tuple constructor @(\# \#)@ #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data) #else@@ -147,7 +134,7 @@ #endif -- | This type is used to represent qualified variables, and also--- qualified constructors.+-- qualified constructors. data QName = Qual ModuleName Name -- ^ name qualified with a module name | UnQual Name -- ^ unqualified local name@@ -199,7 +186,7 @@ #endif -- | A name (/cname/) of a component of a class or data type in an @import@--- or export specification.+-- or export specification. data CName = VarName Name -- ^ name of a method or field | ConName Name -- ^ name of a data constructor@@ -220,18 +207,18 @@ -- | An item in a module's export specification. data ExportSpec- = EVar QName -- ^ variable- | EAbs QName -- ^ @T@:- -- a class or datatype exported abstractly,- -- or a type synonym.- | EThingAll QName -- ^ @T(..)@:- -- a class exported with all of its methods, or- -- a datatype exported with all of its constructors.- | EThingWith QName [CName] -- ^ @T(C_1,...,C_n)@:- -- a class exported with some of its methods, or- -- a datatype exported with some of its constructors.- | EModuleContents ModuleName -- ^ @module M@:- -- re-export a module.+ = EVar QName -- ^ variable+ | EAbs QName -- ^ @T@:+ -- a class or datatype exported abstractly,+ -- or a type synonym.+ | EThingAll QName -- ^ @T(..)@:+ -- a class exported with all of its methods, or+ -- a datatype exported with all of its constructors.+ | EThingWith QName [CName] -- ^ @T(C_1,...,C_n)@:+ -- a class exported with some of its methods, or+ -- a datatype exported with some of its constructors.+ | EModuleContents ModuleName -- ^ @module M@:+ -- re-export a module. #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data) #else@@ -260,15 +247,15 @@ -- | An import specification, representing a single explicit item imported -- (or hidden) from a module. data ImportSpec- = IVar Name -- ^ variable- | IAbs Name -- ^ @T@:- -- the name of a class, datatype or type synonym.+ = IVar Name -- ^ variable+ | IAbs Name -- ^ @T@:+ -- the name of a class, datatype or type synonym. | IThingAll Name -- ^ @T(..)@:- -- a class imported with all of its methods, or- -- a datatype imported with all of its constructors.+ -- a class imported with all of its methods, or+ -- a datatype imported with all of its constructors. | IThingWith Name [CName] -- ^ @T(C_1,...,C_n)@:- -- a class imported with some of its methods, or- -- a datatype imported with some of its constructors.+ -- a class imported with some of its methods, or+ -- a datatype imported with some of its constructors. #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data) #else@@ -470,7 +457,7 @@ data Rhs = UnGuardedRhs Exp -- ^ unguarded right hand side (/exp/) | GuardedRhss [GuardedRhs]- -- ^ guarded right hand side (/gdrhs/)+ -- ^ guarded right hand side (/gdrhs/) #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data) #else@@ -510,15 +497,6 @@ deriving (Eq,Ord,Show) #endif -{-- | Flag denoting whether a tuple is boxed or unboxed.-data Boxed = Boxed | Unboxed-#ifdef __GLASGOW_HASKELL__- deriving (Eq,Ord,Show,Typeable,Data)-#else- deriving (Eq,Ord,Show)-#endif---}- -- | A type variable declaration, optionally with an explicit kind annotation. data TyVarBind = KindedVar Name Kind -- ^ variable binding with kind annotation@@ -605,8 +583,8 @@ | If Exp Exp Exp -- ^ @if@ /exp/ @then@ /exp/ @else@ /exp/ | Case Exp [Alt] -- ^ @case@ /exp/ @of@ /alts/ | Do [Stmt] -- ^ @do@-expression:- -- the last statement in the list- -- should be an expression.+ -- the last statement in the list+ -- should be an expression. | MDo [Stmt] -- ^ @mdo@-expression | Tuple [Exp] -- ^ tuple expression | TupleSection [Maybe Exp] -- ^ tuple section expression, e.g. @(,,3)@@@ -615,22 +593,21 @@ | LeftSection Exp QOp -- ^ left section @(@/exp/ /qop/@)@ | RightSection QOp Exp -- ^ right section @(@/qop/ /exp/@)@ | RecConstr QName [FieldUpdate]- -- ^ record construction expression+ -- ^ record construction expression | RecUpdate Exp [FieldUpdate]- -- ^ record update expression+ -- ^ record update expression | EnumFrom Exp -- ^ unbounded arithmetic sequence,- -- incrementing by 1: @[from ..]@+ -- incrementing by 1: @[from ..]@ | EnumFromTo Exp Exp -- ^ bounded arithmetic sequence,- -- incrementing by 1 @[from .. to]@+ -- incrementing by 1 @[from .. to]@ | EnumFromThen Exp Exp -- ^ unbounded arithmetic sequence,- -- with first two elements given @[from, then ..]@+ -- with first two elements given @[from, then ..]@ | EnumFromThenTo Exp Exp Exp -- ^ bounded arithmetic sequence,- -- with first two elements given @[from, then .. to]@- | ListComp Exp [QualStmt] -- ^ ordinary list comprehension- | ParComp Exp [[QualStmt]] -- ^ parallel list comprehension- | ExpTypeSig SrcLoc Exp Type- -- ^ expression with explicit type signature+ -- with first two elements given @[from, then .. to]@+ | ListComp Exp [QualStmt] -- ^ ordinary list comprehension+ | ParComp Exp [[QualStmt]] -- ^ parallel list comprehension+ | ExpTypeSig SrcLoc Exp Type -- ^ expression with explicit type signature | VarQuote QName -- ^ @'x@ for template haskell reifying of expressions | TypQuote QName -- ^ @''T@ for template haskell reifying of types@@ -738,15 +715,6 @@ deriving (Eq,Ord,Show) #endif -{-- | Recognised tools for OPTIONS pragmas.-data Tool = GHC | HUGS | NHC98 | YHC | HADDOCK | UnknownTool String-#ifdef __GLASGOW_HASKELL__- deriving (Eq,Ord,Show,Typeable,Data)-#else- deriving (Eq,Ord,Show)-#endif--}- -- | Activation clause of a RULES pragma. data Activation = AlwaysActive@@ -791,25 +759,22 @@ -- | A pattern, to be matched against a value. data Pat- = PVar Name -- ^ variable- | PLit Literal -- ^ literal constant- | PNeg Pat -- ^ negated pattern- | PNPlusK Name Integer -- ^ n+k pattern- | PInfixApp Pat QName Pat- -- ^ pattern with an infix data constructor- | PApp QName [Pat] -- ^ data constructor and argument patterns- | PTuple [Pat] -- ^ tuple pattern- | PList [Pat] -- ^ list pattern- | PParen Pat -- ^ parenthesized pattern- | PRec QName [PatField] -- ^ labelled pattern, record style- | PAsPat Name Pat -- ^ @\@@-pattern- | PWildCard -- ^ wildcard pattern: @_@- | PIrrPat Pat -- ^ irrefutable pattern: @~/pat/@+ = PVar Name -- ^ variable+ | PLit Literal -- ^ literal constant+ | PNeg Pat -- ^ negated pattern+ | PNPlusK Name Integer -- ^ n+k pattern+ | PInfixApp Pat QName Pat -- ^ pattern with an infix data constructor+ | PApp QName [Pat] -- ^ data constructor and argument patterns+ | PTuple [Pat] -- ^ tuple pattern+ | PList [Pat] -- ^ list pattern+ | PParen Pat -- ^ parenthesized pattern+ | PRec QName [PatField] -- ^ labelled pattern, record style+ | PAsPat Name Pat -- ^ @\@@-pattern+ | PWildCard -- ^ wildcard pattern: @_@+ | PIrrPat Pat -- ^ irrefutable pattern: @~/pat/@ | PatTypeSig SrcLoc Pat Type -- ^ pattern with type signature- | PViewPat Exp Pat -- ^ view patterns of the form @(/exp/ -> /pat/)@-- | PRPat [RPat] -- ^ regular list pattern-+ | PViewPat Exp Pat -- ^ view patterns of the form @(/exp/ -> /pat/)@+ | PRPat [RPat] -- ^ regular list pattern | PXTag SrcLoc XName [PXAttr] (Maybe Pat) [Pat] -- ^ XML element pattern | PXETag SrcLoc XName [PXAttr] (Maybe Pat)@@ -818,11 +783,8 @@ | PXPatTag Pat -- ^ XML embedded pattern | PXRPats [RPat] -- ^ XML regular list pattern | PExplTypeArg QName Type -- ^ Explicit generics style type argument e.g. @f {| Int |} x = ...@- | PQuasiQuote String String -- ^ quasi quote patter: @[$/name/| /string/ |]@- | PBangPat Pat -- ^ strict (bang) pattern: @f !x = ...@- #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data) #else@@ -853,14 +815,14 @@ -- | An entity in a regular pattern. data RPat- = RPOp RPat RPatOp- | RPEither RPat RPat- | RPSeq [RPat]- | RPGuard Pat [Stmt]- | RPCAs Name RPat- | RPAs Name RPat- | RPParen RPat- | RPPat Pat+ = RPOp RPat RPatOp -- ^ operator pattern, e.g. pat*+ | RPEither RPat RPat -- ^ choice pattern, e.g. (1 | 2)+ | RPSeq [RPat] -- ^ sequence pattern, e.g. (| 1, 2, 3 |)+ | RPGuard Pat [Stmt] -- ^ guarded pattern, e.g. (| p | p < 3 |)+ | RPCAs Name RPat -- ^ non-linear variable binding, e.g. (foo@:(1 | 2))*+ | RPAs Name RPat -- ^ linear variable binding, e.g. foo@(1 | 2)+ | RPParen RPat -- ^ parenthesised pattern, e.g. (2*)+ | RPPat Pat -- ^ an ordinary pattern #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data) #else@@ -883,12 +845,12 @@ -- in a pattern guard. data Stmt = Generator SrcLoc Pat Exp- -- ^ a generator: /pat/ @<-@ /exp/- | Qualifier Exp -- ^ an /exp/ by itself: in a @do@-expression,- -- an action whose result is discarded;- -- in a list comprehension and pattern guard,- -- a guard expression- | LetStmt Binds -- ^ local bindings+ -- ^ a generator: /pat/ @<-@ /exp/+ | Qualifier Exp -- ^ an /exp/ by itself: in a @do@-expression,+ -- an action whose result is discarded;+ -- in a list comprehension and pattern guard,+ -- a guard expression+ | LetStmt Binds -- ^ local bindings | RecStmt [Stmt] -- ^ a recursive binding group for arrows #ifdef __GLASGOW_HASKELL__ deriving (Eq,Ord,Show,Typeable,Data)@@ -957,64 +919,64 @@ -- Builtin names. prelude_mod, main_mod :: ModuleName-prelude_mod = ModuleName "Prelude"-main_mod = ModuleName "Main"+prelude_mod = ModuleName "Prelude"+main_mod = ModuleName "Main" main_name :: Name-main_name = Ident "main"+main_name = Ident "main" unit_con_name :: QName-unit_con_name = Special UnitCon+unit_con_name = Special UnitCon tuple_con_name :: Boxed -> Int -> QName-tuple_con_name b i = Special (TupleCon b (i+1))+tuple_con_name b i = Special (TupleCon b (i+1)) list_cons_name :: QName-list_cons_name = Special Cons+list_cons_name = Special Cons unboxed_singleton_con_name :: QName unboxed_singleton_con_name = Special UnboxedSingleCon unit_con :: Exp-unit_con = Con unit_con_name+unit_con = Con unit_con_name tuple_con :: Boxed -> Int -> Exp-tuple_con b i = Con (tuple_con_name b i)+tuple_con b i = Con (tuple_con_name b i) unboxed_singleton_con :: Exp unboxed_singleton_con = Con (unboxed_singleton_con_name) as_name, qualified_name, hiding_name, minus_name, bang_name, dot_name, star_name :: Name-as_name = Ident "as"-qualified_name = Ident "qualified"-hiding_name = Ident "hiding"-minus_name = Symbol "-"-bang_name = Symbol "!"-dot_name = Symbol "."-star_name = Symbol "*"+as_name = Ident "as"+qualified_name = Ident "qualified"+hiding_name = Ident "hiding"+minus_name = Symbol "-"+bang_name = Symbol "!"+dot_name = Symbol "."+star_name = Symbol "*" export_name, safe_name, unsafe_name, threadsafe_name, stdcall_name, ccall_name :: Name export_name = Ident "export" safe_name = Ident "safe" unsafe_name = Ident "unsafe"-threadsafe_name = Ident "threadsafe"-stdcall_name = Ident "stdcall"+threadsafe_name = Ident "threadsafe"+stdcall_name = Ident "stdcall" ccall_name = Ident "ccall" unit_tycon_name, fun_tycon_name, list_tycon_name, unboxed_singleton_tycon_name :: QName-unit_tycon_name = unit_con_name-fun_tycon_name = Special FunCon-list_tycon_name = Special ListCon+unit_tycon_name = unit_con_name+fun_tycon_name = Special FunCon+list_tycon_name = Special ListCon unboxed_singleton_tycon_name = Special UnboxedSingleCon tuple_tycon_name :: Boxed -> Int -> QName-tuple_tycon_name b i = tuple_con_name b i+tuple_tycon_name b i = tuple_con_name b i unit_tycon, fun_tycon, list_tycon, unboxed_singleton_tycon :: Type-unit_tycon = TyCon unit_tycon_name-fun_tycon = TyCon fun_tycon_name-list_tycon = TyCon list_tycon_name+unit_tycon = TyCon unit_tycon_name+fun_tycon = TyCon fun_tycon_name+list_tycon = TyCon list_tycon_name unboxed_singleton_tycon = TyCon unboxed_singleton_tycon_name tuple_tycon :: Boxed -> Int -> Type-tuple_tycon b i = TyCon (tuple_tycon_name b i)+tuple_tycon b i = TyCon (tuple_tycon_name b i)