FieldSelectors.hs

module FieldSelectors where
import List(nub)
import HsDeclStruct
import HasBaseStruct(hsPApp,hsPVar,hsPWildCard,hsEVar,hsFunBind)
import HsGuardsStruct(HsRhs(..))
import TiNames(localVal')

fieldSelectors noDef cds = map selector fields 
  where
    conFields = nub [((src,c),[n|(ns,_)<-fs,n<-ns])|HsRecDecl src _ _ c fs<-cds]
    fields = nub [(src,n)|((src,_),ns)<-conFields,n<-ns]

    selector (src,field) =
       hsFunBind src
         [HsMatch src field [hsPApp c (map pat fs)]
                            (HsBody (hsEVar x)) noDef
            |((src,c),fs)<-conFields,field `elem` fs]
      where
        x = localVal' "x" (Just src)
        pat f = if f==field
		then hsPVar x
		else hsPWildCard