I'm trying to write some template haskell which will transform:

$(buildCP 0)  into \(SimpleM d1 d2 d3) (SimpleM _ _ _) -> (SimpleM d1 d2 d3)
$(buildCP 1)  into \(SimpleM _ d2 d3) (SimpleM d1 _ _) -> (SimpleM d1 d2 d3)
$(buildCP 1)  into \(SimpleM d1 _ d3) (SimpleM _ d2 _) -> (SimpleM d1 d2 d3)
and so on.

Ultimately I want to generalize this to more variables.

I can't seem to get anything to substitute for the pattern variables in a lambda. Is there a straightforward way of doing this?

Below is what I've been playing with to try to make this work.

Thanks,
Patrick.


---
module THTest where

import Language.Haskell.TH
import qualified Data.Bits

type Policy = Int

data Management = SimpleM Policy Policy Policy
   deriving Show

-- Compiles - but no substitution for the "aX" and "bX" variables
buildCP :: Int -> ExpQ
buildCP k =
   [|\(SimpleM a1 a2 a3) (SimpleM b1 b2 b3) -> (SimpleM $e1 $e2 $e3) |]
   where (e1,a1,b1) = bitToExprs 0 k
         (e2,a2,b2) = bitToExprs 1 k
         (e3,a3,b3) = bitToExprs 2 k


-- Won't compile:

buildCP2 :: Int -> ExpQ
buildCP2 k =
[|\(SimpleM $a1 $a2 $a3) (SimpleM $b1 $b2 $b3) -> (SimpleM $e1 $e2 $e3) |]
   where (e1,a1,b1) = bitToExprs 0 k
         (e2,a2,b2) = bitToExprs 1 k
         (e3,a3,b3) = bitToExprs 2 k

cp1 0 = \(SimpleM d1 d2 d3) (SimpleM _ _ _) -> (SimpleM d1 d2 d3)

{-
-- idea is to use in calls like this:

cp0 0 = $(buildCP 0) -- should be \(SimpleM d1 d2 d3) (SimpleM _ _ _) -> (SimpleM d1 d2 d3)
cp0 1 = $(buildCP 1)
-}

-- There is also a template haskell [p| ... |] syntax, but not yet implemented ...
bitToExprs:: Int -> Int -> (ExpQ,PatQ,PatQ)
bitToExprs n k =
   if Data.Bits.testBit (k::Int) (n::Int)
   then (e,v1,v2)
   else (e,v2,v1)
   where v1 =  return WildP
         v2 =  return $ VarP (mkName name)
         e = return $ VarE (mkName name)
         name = "d" ++ (show $ n + 1)

{-

-- ulitmate goal is something like this with 10ish d variables:
--

cp0 0 (SimpleM d1 d2 d3 m1) (SimpleM _ _ _ m2) = (SimpleM d1 d2 d3 (me1 m1 m2)) cp0 1 (SimpleM d1 d2 _ m1) (SimpleM _ _ d3 m2) = (SimpleM d1 d2 d3 (me2 m1 m2)) cp0 2 (SimpleM d1 _ d3 m1) (SimpleM _ d2 _ m2) = (SimpleM d1 d2 d3 (me1 m1 m2)) cp0 3 (SimpleM d1 _ _ m1) (SimpleM _ d2 d3 m2) = (SimpleM d1 d2 d3 (me2 m1 m2)) cp0 4 (SimpleM _ d2 d3 m1) (SimpleM d1 _ _ m2) = (SimpleM d1 d2 d3 (me1 m1 m2)) cp0 5 (SimpleM _ d2 _ m1) (SimpleM d1 _ d3 m2) = (SimpleM d1 d2 d3 (me2 m1 m2)) cp0 6 (SimpleM _ _ d3 m1) (SimpleM d1 d2 _ m2) = (SimpleM d1 d2 d3 (me1 m1 m2)) cp0 7 (SimpleM _ _ _ m1) (SimpleM d1 d2 d3 m2) = (SimpleM d1 d2 d3 (me2 m1 m2))
cp0 _ _ _ = (trace "cp0 error" undefined)

-}
_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe

Reply via email to