content: -- $Id: HsPatMaps.hs,v 1.16 2005/05/31 02:25:25 hallgren Exp $
  
  {-
     
     Standard maps for the P functor
  
  -}
  
  module HsPatMaps
  where
  
  import HsPatStruct
  import HsFieldsMaps
  import AccList(accList)
  import MUtils
  import HsIdent(mapHsIdent2,accHsIdent2,seqHsIdent)
  
  mapPI idf = mapPI2 idf idf
  
  mapPI2 :: (i1 -> i2) ->
            (i1 -> i2) ->
            (p1 -> p2) ->
            PI i1 p1 -> PI i2 p2
  mapPI2 vf cf pf pat =
    case pat of
      HsPId n                -> HsPId (mapHsIdent2 vf cf n)
      HsPLit s l             -> HsPLit s l
      HsPNeg s l             -> HsPNeg s l
      HsPSucc s n l          -> HsPSucc s (vf n) l
      HsPInfixApp x op y     -> HsPInfixApp (pf x) (cf op) (pf y)
      HsPApp nm ps           -> HsPApp (cf nm) (map pf ps)
      HsPTuple s ps          -> HsPTuple s (map pf ps)
      HsPList  s ps          -> HsPList s (map pf ps)
      HsPParen p             -> HsPParen (pf p) 
      HsPRec nm fields       -> HsPRec (cf nm) (mapFieldsI vf pf fields)
      HsPAsPat nm p          -> HsPAsPat (vf nm) (pf p)
      HsPWildCard            -> HsPWildCard
      HsPIrrPat p            -> HsPIrrPat (pf p)
  
  
  accPI idf = accPI2 idf idf
  
  accPI2 :: (i -> b -> b) ->
            (i -> b -> b) ->
            (p -> b -> b) ->
            (PI i p) -> b -> b
  accPI2 vf cf pf pat =
      case pat of
      HsPId n                -> accHsIdent2 vf cf n
      HsPLit s l             -> id 
      HsPNeg s l             -> id
      HsPSucc s n l          -> vf n
      HsPInfixApp x nm y     -> pf x . cf nm . pf y
      HsPApp nm ps           -> cf nm . accList pf ps
      HsPTuple s ps          -> accList pf ps
      HsPList  s ps          -> accList pf ps
      HsPParen p             -> pf p 
      HsPRec nm fields       -> cf nm . accFieldsI vf pf fields 
      HsPAsPat nm p          -> vf nm . pf p 
      HsPWildCard            -> id 
      HsPIrrPat p            -> pf p
  
  
  accP :: (p -> b -> b) ->
          b ->
          (PI i p) ->
          b
  accP pf = flip $ accPI (curry snd) pf
  
  
  seqPI :: (Monad m,Functor m) => PI (m i) (m p) -> m (PI i p) 
  seqPI pat =
     case pat of
       HsPId n                -> HsPId # seqHsIdent n
       HsPLit s l             -> return $ HsPLit s l
       HsPNeg s l             -> return $ HsPNeg s l
       HsPSucc s n l          -> HsPSucc s # n <# return l
       HsPInfixApp x op y     -> HsPInfixApp # x <# op <# y
       HsPApp nm ps           -> HsPApp # nm <# sequence ps
       HsPTuple s ps          -> HsPTuple s # sequence ps
       HsPList  s ps          -> HsPList s # sequence ps
       HsPParen p             -> HsPParen # p
       HsPRec nm fields       -> HsPRec # nm <# seqFieldsI fields
       HsPAsPat nm p          -> HsPAsPat # nm <# p
       HsPWildCard            -> return HsPWildCard
       HsPIrrPat p            -> HsPIrrPat # p
  