SemanticSplice.hs

   1 {-# LANGUAGE FlexibleInstances #-}
   2 {-# LANGUAGE TemplateHaskell #-}
   3 -- | Semantics for TemplateHaskell
   4 module SemanticSplice where
   5
   6 import qualified Language.Haskell.TH as TH
   7 import qualified Language.Haskell.TH.Syntax as TH
   8 import Syntax
   9
  10 instance Abstractable (TH.Code TH.Q) where
  11   lam f = [|| \x -> $$(f [||x||]) ||]
  12   (.@) f x = [|| $$f $$x ||]
  13 instance Num a => Num (TH.Code TH.Q a) where
  14   x + y = [|| $$x + $$y ||]
  15   x * y = [|| $$x * $$y ||]
  16   x - y = [|| $$x - $$y ||]
  17   abs x = [|| abs $$x ||]
  18   signum x = [|| signum $$x ||]
  19   fromInteger i = [|| fromInteger $$(TH.liftTyped i) ||]
  20   negate x = [|| $$x ||]
  21 instance Fractional a => Fractional (TH.Code TH.Q a) where
  22   fromRational i = [|| fromRational $$(TH.liftTyped i) ||]
  23   recip x = [|| recip $$x ||]
  24   x / y = [|| $$x / $$y ||]
  25
  26 splice :: TH.CodeQ a -> IO String
  27 splice q = TH.runQ (TH.examineCode q) >>= return . TH.pprint . TH.unType