diff --git a/haskell-src-exts.cabal b/haskell-src-exts.cabal
--- a/haskell-src-exts.cabal
+++ b/haskell-src-exts.cabal
@@ -1,5 +1,5 @@
Name: haskell-src-exts
-Version: 1.7.0
+Version: 1.7.1
License: BSD3
License-File: LICENSE
Author: Niklas Broberg
diff --git a/src/Language/Haskell/Exts/Annotated/Simplify.hs b/src/Language/Haskell/Exts/Annotated/Simplify.hs
--- a/src/Language/Haskell/Exts/Annotated/Simplify.hs
+++ b/src/Language/Haskell/Exts/Annotated/Simplify.hs
@@ -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)
diff --git a/src/Language/Haskell/Exts/Annotated/Syntax.hs b/src/Language/Haskell/Exts/Annotated/Syntax.hs
--- a/src/Language/Haskell/Exts/Annotated/Syntax.hs
+++ b/src/Language/Haskell/Exts/Annotated/Syntax.hs
@@ -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
diff --git a/src/Language/Haskell/Exts/Lexer.hs b/src/Language/Haskell/Exts/Lexer.hs
--- a/src/Language/Haskell/Exts/Lexer.hs
+++ b/src/Language/Haskell/Exts/Lexer.hs
@@ -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])) )
]
diff --git a/src/Language/Haskell/Exts/ParseSyntax.hs b/src/Language/Haskell/Exts/ParseSyntax.hs
--- a/src/Language/Haskell/Exts/ParseSyntax.hs
+++ b/src/Language/Haskell/Exts/ParseSyntax.hs
@@ -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]
+ -- ^ ...
| XETag l (XName l) [ParseXAttr l] (Maybe (PExp l))
- | XPcdata l String
- | XExpTag l (PExp l)
- | XRPats l [PExp l]
+ -- ^
+ | 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
diff --git a/src/Language/Haskell/Exts/ParseUtils.hs b/src/Language/Haskell/Exts/ParseUtils.hs
--- a/src/Language/Haskell/Exts/ParseUtils.hs
+++ b/src/Language/Haskell/Exts/ParseUtils.hs
@@ -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)
--}
diff --git a/src/Language/Haskell/Exts/Pretty.hs b/src/Language/Haskell/Exts/Pretty.hs
--- a/src/Language/Haskell/Exts/Pretty.hs
+++ b/src/Language/Haskell/Exts/Pretty.hs
@@ -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
diff --git a/src/Language/Haskell/Exts/SrcLoc.hs b/src/Language/Haskell/Exts/SrcLoc.hs
--- a/src/Language/Haskell/Exts/SrcLoc.hs
+++ b/src/Language/Haskell/Exts/SrcLoc.hs
@@ -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
diff --git a/src/Language/Haskell/Exts/Syntax.hs b/src/Language/Haskell/Exts/Syntax.hs
--- a/src/Language/Haskell/Exts/Syntax.hs
+++ b/src/Language/Haskell/Exts/Syntax.hs
@@ -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)