fenfire-0.1: Preprocessor/Hsx/Build.hs
-----------------------------------------------------------------------------
-- |
-- Module : Preprocessor.Hsx.Build
-- Original : Language.Haskell.Syntax
-- Copyright : (c) The GHC Team, 1997-2000,
-- (c) Niklas Broberg 2004
-- License : BSD-style (see the file LICENSE.txt)
--
-- Maintainer : Niklas Broberg, d00nibro@dtek.chalmers.se
-- Stability : experimental
-- Portability : portable
--
-----------------------------------------------------------------------------
module Preprocessor.Hsx.Build (
-- * Syntax building functions
name, -- :: String -> HsName
sym, -- :: String -> HsName
var, -- :: HsName -> HsExp
op, -- :: HsName -> HsQOp
qvar, -- :: Module -> HsName -> HsExp
pvar, -- :: HsName -> HsPat
app, -- :: HsExp -> HsExp -> HsExp
infixApp, -- :: HsExp -> HsQOp -> HsExp -> HsExp
appFun, -- :: HsExp -> [HsExp] -> HsExp
pApp, -- :: HsName -> [HsPat] -> HsPat
tuple, -- :: [HsExp] -> HsExp
pTuple, -- :: [HsPat] -> HsPat
varTuple, -- :: [HsName] -> HsExp
pvarTuple, -- :: [HsName] -> HsPat
function, -- :: String -> HsExp
strE, -- :: String -> HsExp
charE, -- :: Char -> HsExp
intE, -- :: Integer -> HsExp
strP, -- :: String -> HsPat
charP, -- :: Char -> HsPat
intP, -- :: Integer -> HsPat
doE, -- :: [HsStmt] -> HsExp
lamE, -- :: SrcLoc -> [HsPat] -> HsExp -> HsExp
letE, -- :: [HsDecl] -> HsExp -> HsExp
caseE, -- :: HsExp -> [HsAlt] -> HsExp
alt, -- :: SrcLoc -> HsPat -> HsExp -> HsAlt
altGW, -- :: SrcLoc -> HsPat -> [HsStmt] -> HsExp -> HsBinds -> HsAlt
listE, -- :: [HsExp] -> HsExp
eList, -- :: HsExp
peList, -- :: HsPat
paren, -- :: HsExp -> HsExp
pParen, -- :: HsPat -> HsPat
qualStmt, -- :: HsExp -> HsStmt
genStmt, -- :: SrcLoc -> HsPat -> HsExp -> HsStmt
letStmt, -- :: [HsDecl] -> HsStmt
binds, -- :: [HsDecl] -> HsBinds
noBinds, -- :: HsBinds
wildcard, -- :: HsPat
genNames, -- :: String -> Int -> [HsName]
-- * More advanced building
sfun, -- :: SrcLoc -> HsName -> [HsName] -> HsRhs -> HsBinds -> HsDecl
simpleFun, -- :: SrcLoc -> HsName -> HsName -> HsExp -> HsDecl
patBind, -- :: SrcLoc -> HsPat -> HsExp -> HsDecl
patBindWhere, -- :: SrcLoc -> HsPat -> HsExp -> [HsDecl] -> HsDecl
nameBind, -- :: SrcLoc -> HsName -> HsExp -> HsDecl
metaFunction, -- :: String -> [HsExp] -> HsExp
metaConPat -- :: String -> [HsPat] -> HsPat
) where
import Preprocessor.Hsx.Syntax
-----------------------------------------------------------------------------
-- Help functions for Abstract syntax
name :: String -> HsName
name = HsIdent
sym :: String -> HsName
sym = HsSymbol
var :: HsName -> HsExp
var = HsVar . UnQual
op :: HsName -> HsQOp
op = HsQVarOp . UnQual
qvar :: Module -> HsName -> HsExp
qvar m n = HsVar $ Qual m n
pvar :: HsName -> HsPat
pvar = HsPVar
app :: HsExp -> HsExp -> HsExp
app = HsApp
infixApp :: HsExp -> HsQOp -> HsExp -> HsExp
infixApp = HsInfixApp
appFun :: HsExp -> [HsExp] -> HsExp
appFun f [] = f
appFun f (a:as) = appFun (app f a) as
pApp :: HsName -> [HsPat] -> HsPat
pApp n ps = HsPApp (UnQual n) ps
tuple :: [HsExp] -> HsExp
tuple = HsTuple
pTuple :: [HsPat] -> HsPat
pTuple = HsPTuple
varTuple :: [HsName] -> HsExp
varTuple ns = tuple $ map var ns
pvarTuple :: [HsName] -> HsPat
pvarTuple ns = pTuple $ map pvar ns
function :: String -> HsExp
function = var . HsIdent
strE :: String -> HsExp
strE = HsLit . HsString
charE :: Char -> HsExp
charE = HsLit . HsChar
intE :: Integer -> HsExp
intE = HsLit . HsInt
strP :: String -> HsPat
strP = HsPLit . HsString
charP :: Char -> HsPat
charP = HsPLit . HsChar
intP :: Integer -> HsPat
intP = HsPLit . HsInt
doE :: [HsStmt] -> HsExp
doE = HsDo
lamE :: SrcLoc -> [HsPat] -> HsExp -> HsExp
lamE = HsLambda
letE :: [HsDecl] -> HsExp -> HsExp
letE ds e = HsLet (binds ds) e
caseE :: HsExp -> [HsAlt] -> HsExp
caseE = HsCase
alt :: SrcLoc -> HsPat -> HsExp -> HsAlt
alt s p e = HsAlt s p (HsUnGuardedAlt e) noBinds
altGW :: SrcLoc -> HsPat -> [HsStmt] -> HsExp -> HsBinds -> HsAlt
altGW s p gs e w = HsAlt s p (gAlt s gs e) w
unGAlt :: HsExp -> HsGuardedAlts
unGAlt = HsUnGuardedAlt
gAlts :: SrcLoc -> [([HsStmt],HsExp)] -> HsGuardedAlts
gAlts s as = HsGuardedAlts $ map (\(gs,e) -> HsGuardedAlt s gs e) as
gAlt :: SrcLoc -> [HsStmt] -> HsExp -> HsGuardedAlts
gAlt s gs e = gAlts s [(gs,e)]
listE :: [HsExp] -> HsExp
listE = HsList
eList :: HsExp
eList = HsList []
peList :: HsPat
peList = HsPList []
paren :: HsExp -> HsExp
paren = HsParen
pParen :: HsPat -> HsPat
pParen = HsPParen
qualStmt :: HsExp -> HsStmt
qualStmt = HsQualifier
genStmt :: SrcLoc -> HsPat -> HsExp -> HsStmt
genStmt = HsGenerator
letStmt :: [HsDecl] -> HsStmt
letStmt ds = HsLetStmt $ binds ds
binds :: [HsDecl] -> HsBinds
binds = HsBDecls
noBinds :: HsBinds
noBinds = binds []
wildcard :: HsPat
wildcard = HsPWildCard
genNames :: String -> Int -> [HsName]
genNames s k = [ HsIdent $ s ++ show i | i <- [1..k] ]
-------------------------------------------------------------------------------
-- Some more specialised help functions
-- | A function with a single "match"
sfun :: SrcLoc -> HsName -> [HsName] -> HsRhs -> HsBinds -> HsDecl
sfun s f pvs rhs bs = HsFunBind [HsMatch s f (map pvar pvs) rhs bs]
-- | A function with a single "match", a single argument, no guards
-- and no where declarations
simpleFun :: SrcLoc -> HsName -> HsName -> HsExp -> HsDecl
simpleFun s f a e = let rhs = HsUnGuardedRhs e
in sfun s f [a] rhs noBinds
-- | A pattern bind where the pattern is a variable, and where
-- there are no guards and no 'where' clause.
patBind :: SrcLoc -> HsPat -> HsExp -> HsDecl
patBind s p e = let rhs = HsUnGuardedRhs e
in HsPatBind s p rhs noBinds
patBindWhere :: SrcLoc -> HsPat -> HsExp -> [HsDecl] -> HsDecl
patBindWhere s p e ds = let rhs = HsUnGuardedRhs e
in HsPatBind s p rhs (binds ds)
nameBind :: SrcLoc -> HsName -> HsExp -> HsDecl
nameBind s n e = patBind s (pvar n) e
-- meta-level functions, i.e. functions that represent functions,
-- and that take arguments representing arguments... whew!
metaFunction :: String -> [HsExp] -> HsExp
metaFunction s es = mf s (reverse es)
where mf s [] = var $ name s
mf s (e:es) = app (mf s es) e
metaConPat :: String -> [HsPat] -> HsPat
metaConPat s ps = pApp (name s) ps