SemanticSplice.hs

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