{-# OPTIONS_GHC -fglasgow-exts -fno-monomorphism-restriction #-}
-- Many people ask if GHC will evaluate toplevel constants at compile
-- time, you know, since Haskell is pure it'd be great if those
-- computations could be done once and not use up cycles during
-- runtime. Not an entirely bad idea, I think.
--
-- So I set about allowing just that: for arbitrary expressions to be
-- evaluated, and the expanded expression spliced into client code.
--
-- If you had some data in a file just out of convenience, you could say:
-- yourData = $(compileTimeIO $ parseFile $ readFile data.txt)
--
-- Or if you had an expensive computation that you want done at compile:
-- result = $(compileTimeEval $ expensiveComputation)
--
-- I would appreciate comments. I wrote this completely blind with just
-- the TH and Generics haddocks, so if I'm doing something tremendously
-- stupid that can be improved, let me know. :) Especially if you can
-- think of a less awkward way to go from Generics' data to TH
-- expressions than using 'showConstr'...
--
-- I wrote this with 6.6.1, in case there's any incompatibilities. Copy/
-- paste this post into CompileTime.hs, load into ghci, :set -fth, and
-- futz around with the splices.
--
-- -- Nicholas Messenger (nmessenger at gmail.com, omnId on #haskell)
module CompileTime(compileTimeEval, compileTimeIO) where
import Data.Generics
import Language.Haskell.TH
import Control.Monad
import Data.Tree
import Data.Ratio
-- Expands a datum into an expression tree to be spliced into
-- client code.
compileTimeEval :: Data a = a - ExpQ
compileTimeEval = return . toExp
-- Runs the IO action and splices in the evaluated result datum.
compileTimeIO :: Data a = IO a - ExpQ
compileTimeIO = liftM toExp . runIO
-- Does the work. :) toTree gets us a tree of constructors, so
-- we mostly just have to fold the tree with AppE, except for
-- TH's bizarre TupE.
toExp :: Data d = d - Exp
toExp = applyAll . toTree
where
applyAll (Node k args)
| isTuple k = TupE (map applyAll args)
| otherwise = foldl AppE k (map applyAll args)
isTuple (ConE n) = all (==',') (nameBase n)
isTuple _= False
-- Synonym to shorten the definition of exp below
type Ex a = a - Exp
-- Turns some datum into a tree of TH expressions representing
-- that datum. The Exp at each node represents the constructor,
-- the subtrees are its arguments.
toTree :: Data d = d - Tree Exp
toTree x = Node (exp x) (gmapQ toTree x)
where
-- The various ways to turn a (Data d = d) into an
-- Exp representing its constructor.
any = ConE . mkName . deparen . showConstr . toConstr
char = LitE . CharL
int = sigged $ LitE . IntegerL . toInteger
rat = sigged $ LitE . RationalL . toRational
sigged f x = SigE (f x) (ConT . mkName . show $ typeOf x)
-- The above functions combined together for different types.
-- This is what gives the constructor Exp at each Node. There
-- are definitely more types to cover that 'any' gets wrong...
exp = any `extQ` (int::Ex Int)`extQ` (int::Ex Integer)
`extQ` char `extQ` (rat::Ex Float)
`extQ` (rat::Ex Double) `extQ` (rat::Ex Rational)
-- Generics' showConstr puts parens around infix
-- constructors. TH's ConE doesn't like 'em.
deparen s = (if last s == ')' then init else id) .
(if head s == '(' then tail else id) $ s
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe
