{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -Wno-orphans #-}
-- | Semantics for TemplateHaskell
module SemanticSplice where

import qualified Language.Haskell.TH as TH
import qualified Language.Haskell.TH.Syntax as TH
import Syntax

instance Abstractable (TH.Code TH.Q) where
  lam f = [|| \x -> $$(f [||x||]) ||]
  (.@) f x = [|| $$f $$x ||]
instance Num a => Num (TH.Code TH.Q a) where
  x + y = [|| $$x + $$y ||]
  x * y = [|| $$x * $$y ||]
  x - y = [|| $$x - $$y ||]
  abs x = [|| abs $$x ||]
  signum x = [|| signum $$x ||]
  fromInteger i = [|| fromInteger $$(TH.liftTyped i) ||]
  negate x = [|| $$x ||]
instance Fractional a => Fractional (TH.Code TH.Q a) where
  fromRational i = [|| fromRational $$(TH.liftTyped i) ||]
  recip x = [|| recip $$x ||]
  x / y = [|| $$x / $$y ||]

splice :: TH.CodeQ a -> IO String
splice q = TH.runQ (TH.examineCode q) >>= return . TH.pprint . TH.unType