{-# OPTIONS_HADDOCK hide #-} module Language.Haskell.Exts.ParseSyntax where import Language.Haskell.Exts.Annotated.Syntax hiding ( Type(..), Asst(..), Exp(..), FieldUpdate(..), XAttr(..), Context(..) ) import qualified Language.Haskell.Exts.Annotated.Syntax as S ( Type(..), Asst(..), Exp(..), FieldUpdate(..), XAttr(..), Context(..) ) --------------------------------------- -- Expressions as we parse them (and patterns, 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 Boxed [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] -- ^ <Name>...</Name> | XETag l (XName l) [ParseXAttr l] (Maybe (PExp l)) -- ^ <Name /> | XPcdata l String -- ^ PCDATA | XExpTag l (PExp l) -- ^ <% ... %> | XChildTag l [PExp l] -- ^ <%> ... </%> | XRPats l [PExp l] -- ^ <[ ... ]> -- Pragmas | CorePragma l String (PExp l) -- ^ {-# CORE #-} pragma | SCCPragma l String (PExp l) -- ^ {-# SCC #-} pragma | GenPragma l String (Int, Int) (Int, Int) (PExp l) -- ^ {-# GENERATED ... #-} pragma -- 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) -- ^ 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 = 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 bx 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 XChildTag l es -> 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 bx mes -> TupleSection (f l) bx 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 XChildTag l es -> XChildTag (f l) es XRPats l es -> XRPats (f l) es 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 bx mes -> TupleSection (f l) bx (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) XChildTag l es -> XChildTag (f l) (map (fmap f) es) XRPats l es -> XRPats (f l) (map (fmap f) es) 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)