DerivingUtils.hs

module DerivingUtils(
    TypeInfo(..),DefTy(..),ConInfo(..),HsIdentI(..),IdTy(..),
    idTy,idName,
    fun,alt1,alt2,fun0,alt1',alt2',
    vars,app,apps,opapp,con,var,ident,wild,(-::),str,pair,
    hsLet,hsPApp,hsTyId,hsLit,hsPLit,HsLiteral(..),hsListComp,HsStmt(..),
    oneDef,toDefs,noDef,localVal,
    getBaseName,convCon,ModuleName(..),srcLoc,fakePos,
    isEnum,
    conj,
    --eq,bool,false,
    stdvalue,stdtype,stdclass,
    ( # ),
    module ModNames
  ) where
import TiNames as TI(conName,localVal,idName)
import TiClasses(var,con,ident,app,tuple,noDef,oneDef,toDefs)
import HasBaseStruct(hsInfixApp,hsPWildCard,hsFunBind,hsExpTypeSig,hsLit,
		     hsListComp,hsPLit,hsTyId,hsPApp,hsLet)
import HasBaseName(getBaseName)
import BaseSyntax
import TypedIds
import HsConstants as ModNames(mod_Prelude,mod_Ix)
import UniqueNames(origModule)
import SrcLoc
import TiPNT()
import TiHsName()
import MUtils

default(Int)

vars x = [var (localVal (x++show n))|n<-[1..]]
apps args = foldl1 app args
pair x y = tuple [x,y]

opapp op e1 e2 = hsInfixApp e1 op e2
wild=hsPWildCard

fun = hsFunBind
alt2' src f p1 p2 e = HsMatch src f [p1,p2] (HsBody e) 
alt1' src f p e = HsMatch src f [p] (HsBody e) 

alt2 src f p1 p2 e = alt2' src f p1 p2 e noDef
alt1 src f p e = alt1' src f p e noDef

fun0 src f e = fun src [HsMatch src f [] (HsBody e) noDef]

isEnum = all isNullary
  where isNullary c = conArity c==0

convCon (t,ty) c0 = TI.conName (origModule c0) (getBaseName c0) t ty

e-::t = hsExpTypeSig loc0 e [] t
str s = hsLit s . HsString 
{-
andand = pv "&&"

bool = prelType "Bool"
false = prelCon "False" bool boolInfo
true = prelCon "True" bool boolInfo
boolInfo = TypeInfo {defType=Just Data,
		     fields=[],
		     constructors=[bc "False",bc "True"]}
  where
    bc c = ConInfo (prelCon c bool boolInfo) 0 Nothing
-}
conj andand true [] = ident true
conj andand true tsts = foldr1 (opapp andand) tsts

fakePos :: SrcLoc -> Int -> SrcLoc
fakePos (SrcLoc path char line col) n =
    SrcLoc (path++":derived_"++show col) char line n

stdvalue stdnames m n = stdnames ValueNames (m,n)
stdtype stdnames m n = stdnames ClassOrTypeNames (m,n)
stdclass = stdtype