Plain Haskell source file:
HsExpMaps.hs
-- $Id: HsExpMaps.hs,v 1.10 2001/10/09 02:10:28 hallgren Exp $
Maps for the E functor.
module HsExpMaps where
import HsExpStruct
import HsIdent
import HsGuardsMaps(mapAlt, accAlt, seqAlt)
import AccList(accList)
import MUtils
mapEI ::(i1 -> i2) ->
(e1 -> e2) ->
(p1 -> p2) ->
(d1 -> d2) ->
(t1 -> t2) ->
(c1 -> c2) ->
EI i1 e1 p1 d1 t1 c1 ->
EI i2 e2 p2 d2 t2 c2
mapEI idf ef pf df tf cf exp =
case exp of
HsId n -> HsId (mapHsIdent idf n)
HsLit l -> HsLit l
HsInfixApp x op z -> HsInfixApp (ef x) (mapHsIdent idf op) (ef z)
HsApp x y -> HsApp (ef x) (ef y)
HsNegApp x -> HsNegApp (ef x)
HsLambda ps e -> HsLambda (map pf ps) (ef e)
HsLet ds e -> HsLet (df ds) (ef e)
HsIf x y z -> HsIf (ef x) (ef y) (ef z)
HsCase e alts -> HsCase (ef e) (map (mapAlt ef pf df) alts)
HsDo stmts -> HsDo (mapStmt stmts)
HsTuple xs -> HsTuple (map ef xs)
HsList xs -> HsList (map ef xs)
HsParen x -> HsParen (ef x)
HsLeftSection x op -> HsLeftSection (ef x) (mapHsIdent idf op)
HsRightSection op y -> HsRightSection (mapHsIdent idf op) (ef y)
HsRecConstr n upds -> HsRecConstr (idf n)
(map mapFieldUpdateI upds)
HsRecUpdate e upds -> HsRecUpdate (ef e)
(map mapFieldUpdateI upds)
HsEnumFrom x -> HsEnumFrom (ef x)
HsEnumFromTo x y -> HsEnumFromTo (ef x) (ef y)
HsEnumFromThen x y -> HsEnumFromThen (ef x) (ef y)
HsEnumFromThenTo x y z -> HsEnumFromThenTo (ef x) (ef y) (ef z)
HsListComp stmts -> HsListComp (mapStmt stmts)
HsExpTypeSig s e c t -> HsExpTypeSig s (ef e) (cf c) (tf t)
HsAsPat n e -> HsAsPat (idf n) (ef e) -- pattern only
HsWildCard -> HsWildCard -- ditto
HsIrrPat e -> HsIrrPat (ef e) -- ditto
where
mapFieldUpdateI (HsFieldBind n) = HsFieldBind (idf n)
mapFieldUpdateI (HsFieldUpdate n e) = HsFieldUpdate (idf n) (ef e)
mapStmt (HsGenerator p e s) = HsGenerator (pf p) (ef e) (mapStmt s)
mapStmt (HsQualifier e s) = HsQualifier (ef e) (mapStmt s)
mapStmt (HsLetStmt ds s) = HsLetStmt (df ds) (mapStmt s)
mapStmt (HsLast e) = HsLast (ef e)
Accumulator for the E functor.
accEI ::(i -> b -> b) ->
(e -> b -> b) ->
(p -> b -> b) ->
(d -> b -> b) ->
(t -> b -> b) ->
(c -> b -> b) ->
EI i e p d t c ->
b ->
b
accEI idf ef pf df tf cf exp =
case exp of
HsId n -> accHsIdent idf n
HsLit l -> id
HsInfixApp x op z -> ef x . accHsIdent idf op . ef z
HsApp x y -> ef x . ef y
HsNegApp x -> ef x
HsLambda ps e -> ef e . accList pf ps
HsLet ds e -> ef e . df ds
HsIf x y z -> ef x . ef y . ef z
HsCase e alts -> ef e . accList (accAlt ef pf df) alts
HsDo stmts -> accStmt df ef pf stmts
HsTuple xs -> accList ef xs
HsList xs -> accList ef xs
HsParen x -> ef x
HsLeftSection x op -> ef x . accHsIdent idf op
HsRightSection op y -> accHsIdent idf op . ef y
HsRecConstr n upds -> idf n . accList (accFieldUpdateI idf ef) upds
HsRecUpdate e upds -> ef e . accList (accFieldUpdateI idf ef) upds
HsEnumFrom x -> ef x
HsEnumFromTo x y -> ef x . ef y
HsEnumFromThen x y -> ef x . ef y
HsEnumFromThenTo x y z -> ef x . ef y . ef z
HsListComp stmts -> accStmt df ef pf stmts
HsExpTypeSig s e c t -> ef e . cf c . tf t
HsAsPat n e -> idf n . ef e -- pattern only
HsWildCard -> id -- ditto
HsIrrPat e -> ef e -- ditto
accFieldUpdateI idf ef (HsFieldBind n) = idf n
accFieldUpdateI idf ef (HsFieldUpdate n e) = idf n . ef e
accStmt df ef pf (HsGenerator p e s) = pf p . ef e . accStmt df ef pf s
accStmt df ef pf (HsQualifier e s) = ef e . accStmt df ef pf s
accStmt df ef pf (HsLetStmt ds s) = df ds . accStmt df ef pf s
accStmt df ef pf (HsLast e) = ef e
---------
seqEI :: (Monad m,Functor m) =>
EI (m i) (m e) (m p) (m ds) (m t) (m c) ->
m (EI i e p ds t c)
seqEI exp =
case exp of
HsId n -> HsId # seqHsIdent n
HsLit l -> return $ HsLit l
HsInfixApp x op z -> HsInfixApp # x <# seqHsIdent op <# z
HsApp x y -> HsApp # x <# y
HsNegApp x -> HsNegApp # x
HsLambda ps e -> HsLambda # sequence ps <# e
HsLet ds e -> HsLet # ds <# e
HsIf x y z -> HsIf # x <# y <# z
HsCase e alts -> HsCase # e <# mapM seqAlt alts
HsDo stmts -> HsDo # seqStmt stmts
HsTuple xs -> HsTuple # sequence xs
HsList xs -> HsList # sequence xs
HsParen x -> HsParen # x
HsLeftSection x op -> HsLeftSection # x <# seqHsIdent op
HsRightSection op y -> HsRightSection # seqHsIdent op <# y
HsRecConstr n upds -> HsRecConstr # n <# mapM seqFieldUpdate upds
HsRecUpdate e upds -> HsRecUpdate # e <# mapM seqFieldUpdate upds
HsEnumFrom x -> HsEnumFrom # x
HsEnumFromTo x y -> HsEnumFromTo # x <# y
HsEnumFromThen x y -> HsEnumFromThen # x <# y
HsEnumFromThenTo x y z -> HsEnumFromThenTo # x <# y <# z
HsListComp stmts -> HsListComp # seqStmt stmts
HsExpTypeSig s e c t -> HsExpTypeSig s # e <# c <# t
HsAsPat n e -> HsAsPat # n <# e -- pattern only
HsWildCard -> return HsWildCard -- ditto
HsIrrPat e -> HsIrrPat # e -- ditto
seqStmt (HsGenerator p e s) = HsGenerator # p <# e <# seqStmt s
seqStmt (HsQualifier e s) = HsQualifier # e <# seqStmt s
seqStmt (HsLetStmt ds s) = HsLetStmt # ds <# seqStmt s
seqStmt (HsLast e) = HsLast # e
seqFieldUpdate (HsFieldBind n) = HsFieldBind # n
seqFieldUpdate (HsFieldUpdate n e) = HsFieldUpdate # n <# e
seqE :: (Monad m,Functor m) =>
E (m e) (m p) (m ds) (m t) (m c) ->
m (E e p ds t c)
seqE exp =
case exp of
HsId n -> return $ HsId n
HsLit l -> return $ HsLit l
HsInfixApp x op z -> flip HsInfixApp op # x <# z
HsApp x y -> HsApp # x <# y
HsNegApp x -> HsNegApp # x
HsLambda ps e -> HsLambda # sequence ps <# e
HsLet ds e -> HsLet # ds <# e
HsIf x y z -> HsIf # x <# y <# z
HsCase e alts -> HsCase # e <# mapM seqAlt alts
HsDo stmts -> HsDo # seqStmt stmts
HsTuple xs -> HsTuple # sequence xs
HsList xs -> HsList # sequence xs
HsParen x -> HsParen # x
HsLeftSection x op -> flip HsLeftSection op # x
HsRightSection op y -> HsRightSection op # y
HsRecConstr n upds -> HsRecConstr n # mapM seqFieldUpdate upds
HsRecUpdate e upds -> HsRecUpdate # e <# mapM seqFieldUpdate upds
HsEnumFrom x -> HsEnumFrom # x
HsEnumFromTo x y -> HsEnumFromTo # x <# y
HsEnumFromThen x y -> HsEnumFromThen # x <# y
HsEnumFromThenTo x y z -> HsEnumFromThenTo # x <# y <# z
HsListComp stmts -> HsListComp # seqStmt stmts
HsExpTypeSig s e c t -> HsExpTypeSig s # e <# c <# t
HsAsPat n e -> HsAsPat n # e -- pattern only
HsWildCard -> return HsWildCard -- ditto
HsIrrPat e -> HsIrrPat # e -- ditto
seqTypeId (TypeQual c t) = TypeQual # c <# t
seqTypeId (TypeUnQual t) = TypeUnQual # t
Index