{-# LANGUAGE TemplateHaskell #-}
module NoSlow.Main.TH
where

import qualified NoSlow.Micro.Kernels as K
import NoSlow.Main.Util
import NoSlow.Backend.TH ( calls )
import NoSlow.Util.Base

import Language.Haskell.TH

benchtrees :: String -> Sort -> TypeQ -> Q [Dec] -> [KTree] -> ExpQ
benchtrees grp sort tyq ks ts
  = do
      ty <- tyq
      varE 'klist `appE` listE (map (benchtree grp sort ty ks) ts)

benchtree :: String -> Sort -> Type -> Q [Dec] -> KTree -> ExpQ
benchtree grp sort ty ks (KGroup s ts)
  = mk_kgroup s (map (benchtree grp sort ty ks) ts)
benchtree grp sort ty@(ConT c) ks (KModule s gmod)
  = do
      TyConI (TySynD t _ _) <- reify $ mkName $ gmod ++ ".Spec_Vector"

      let vec_ty = conT t `appT` return ty
          ty_tag = conE 'Ty `sigE` appT (conT ''Ty) vec_ty

      mk_kgroup s [mk_kernels ty_tag real_mod]
  where
    mk_kernels ty mod = varE 'kernels `appE` litE (StringL grp)
                                      `appE` ty
                                      `appE` calls 'kernel mod ks

    real_mod = case sort of
                 Generic     -> gmod
                 Specialised -> gmod ++ '.' : nameBase c

mk_kgroup :: String -> [ExpQ] -> ExpQ
mk_kgroup s exps = varE 'kgroup `appE` litE (StringL s) `appE` listE exps