{-# 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

data Sort = Poly | Mono

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

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

      let tag = case sort of
                  Poly -> '*' : nameBase c
                  Mono -> nameBase c

          real_mod = case sort of
                       Poly -> poly_mod
                       Mono -> poly_mod ++ '.' : nameBase c

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

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

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