content: ------- Maps for the E functor.
  
  module HsExpMaps where
  
  import HsExpStruct
  import HsIdent
  import HsGuardsMaps(mapAlt, accAlt, seqAlt)
  import HsFieldsMaps
  import AccList(accList)
  import MUtils
  
  mapEI idf = mapEI2 idf idf
  
  mapEI2 :: (i1 -> i2) -> 
            (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
  mapEI2 vf cf ef pf df tf ctxf exp =
    case exp of
      HsId n                 -> HsId (mapHsIdent2 vf cf n)
      HsLit s l              -> HsLit s l
      HsInfixApp x op z      -> HsInfixApp (ef x) (mapHsIdent2 vf cf op) (ef z)
      HsApp x y              -> HsApp (ef x) (ef y)
      HsNegApp s x           -> HsNegApp s (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 (mStmt stmts)
      HsTuple xs             -> HsTuple (map ef xs)
      HsList xs              -> HsList (map ef xs)
      HsParen x              -> HsParen (ef x) 
      HsLeftSection x op     -> HsLeftSection (ef x) (mapHsIdent2 vf cf op)
      HsRightSection op y    -> HsRightSection (mapHsIdent2 vf cf op) (ef y) 
      HsRecConstr s n upds   -> HsRecConstr s (cf n) (mapFieldsI vf ef upds)
      HsRecUpdate s e upds   -> HsRecUpdate s (ef e) (mapFieldsI vf ef 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 (mStmt stmts)
      HsExpTypeSig s e c t   -> HsExpTypeSig s (ef e) (ctxf c) (tf t)
      HsAsPat n e            -> HsAsPat (vf n) (ef e)  -- pattern only
      HsWildCard             -> HsWildCard        -- ditto
      HsIrrPat e             -> HsIrrPat (ef e)   -- ditto
    where
      mStmt = mapStmt ef pf df
  
  mapStmt ef pf df stmt =
    case stmt of
      HsGenerator loc p e s -> HsGenerator loc (pf p) (ef e) (m s)
      HsQualifier e s       -> HsQualifier (ef e) (m s)
      HsLetStmt ds s        -> HsLetStmt (df ds) (m s)
      HsLast e              -> HsLast (ef e)
    where
      m = mapStmt ef pf df
  
  -- 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 s l              -> id
      HsInfixApp x op z      -> ef x . accHsIdent idf op . ef z 
      HsApp x y              -> ef x . ef y 
      HsNegApp s 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 s n upds   -> idf n . accFieldsI idf ef upds 
      HsRecUpdate s e upds   -> ef e .  accFieldsI 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
  
  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 s l              -> return $ HsLit s l
      HsInfixApp x op z      -> HsInfixApp # x <# seqHsIdent op <# z
      HsApp x y              -> HsApp # x <# y
      HsNegApp s x           -> HsNegApp s # 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 s n upds   -> HsRecConstr s # n <# seqFieldsI upds
      HsRecUpdate s e upds   -> HsRecUpdate s # e <# seqFieldsI 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 loc p e s) = HsGenerator loc # 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
  