staged.hs

{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}

module StagedPower where

import Language.Haskell.TH (Q, TExp)

type Code a = Q (TExp a)

-- Monomorphic
qpower :: Int -> Q (TExp Int) -> Q (TExp Int)
qpower 0 _ = [||1||]
qpower i n = [||$$n * $$(qpower (i - 1) n)||]

-- Polymorphic
newtype Powerer = Pwr {getPwr :: forall a. Num a => a -> a}

makePowers :: forall a. Code a -> Code (a -> a -> a) -> Int -> Code (a -> a)
makePowers one times power = [||\n -> $$(go [||n||] power)||]
 where
  go :: Code a -> Int -> Code a
  go _ 0 = one
  go n i = [||$$times $$n $$(go n (i -1))||]

qpowerer :: Int -> Q (TExp Powerer)
qpowerer i =
  [||
  Pwr $ \a ->
    let times = (*)
        one = 1
     in $$(makePowers [||one||] [||times||] i) a
  ||]