53 lines
1.5 KiB
Haskell
53 lines
1.5 KiB
Haskell
{-# LANGUAGE TemplateHaskell #-}
|
|
{-# LANGUAGE QuasiQuotes #-}
|
|
|
|
module Common where
|
|
-- Common Utility Functions
|
|
|
|
import Language.Haskell.TH
|
|
|
|
|
|
------------
|
|
-- Tuples --
|
|
------------
|
|
|
|
fst3 :: (a,b,c) -> a
|
|
fst3 (x,_,_) = x
|
|
snd3 :: (a,b,c) -> b
|
|
snd3 (_,y,_) = y
|
|
trd3 :: (a,b,c) -> c
|
|
trd3 (_,_,z) = z
|
|
|
|
projNI :: Int -> Int -> ExpQ -- generic projection gives I-th element of N-tuple, i.e. snd3 = $(projNI 3 2) --ghci -fth
|
|
-- $(projN n m) :: (t1,..,tn) -> tm (for m<=n)
|
|
projNI n i = lamE [pat] rhs
|
|
where pat = tupP (map varP xs)
|
|
rhs = varE (xs !! (i - 1))
|
|
xs = [ mkName $ "x" ++ show j | j <- [1..n] ]
|
|
|
|
|
|
---------------
|
|
-- Functions --
|
|
---------------
|
|
|
|
permuteFun :: [Int] -> ExpQ -- generic permutation of function arguments, i.e. $(permuteFun [2,1]) == flip
|
|
permuteFun perm = lamE pat rhs
|
|
where pat = map varP $ fn:xs
|
|
rhs = foldl appE (varE fn) $ map varE ps
|
|
-- rhs = appE (varE fn) (varE $ xs!!1)
|
|
ln = length perm
|
|
xs = [ mkName $ "x" ++ show j | j <- [1..ln] ]
|
|
ps = [ xs !! (j-1) | j <- perm ]
|
|
fn = mkName "fn"
|
|
|
|
altFun :: [Int] -> ExpQ -- generic permutation/repetition of function arguments, i.e. $(permuteFun [2,1]) == flip
|
|
altFun perm = lamE pat rhs
|
|
where pat = map varP $ fn:xs
|
|
rhs = foldl appE (varE fn) $ map varE ps
|
|
-- rhs = appE (varE fn) (varE $ xs!!1)
|
|
mx = maximum perm
|
|
xs = [ mkName $ "x" ++ show j | j <- [1..mx] ]
|
|
ps = [ xs !! (j-1) | j <- perm ]
|
|
fn = mkName "fn"
|
|
|