hpaste

recent | annotate | new

{-# OPTIONS_GHC -fglasgow-exts -fth #-}

module ArgMunge (argmunge) where

import Language.Haskell.TH

argmunge munger arity 
        | and [i `elem` [0 .. arity -1] | i <- munger]  = lamE lhs rhs
        | otherwise     = report True "argmunge: illegal argument number"
                                 >> lamE lhs rhs
        where   lhs = map varP (f:argVars)
                rhs = foldl1 appE $ map varE (f:mungedargs)
                mungedargs = [argVars !! munge_i | munge_i <- munger]
                argVars = map (mkName.('a':).show) [0 .. arity - 1]
                f = mkName "f"

Written in response to a challenge by Hitesh Jasani: see http://pozorvlak.livejournal.com/95275.html for more details.

{-# LANGUAGE TemplateHaskell #-}

module ArgMunge (argMunge) where
import Control.Monad (replicateM)
import Language.Haskell.TH

argMunge :: [Int] -> Int -> ExpQ
argMunge xs n
  | and [0 <= i && i < n | i <- xs]
  = newName "f" >>= \f ->
      replicateM n (newName "a") >>= \argv ->
        lamE (varP f : fmap varP argv)
          (foldl (\a -> appE a . varE . (argv!!)) (varE f) xs)
  | otherwise
  = report True ("argMunge: illegal argument number: "
      ++(show . head . dropWhile (<n) $ xs)
        ++" >= arity = "++(show n))
          >> [|()|]