1----------------------------------------------------------------------------- 2-- | 3-- Module : Language.Haskell.Exts.Build 4-- Copyright : (c) The GHC Team, 1997-2000, 5-- (c) Niklas Broberg 2004 6-- License : BSD-style (see the file LICENSE.txt) 7-- 8-- Maintainer : Niklas Broberg, d00nibro@chalmers.se 9-- Stability : experimental 10-- Portability : portable 11-- 12-- This module contains combinators to use when building 13-- Haskell source trees programmatically, as opposed to 14-- parsing them from a string. The contents here are quite 15-- experimental and will likely receive a lot of attention 16-- when the rest has stabilised. 17-- 18----------------------------------------------------------------------------- 19 20module Language.Haskell.Exts.Build ( 21 22 -- * Syntax building functions 23 name, -- :: String -> Name () 24 sym, -- :: String -> Name () 25 var, -- :: Name () -> Exp () 26 op, -- :: Name () -> QOp 27 qvar, -- :: Module -> Name () -> Exp () 28 pvar, -- :: Name () -> Pat () 29 app, -- :: Exp () -> Exp () -> Exp () 30 infixApp, -- :: Exp () -> QOp -> Exp () -> Exp () 31 appFun, -- :: Exp () -> [Exp] -> Exp () 32 pApp, -- :: Name () -> [Pat] -> Pat () 33 tuple, -- :: [Exp] -> Exp () 34 pTuple, -- :: [Pat] -> Pat () 35 varTuple, -- :: [Name] -> Exp () 36 pvarTuple, -- :: [Name] -> Pat () 37 function, -- :: String -> Exp () 38 strE, -- :: String -> Exp () 39 charE, -- :: Char -> Exp () 40 intE, -- :: Integer -> Exp () 41 strP, -- :: String -> Pat () 42 charP, -- :: Char -> Pat () 43 intP, -- :: Integer -> Pat () 44 doE, -- :: [Stmt] -> Exp () 45 lamE, -- :: SrcLoc -> [Pat] -> Exp () -> Exp () 46 letE, -- :: [Decl] -> Exp () -> Exp () 47 caseE, -- :: Exp () -> [Alt] -> Exp () 48 alt, -- :: SrcLoc -> Pat () -> Exp () -> Alt 49 altGW, -- :: SrcLoc -> Pat () -> [Stmt] -> Exp () -> Binds -> Alt 50 listE, -- :: [Exp] -> Exp () 51 eList, -- :: Exp () 52 peList, -- :: Pat () 53 paren, -- :: Exp () -> Exp () 54 pParen, -- :: Pat () -> Pat () 55 qualStmt, -- :: Exp () -> Stmt 56 genStmt, -- :: SrcLoc -> Pat () -> Exp () -> Stmt 57 letStmt, -- :: [Decl] -> Stmt 58 binds, -- :: [Decl] -> Binds 59 noBinds, -- :: Binds 60 wildcard, -- :: Pat () 61 genNames, -- :: String -> Int -> [Name] 62 63 -- * More advanced building 64 sfun, -- :: SrcLoc -> Name () -> [Name] -> Rhs -> Binds -> Decl () 65 simpleFun, -- :: SrcLoc -> Name () -> Name () -> Exp () -> Decl () 66 patBind, -- :: SrcLoc -> Pat () -> Exp () -> Decl () 67 patBindWhere, -- :: SrcLoc -> Pat () -> Exp () -> [Decl] -> Decl () 68 nameBind, -- :: SrcLoc -> Name () -> Exp () -> Decl () 69 metaFunction, -- :: String -> [Exp] -> Exp () 70 metaConPat -- :: String -> [Pat] -> Pat () 71 ) where 72 73import Language.Haskell.Exts.Syntax 74 75----------------------------------------------------------------------------- 76-- Help functions for Abstract syntax 77 78-- | An identifier with the given string as its name. 79-- The string should be a valid Haskell identifier. 80name :: String -> Name () 81name = Ident () 82 83-- | A symbol identifier. The string should be a valid 84-- Haskell symbol identifier. 85sym :: String -> Name () 86sym = Symbol () 87 88-- | A local variable as expression. 89var :: Name () -> Exp () 90var = Var () . UnQual () 91 92-- | Use the given identifier as an operator. 93op :: Name () -> QOp () 94op = QVarOp () . UnQual () 95 96-- | A qualified variable as expression. 97qvar :: ModuleName () -> Name () -> Exp () 98qvar m n = Var () $ Qual () m n 99 100-- | A pattern variable. 101pvar :: Name () -> Pat () 102pvar = PVar () 103 104-- | Application of expressions by juxtaposition. 105app :: Exp () -> Exp () -> Exp () 106app = App () 107 108-- | Apply an operator infix. 109infixApp :: Exp () -> QOp () -> Exp () -> Exp () 110infixApp = InfixApp () 111 112-- | Apply a function to a list of arguments. 113appFun :: Exp () -> [Exp ()] -> Exp () 114appFun f [] = f 115appFun f (a:as) = appFun (app f a) as 116 117-- | A constructor pattern, with argument patterns. 118pApp :: Name () -> [Pat ()] -> Pat () 119pApp n ps = PApp () (UnQual () n) ps 120 121-- | A tuple expression. 122tuple :: [Exp ()] -> Exp () 123tuple = Tuple () Boxed 124 125-- | A tuple pattern. 126pTuple :: [Pat ()] -> Pat () 127pTuple = PTuple () Boxed 128 129-- | A tuple expression consisting of variables only. 130varTuple :: [Name ()] -> Exp () 131varTuple ns = tuple $ map var ns 132 133-- | A tuple pattern consisting of variables only. 134pvarTuple :: [Name ()] -> Pat () 135pvarTuple ns = pTuple $ map pvar ns 136 137-- | A function with a given name. 138function :: String -> Exp () 139function = var . Ident () 140 141-- | A literal string expression. 142strE :: String -> Exp () 143strE s = Lit () (String () s s) 144 145-- | A literal character expression. 146charE :: Char -> Exp () 147charE c = Lit () (Char () c [c]) 148 149-- | A literal integer expression. 150intE :: Integer -> Exp () 151intE n = Lit () (Int () n (show n)) 152 153-- | A literal string pattern. 154strP :: String -> Pat () 155strP s = PLit () (Signless ()) (String () s s) 156 157-- | A literal character pattern. 158charP :: Char -> Pat () 159charP x = PLit () (Signless ()) (Char () x [x]) 160 161-- | A literal integer pattern. 162intP :: Integer -> Pat () 163intP x = PLit () 164 (if x >= 0 then Signless () else Negative ()) 165 (Int () (abs x) (show x)) 166 167-- | A do block formed by the given statements. 168-- The last statement in the list should be 169-- a 'Qualifier' expression. 170doE :: [Stmt ()] -> Exp () 171doE = Do () 172 173-- | Lambda abstraction, given a list of argument 174-- patterns and an expression body. 175lamE :: [Pat ()] -> Exp () -> Exp () 176lamE = Lambda () 177 178-- | A @let@ ... @in@ block. 179letE :: [Decl ()] -> Exp () -> Exp () 180letE ds e = Let () (binds ds) e 181 182-- | A @case@ expression. 183caseE :: Exp () -> [Alt ()] -> Exp () 184caseE = Case () 185 186-- | An unguarded alternative in a @case@ expression. 187alt :: Pat () -> Exp () -> Alt () 188alt p e = Alt () p (unGAlt e) noBinds 189 190-- | An alternative with a single guard in a @case@ expression. 191altGW :: Pat () -> [Stmt ()] -> Exp () -> Binds () -> Alt () 192altGW p gs e w = Alt () p (gAlt gs e) (Just w) 193 194-- | An unguarded righthand side of a @case@ alternative. 195unGAlt :: Exp () -> Rhs () 196unGAlt = UnGuardedRhs () 197 198-- | An list of guarded righthand sides for a @case@ alternative. 199gAlts :: [([Stmt ()],Exp ())] -> Rhs () 200gAlts as = GuardedRhss () $ map (\(gs,e) -> GuardedRhs () gs e) as 201 202-- | A single guarded righthand side for a @case@ alternative. 203gAlt :: [Stmt ()] -> Exp () -> Rhs () 204gAlt gs e = gAlts [(gs,e)] 205 206-- | A list expression. 207listE :: [Exp ()] -> Exp () 208listE = List () 209 210-- | The empty list expression. 211eList :: Exp () 212eList = List () [] 213 214-- | The empty list pattern. 215peList :: Pat () 216peList = PList () [] 217 218-- | Put parentheses around an expression. 219paren :: Exp () -> Exp () 220paren = Paren () 221 222-- | Put parentheses around a pattern. 223pParen :: Pat () -> Pat () 224pParen = PParen () 225 226-- | A qualifier expression statement. 227qualStmt :: Exp () -> Stmt () 228qualStmt = Qualifier () 229 230-- | A generator statement: /pat/ @<-@ /exp/ 231genStmt :: Pat () -> Exp () -> Stmt () 232genStmt = Generator () 233 234-- | A @let@ binding group as a statement. 235letStmt :: [Decl ()] -> Stmt () 236letStmt ds = LetStmt () $ binds ds 237 238-- | Hoist a set of declarations to a binding group. 239binds :: [Decl ()] -> Binds () 240binds = BDecls () 241 242-- | An empty binding group. 243noBinds :: Maybe (Binds ()) 244noBinds = Nothing 245 246-- | The wildcard pattern: @_@ 247wildcard :: Pat () 248wildcard = PWildCard () 249 250-- | Generate k names by appending numbers 1 through k to a given string. 251genNames :: String -> Int -> [Name ()] 252genNames s k = [ Ident () $ s ++ show i | i <- [1..k] ] 253 254------------------------------------------------------------------------------- 255-- Some more specialised help functions 256 257-- | A function with a single clause 258sfun :: Name () -> [Name ()] -> (Rhs ()) -> Maybe (Binds ()) -> Decl () 259sfun f pvs rhs bs = FunBind () [Match () f (map pvar pvs) rhs bs] 260 261-- | A function with a single clause, a single argument, no guards 262-- and no where declarations 263simpleFun :: Name () -> Name () -> Exp () -> Decl () 264simpleFun f a e = let rhs = UnGuardedRhs () e 265 in sfun f [a] rhs noBinds 266 267-- | A pattern bind where the pattern is a variable, and where 268-- there are no guards and no 'where' clause. 269patBind :: Pat () -> Exp () -> Decl () 270patBind p e = let rhs = UnGuardedRhs () e 271 in PatBind () p rhs noBinds 272 273-- | A pattern bind where the pattern is a variable, and where 274-- there are no guards, but with a 'where' clause. 275patBindWhere :: Pat () -> Exp () -> [Decl ()] -> Decl () 276patBindWhere p e ds = let rhs = UnGuardedRhs () e 277 in PatBind () p rhs (if null ds then Nothing else Just (binds ds)) 278 279-- | Bind an identifier to an expression. 280nameBind :: Name () -> Exp () -> Decl () 281nameBind n e = patBind (pvar n) e 282 283-- | Apply function of a given name to a list of arguments. 284metaFunction :: String -> [Exp ()] -> Exp () 285metaFunction s' es' = mf s' (reverse es') 286 where mf s [] = var $ name s 287 mf s (e:es) = app (mf s es) e 288 289-- | Apply a constructor of a given name to a list of pattern 290-- arguments, forming a constructor pattern. 291metaConPat :: String -> [Pat ()] -> Pat () 292metaConPat s ps = pApp (name s) ps 293